parameters should be spelled in capitals

src/HDF5_utilities.f90

@@ -135,8 +135,8 @@ subroutine HDF5_utilities_init()
 
   call H5Tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr)
   call HDF5_chkerr(hdferr)
-  if (int(storage_size(0.0_pReal),SIZE_T)/=typeSize*8) &
-    error stop 'pReal does not match H5T_NATIVE_DOUBLE'
+  if (int(storage_size(0.0_pREAL),SIZE_T)/=typeSize*8) &
+    error stop 'pREAL does not match H5T_NATIVE_DOUBLE'
 
   call H5get_libversion_f(HDF5_major,HDF5_minor,HDF5_release,hdferr)
   call HDF5_chkerr(hdferr)
@@ -443,7 +443,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
 
   integer(HID_T),   intent(in)           :: loc_id
   character(len=*), intent(in)           :: attrLabel
-  real(pReal),      intent(in)           :: attrValue
+  real(pREAL),      intent(in)           :: attrValue
   character(len=*), intent(in), optional :: path
 
   integer(HID_T) :: attr_id, space_id
@@ -576,7 +576,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
 
   integer(HID_T),   intent(in)               :: loc_id
   character(len=*), intent(in)               :: attrLabel
-  real(pReal),      intent(in), dimension(:) :: attrValue
+  real(pREAL),      intent(in), dimension(:) :: attrValue
   character(len=*), intent(in), optional     :: path
 
   integer(HSIZE_T),dimension(1) :: array_size
@@ -640,7 +640,7 @@ end subroutine HDF5_setLink
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(out), dimension(:) :: dataset                                            !< data read from file
+  real(pREAL),      intent(out), dimension(:) :: dataset                                            !< data read from file
   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                                                         !< dataset is distributed over multiple processes
@@ -674,7 +674,7 @@ end subroutine HDF5_read_real1
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(out), dimension(:,:) :: dataset                                          !< data read from file
+  real(pREAL),      intent(out), dimension(:,:) :: dataset                                          !< data read from file
   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                                                         !< dataset is distributed over multiple processes
@@ -708,7 +708,7 @@ end subroutine HDF5_read_real2
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(out), dimension(:,:,:) :: dataset                                        !< data read from file
+  real(pREAL),      intent(out), dimension(:,:,:) :: dataset                                        !< data read from file
   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                                                         !< dataset is distributed over multiple processes
@@ -742,7 +742,7 @@ end subroutine HDF5_read_real3
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(out), dimension(:,:,:,:) :: dataset                                      !< read data
+  real(pREAL),      intent(out), dimension(:,:,:,:) :: dataset                                      !< read data
   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                                                         !< dataset is distributed over multiple processes
@@ -777,7 +777,7 @@ end subroutine HDF5_read_real4
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(out), dimension(:,:,:,:,:) :: dataset                                    !< data read from file
+  real(pREAL),      intent(out), dimension(:,:,:,:,:) :: dataset                                    !< data read from file
   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                                                         !< dataset is distributed over multiple processes
@@ -812,7 +812,7 @@ end subroutine HDF5_read_real5
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(out), dimension(:,:,:,:,:,:) :: dataset                                  !< data read from file
+  real(pREAL),      intent(out), dimension(:,:,:,:,:,:) :: dataset                                  !< data read from file
   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                                                         !< dataset is distributed over multiple processes
@@ -847,7 +847,7 @@ end subroutine HDF5_read_real6
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(out), dimension(:,:,:,:,:,:,:) :: dataset                                !< data read from file
+  real(pREAL),      intent(out), dimension(:,:,:,:,:,:,:) :: dataset                                !< data read from file
   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                                                         !< dataset is distributed over multiple processes
@@ -1126,7 +1126,7 @@ end subroutine HDF5_read_int7
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(:) :: dataset                                             !< data written to file
+  real(pREAL),      intent(in), dimension(:) :: dataset                                             !< data written to file
   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                                                         !< dataset is distributed over multiple processes
@@ -1163,7 +1163,7 @@ end subroutine HDF5_write_real1
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(:,:) :: dataset                                           !< data written to file
+  real(pREAL),      intent(in), dimension(:,:) :: dataset                                           !< data written to file
   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                                                         !< dataset is distributed over multiple processes
@@ -1200,7 +1200,7 @@ end subroutine HDF5_write_real2
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(:,:,:) :: dataset                                         !< data written to file
+  real(pREAL),      intent(in), dimension(:,:,:) :: dataset                                         !< data written to file
   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                                                         !< dataset is distributed over multiple processes
@@ -1237,7 +1237,7 @@ end subroutine HDF5_write_real3
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(:,:,:,:) :: dataset                                       !< data written to file
+  real(pREAL),      intent(in), dimension(:,:,:,:) :: dataset                                       !< data written to file
   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                                                         !< dataset is distributed over multiple processes
@@ -1275,7 +1275,7 @@ end subroutine HDF5_write_real4
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(:,:,:,:,:) :: dataset                                     !< data written to file
+  real(pREAL),      intent(in), dimension(:,:,:,:,:) :: dataset                                     !< data written to file
   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                                                         !< dataset is distributed over multiple processes
@@ -1312,7 +1312,7 @@ end subroutine HDF5_write_real5
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(:,:,:,:,:,:) :: dataset                                   !< data written to file
+  real(pREAL),      intent(in), dimension(:,:,:,:,:,:) :: dataset                                   !< data written to file
   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                                                         !< dataset is distributed over multiple processes
@@ -1349,7 +1349,7 @@ end subroutine HDF5_write_real6
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(:,:,:,:,:,:,:) :: dataset                                 !< data written to file
+  real(pREAL),      intent(in), dimension(:,:,:,:,:,:,:) :: dataset                                 !< data written to file
   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                                                         !< dataset is distributed over multiple processes
@@ -1388,7 +1388,7 @@ end subroutine HDF5_write_real7
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_real(dataset,loc_id,datasetName,parallel)
 
-  real(pReal),      intent(in), dimension(..) :: dataset                                            !< data written to file
+  real(pREAL),      intent(in), dimension(..) :: dataset                                            !< data written to file
   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                                                         !< dataset is distributed over multiple processes

src/IO.f90

@@ -274,7 +274,7 @@ end function IO_intValue
 !--------------------------------------------------------------------------------------------------
 !> @brief Read real value at myChunk from string.
 !--------------------------------------------------------------------------------------------------
-real(pReal) function IO_realValue(str,chunkPos,myChunk)
+real(pREAL) function IO_realValue(str,chunkPos,myChunk)
 
   character(len=*),        intent(in) :: str                                                        !< raw input with known start and end of each chunk
   integer,   dimension(:), intent(in) :: chunkPos                                                   !< positions of start and end of each tag/chunk in given string
@@ -373,7 +373,7 @@ end function IO_strAsInt
 !--------------------------------------------------------------------------------------------------
 !> @brief Return real value from given string.
 !--------------------------------------------------------------------------------------------------
-real(pReal) function IO_strAsReal(str)
+real(pREAL) function IO_strAsReal(str)
 
   character(len=*), intent(in) :: str                                                               !< string for conversion to real value
 
@@ -385,7 +385,7 @@ real(pReal) function IO_strAsReal(str)
     read(str,*,iostat=readStatus) IO_strAsReal
     if (readStatus /= 0) call IO_error(112,str)
   else valid
-    IO_strAsReal = 0.0_pReal
+    IO_strAsReal = 0.0_pREAL
     call IO_error(112,str)
   end if valid
 
@@ -733,12 +733,12 @@ subroutine selfTest()
   character(len=:),      allocatable :: str,out
 
 
-  if (dNeq(1.0_pReal, IO_strAsReal('1.0')))          error stop 'IO_strAsReal'
-  if (dNeq(1.0_pReal, IO_strAsReal('1e0')))          error stop 'IO_strAsReal'
-  if (dNeq(0.1_pReal, IO_strAsReal('1e-1')))         error stop 'IO_strAsReal'
-  if (dNeq(0.1_pReal, IO_strAsReal('1.0e-1')))       error stop 'IO_strAsReal'
-  if (dNeq(0.1_pReal, IO_strAsReal('1.00e-1')))      error stop 'IO_strAsReal'
-  if (dNeq(10._pReal, IO_strAsReal(' 1.0e+1 ')))     error stop 'IO_strAsReal'
+  if (dNeq(1.0_pREAL, IO_strAsReal('1.0')))          error stop 'IO_strAsReal'
+  if (dNeq(1.0_pREAL, IO_strAsReal('1e0')))          error stop 'IO_strAsReal'
+  if (dNeq(0.1_pREAL, IO_strAsReal('1e-1')))         error stop 'IO_strAsReal'
+  if (dNeq(0.1_pREAL, IO_strAsReal('1.0e-1')))       error stop 'IO_strAsReal'
+  if (dNeq(0.1_pREAL, IO_strAsReal('1.00e-1')))      error stop 'IO_strAsReal'
+  if (dNeq(10._pREAL, IO_strAsReal(' 1.0e+1 ')))     error stop 'IO_strAsReal'
 
   if (3112019  /= IO_strAsInt( '3112019'))           error stop 'IO_strAsInt'
   if (3112019  /= IO_strAsInt(' 3112019'))           error stop 'IO_strAsInt'
@@ -760,7 +760,7 @@ subroutine selfTest()
 
   str = ' 1.0 xxx'
   chunkPos = IO_strPos(str)
-  if (dNeq(1.0_pReal,IO_realValue(str,chunkPos,1)))  error stop 'IO_realValue'
+  if (dNeq(1.0_pREAL,IO_realValue(str,chunkPos,1)))  error stop 'IO_realValue'
 
   str = 'M 3112019 F'
   chunkPos = IO_strPos(str)

src/LAPACK_interface.f90

@@ -12,11 +12,11 @@ module LAPACK_interface
 
       character,   intent(in)                             :: jobvl,jobvr
       integer,     intent(in)                             :: n,lda,ldvl,ldvr,lwork
-      real(pReal), intent(inout), dimension(lda,n)        :: a
-      real(pReal), intent(out),   dimension(n)            :: wr,wi
-      real(pReal), intent(out),   dimension(ldvl,n)       :: vl
-      real(pReal), intent(out),   dimension(ldvr,n)       :: vr
-      real(pReal), intent(out),   dimension(max(1,lwork)) :: work
+      real(pREAL), intent(inout), dimension(lda,n)        :: a
+      real(pREAL), intent(out),   dimension(n)            :: wr,wi
+      real(pREAL), intent(out),   dimension(ldvl,n)       :: vl
+      real(pREAL), intent(out),   dimension(ldvr,n)       :: vr
+      real(pREAL), intent(out),   dimension(max(1,lwork)) :: work
       integer,     intent(out)                            :: info
     end subroutine dgeev
 
@@ -25,9 +25,9 @@ module LAPACK_interface
       implicit none(type,external)
 
       integer,     intent(in)                             :: n,nrhs,lda,ldb
-      real(pReal), intent(inout), dimension(lda,n)        :: a
+      real(pREAL), intent(inout), dimension(lda,n)        :: a
       integer,     intent(out),   dimension(n)            :: ipiv
-      real(pReal), intent(inout), dimension(ldb,nrhs)     :: b
+      real(pREAL), intent(inout), dimension(ldb,nrhs)     :: b
       integer,     intent(out)                            :: info
     end subroutine dgesv
 
@@ -36,7 +36,7 @@ module LAPACK_interface
       implicit none(type,external)
 
       integer,     intent(in)                             :: m,n,lda
-      real(pReal), intent(inout), dimension(lda,n)        :: a
+      real(pREAL), intent(inout), dimension(lda,n)        :: a
       integer,     intent(out),   dimension(min(m,n))     :: ipiv
       integer,     intent(out)                            :: info
     end subroutine dgetrf
@@ -46,9 +46,9 @@ module LAPACK_interface
       implicit none(type,external)
 
       integer,     intent(in)                             :: n,lda,lwork
-      real(pReal), intent(inout), dimension(lda,n)        :: a
+      real(pREAL), intent(inout), dimension(lda,n)        :: a
       integer,     intent(in),    dimension(n)            :: ipiv
-      real(pReal), intent(out),   dimension(max(1,lwork)) :: work
+      real(pREAL), intent(out),   dimension(max(1,lwork)) :: work
       integer,     intent(out)                            :: info
     end subroutine dgetri
 
@@ -58,9 +58,9 @@ module LAPACK_interface
 
       character,   intent(in)                             :: jobz,uplo
       integer,     intent(in)                             :: n,lda,lwork
-      real(pReal), intent(inout), dimension(lda,n)        :: a
-      real(pReal), intent(out),   dimension(n)            :: w
-      real(pReal), intent(out),   dimension(max(1,lwork)) :: work
+      real(pREAL), intent(inout), dimension(lda,n)        :: a
+      real(pREAL), intent(out),   dimension(n)            :: w
+      real(pREAL), intent(out),   dimension(max(1,lwork)) :: work
       integer,     intent(out)                            :: info
     end subroutine dsyev
 

src/Marc/DAMASK_Marc.f90

@@ -233,32 +233,32 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
     matus, &                                                                                        !< (1) user material identification number, (2) internal material identification number
     kcus, &                                                                                         !< (1) layer number, (2) internal layer number
     lclass                                                                                          !< (1) element class, (2) 0: displacement, 1: low order Herrmann, 2: high order Herrmann
-  real(pReal),   dimension(*),           intent(in) :: &                                            ! has dimension(1) according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(*)
+  real(pREAL),   dimension(*),           intent(in) :: &                                            ! has dimension(1) according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(*)
     e, &                                                                                            !< total elastic strain
     de, &                                                                                           !< increment of strain
     dt                                                                                              !< increment of state variables
-  real(pReal),   dimension(itel),        intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
+  real(pREAL),   dimension(itel),        intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
     strechn, &                                                                                      !< square of principal stretch ratios, lambda(i) at t=n
     strechn1                                                                                        !< square of principal stretch ratios, lambda(i) at t=n+1
-  real(pReal),   dimension(3,3),         intent(in) :: &                                            ! has dimension(itel,*) according to MSC.Marc 2012 Manual D, but we alway assume dimension(3,3)
+  real(pREAL),   dimension(3,3),         intent(in) :: &                                            ! has dimension(itel,*) according to MSC.Marc 2012 Manual D, but we alway assume dimension(3,3)
     ffn, &                                                                                          !< deformation gradient at t=n
     ffn1                                                                                            !< deformation gradient at t=n+1
-  real(pReal),   dimension(itel,*),      intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
+  real(pREAL),   dimension(itel,*),      intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
     frotn, &                                                                                        !< rotation tensor at t=n
     eigvn, &                                                                                        !< i principal direction components for j eigenvalues at t=n
     frotn1, &                                                                                       !< rotation tensor at t=n+1
     eigvn1                                                                                          !< i principal direction components for j eigenvalues at t=n+1
-  real(pReal),   dimension(ndeg,*),      intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
+  real(pREAL),   dimension(ndeg,*),      intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
     disp, &                                                                                         !< incremental displacements
     dispt                                                                                           !< displacements at t=n (at assembly, lovl=4) and displacements at t=n+1 (at stress recovery, lovl=6)
-  real(pReal),   dimension(ncrd,*),      intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
+  real(pREAL),   dimension(ncrd,*),      intent(in) :: &                                            ! according to MSC.Marc 2012 Manual D
     coord                                                                                           !< coordinates
-  real(pReal),   dimension(*),           intent(inout) :: &                                         ! according to MSC.Marc 2012 Manual D
+  real(pREAL),   dimension(*),           intent(inout) :: &                                         ! according to MSC.Marc 2012 Manual D
     t                                                                                               !< state variables (comes in at t=n, must be updated to have state variables at t=n+1)
-  real(pReal),   dimension(ndi+nshear),  intent(out) :: &                                           ! has dimension(*) according to MSC.Marc 2012 Manual D, but we need to loop over it
+  real(pREAL),   dimension(ndi+nshear),  intent(out) :: &                                           ! has dimension(*) according to MSC.Marc 2012 Manual D, but we need to loop over it
     s, &                                                                                            !< stress - should be updated by user
     g                                                                                               !< change in stress due to temperature effects
-  real(pReal),   dimension(ngens,ngens), intent(out) :: &                                           ! according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(ngens,*)
+  real(pREAL),   dimension(ngens,ngens), intent(out) :: &                                           ! according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(ngens,*)
     d                                                                                               !< stress-strain law to be formed
 
 !--------------------------------------------------------------------------------------------------
@@ -269,17 +269,17 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
 #include QUOTE(PASTE(include/creeps,MARC4DAMASK))                                                   ! creeps is needed for timinc (time increment)
 
   logical :: cutBack
-  real(pReal), dimension(6) ::   stress
-  real(pReal), dimension(6,6) :: ddsdde
+  real(pREAL), dimension(6) ::   stress
+  real(pREAL), dimension(6,6) :: ddsdde
   integer :: computationMode, i, node, CPnodeID
   integer(pI32) :: defaultNumThreadsInt                                                             !< default value set by Marc
 
   integer, save :: &
     theInc       = -1, &                                                                            !< needs description
     lastLovl     =  0                                                                               !< lovl in previous call to marc hypela2
-  real(pReal), save :: &
-    theTime      = 0.0_pReal, &                                                                     !< needs description
-    theDelta     = 0.0_pReal
+  real(pREAL), save :: &
+    theTime      = 0.0_pREAL, &                                                                     !< needs description
+    theDelta     = 0.0_pREAL
   logical, save :: &
     lastIncConverged  = .false., &                                                                  !< needs description
     outdatedByNewInc  = .false., &                                                                  !< needs description
@@ -351,8 +351,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
 
   d = ddsdde(1:ngens,1:ngens)
   s = stress(1:ndi+nshear)
-  g = 0.0_pReal
-  if (symmetricSolver) d = 0.5_pReal*(d+transpose(d))
+  g = 0.0_pREAL
+  if (symmetricSolver) d = 0.5_pREAL*(d+transpose(d))
 
   call omp_set_num_threads(defaultNumThreadsInt)                                                    ! reset number of threads to stored default value
 
@@ -368,18 +368,18 @@ subroutine flux(f,ts,n,time)
   use discretization_Marc
 
   implicit none(type,external)
-  real(pReal),   dimension(6),  intent(in) :: &
+  real(pREAL),   dimension(6),  intent(in) :: &
     ts
   integer(pI64), dimension(10), intent(in) :: &
     n
-  real(pReal),                  intent(in) :: &
+  real(pREAL),                  intent(in) :: &
     time
-  real(pReal),   dimension(2),  intent(out) :: &
+  real(pREAL),   dimension(2),  intent(out) :: &
     f
 
 
   f(1) = homogenization_f_T(discretization_Marc_FEM2DAMASK_cell(int(n(3)),int(n(1))))
-  f(2) = 0.0_pReal
+  f(2) = 0.0_pREAL
 
  end subroutine flux
 
@@ -402,7 +402,7 @@ subroutine uedinc(inc,incsub)
 
   integer :: n, nqncomp, nqdatatype
   integer, save :: inc_written
-  real(pReal), allocatable, dimension(:,:) :: d_n
+  real(pREAL), allocatable, dimension(:,:) :: d_n
 #include QUOTE(PASTE(include/creeps,MARC4DAMASK))                                                   ! creeps is needed for timinc (time increment)
 
 
@@ -411,7 +411,7 @@ subroutine uedinc(inc,incsub)
     do n = lbound(discretization_Marc_FEM2DAMASK_node,1), ubound(discretization_Marc_FEM2DAMASK_node,1)
       if (discretization_Marc_FEM2DAMASK_node(n) /= -1) then
         call nodvar(1,n,d_n(1:3,discretization_Marc_FEM2DAMASK_node(n)),nqncomp,nqdatatype)
-        if (nqncomp == 2) d_n(3,discretization_Marc_FEM2DAMASK_node(n)) = 0.0_pReal
+        if (nqncomp == 2) d_n(3,discretization_Marc_FEM2DAMASK_node(n)) = 0.0_pREAL
       end if
     end do
 

src/Marc/discretization_Marc.f90

@@ -20,7 +20,7 @@ module discretization_Marc
   implicit none(type,external)
   private
 
-  real(pReal),                         public, protected :: &
+  real(pREAL),                         public, protected :: &
     mesh_unitlength                                                                                 !< physical length of one unit in mesh MD: needs systematic_name
 
   integer,  dimension(:), allocatable, public, protected :: &
@@ -51,7 +51,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine discretization_Marc_init
 
-  real(pReal), dimension(:,:),     allocatable :: &
+  real(pREAL), dimension(:,:),     allocatable :: &
    node0_elem, &                                                                                    !< node x,y,z coordinates (initially!)
    node0_cell
   type(tElement) :: elem
@@ -61,11 +61,11 @@ subroutine discretization_Marc_init
   integer:: &
     Nelems                                                                                          !< total number of elements in the mesh
 
-  real(pReal), dimension(:,:),     allocatable :: &
+  real(pREAL), dimension(:,:),     allocatable :: &
     IP_reshaped
   integer,     dimension(:,:),     allocatable :: &
     connectivity_elem
-  real(pReal), dimension(:,:,:,:), allocatable :: &
+  real(pREAL), dimension(:,:,:,:), allocatable :: &
     unscaledNormals
 
   type(tDict), pointer :: &
@@ -75,8 +75,8 @@ subroutine discretization_Marc_init
   print'(/,a)', ' <<<+-  discretization_Marc init  -+>>>'; flush(6)
 
   num_commercialFEM => config_numerics%get_dict('commercialFEM',defaultVal = emptyDict)
-  mesh_unitlength = num_commercialFEM%get_asReal('unitlength',defaultVal=1.0_pReal)                 ! set physical extent of a length unit in mesh
-  if (mesh_unitlength <= 0.0_pReal) call IO_error(301,'unitlength')
+  mesh_unitlength = num_commercialFEM%get_asReal('unitlength',defaultVal=1.0_pREAL)                 ! set physical extent of a length unit in mesh
+  if (mesh_unitlength <= 0.0_pREAL) call IO_error(301,'unitlength')
 
   call inputRead(elem,node0_elem,connectivity_elem,materialAt)
   nElems = size(connectivity_elem,2)
@@ -113,9 +113,9 @@ end subroutine discretization_Marc_init
 !--------------------------------------------------------------------------------------------------
 subroutine discretization_Marc_updateNodeAndIpCoords(d_n)
 
-  real(pReal), dimension(:,:), intent(in)  :: d_n
+  real(pREAL), dimension(:,:), intent(in)  :: d_n
 
-  real(pReal), dimension(:,:), allocatable :: node_cell
+  real(pREAL), dimension(:,:), allocatable :: node_cell
 
 
   node_cell = buildCellNodes(discretization_NodeCoords0(1:3,1:maxval(discretization_Marc_FEM2DAMASK_node)) + d_n)
@@ -134,7 +134,7 @@ function discretization_Marc_FEM2DAMASK_cell(IP_FEM,elem_FEM) result(cell)
   integer, intent(in) :: IP_FEM, elem_FEM
   integer :: cell
 
-  real(pReal), dimension(:,:), allocatable :: node_cell
+  real(pREAL), dimension(:,:), allocatable :: node_cell
 
 
   cell = (discretization_Marc_FEM2DAMASK_elem(elem_FEM)-1)*discretization_nIPs + IP_FEM
@@ -155,7 +155,7 @@ subroutine writeGeometry(elem, &
   integer, dimension(:,:),     intent(in) :: &
     connectivity_elem, &
     connectivity_cell_reshaped
-  real(pReal), dimension(:,:), intent(in) :: &
+  real(pREAL), dimension(:,:), intent(in) :: &
     coordinates_nodes, &
     coordinates_points
 
@@ -187,7 +187,7 @@ end subroutine writeGeometry
 subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt)
 
   type(tElement), intent(out) :: elem
-  real(pReal), dimension(:,:), allocatable, intent(out) :: &
+  real(pREAL), dimension(:,:), allocatable, intent(out) :: &
     node0_elem                                                                                      !< node x,y,z coordinates (initially!)
   integer, dimension(:,:),     allocatable, intent(out) :: &
     connectivity_elem
@@ -535,7 +535,7 @@ end subroutine inputRead_mapNodes
 subroutine inputRead_elemNodes(nodes, &
                                nNode,fileContent)
 
-  real(pReal), allocatable,  dimension(:,:), intent(out) :: nodes
+  real(pREAL), allocatable,  dimension(:,:), intent(out) :: nodes
   integer,                                   intent(in)  :: nNode
   character(len=*),            dimension(:), intent(in)  :: fileContent                             !< file content, separated per lines
 
@@ -914,8 +914,8 @@ end subroutine buildCells
 !--------------------------------------------------------------------------------------------------
 pure function buildCellNodes(node_elem)
 
-  real(pReal),               dimension(:,:), intent(in)  :: node_elem                               !< element nodes
-  real(pReal),               dimension(:,:), allocatable :: buildCellNodes                          !< cell node coordinates
+  real(pREAL),               dimension(:,:), intent(in)  :: node_elem                               !< element nodes
+  real(pREAL),               dimension(:,:), allocatable :: buildCellNodes                          !< cell node coordinates
 
   integer :: i, j, k, n
 
@@ -927,13 +927,13 @@ pure function buildCellNodes(node_elem)
   do i = 1, size(cellNodeDefinition)
     do j = 1, size(cellNodeDefinition(i)%parents,1)
       n = n+1
-      buildCellNodes(:,n) = 0.0_pReal
+      buildCellNodes(:,n) = 0.0_pREAL
       do k = 1, size(cellNodeDefinition(i)%parents,2)
         buildCellNodes(:,n) = buildCellNodes(:,n) &
                             + buildCellNodes(:,cellNodeDefinition(i)%parents(j,k)) &
-                            * real(cellNodeDefinition(i)%weights(j,k),pReal)
+                            * real(cellNodeDefinition(i)%weights(j,k),pREAL)
       end do
-      buildCellNodes(:,n) = buildCellNodes(:,n)/real(sum(cellNodeDefinition(i)%weights(j,:)),pReal)
+      buildCellNodes(:,n) = buildCellNodes(:,n)/real(sum(cellNodeDefinition(i)%weights(j,:)),pREAL)
     end do
   end do
 
@@ -945,8 +945,8 @@ end function buildCellNodes
 !--------------------------------------------------------------------------------------------------
 pure function buildIPcoordinates(node_cell)
 
-  real(pReal), dimension(:,:), intent(in)  :: node_cell                                             !< cell node coordinates
-  real(pReal), dimension(:,:), allocatable :: buildIPcoordinates                                    !< cell-center/IP coordinates
+  real(pREAL), dimension(:,:), intent(in)  :: node_cell                                             !< cell node coordinates
+  real(pREAL), dimension(:,:), allocatable :: buildIPcoordinates                                    !< cell-center/IP coordinates
 
   integer, dimension(:,:), allocatable :: connectivity_cell_reshaped
   integer :: i, n, NcellNodesPerCell,Ncells
@@ -959,12 +959,12 @@ pure function buildIPcoordinates(node_cell)
   allocate(buildIPcoordinates(3,Ncells))
 
   do i = 1, size(connectivity_cell_reshaped,2)
-    buildIPcoordinates(:,i) = 0.0_pReal
+    buildIPcoordinates(:,i) = 0.0_pREAL
     do n = 1, size(connectivity_cell_reshaped,1)
       buildIPcoordinates(:,i) = buildIPcoordinates(:,i) &
                               + node_cell(:,connectivity_cell_reshaped(n,i))
     end do
-    buildIPcoordinates(:,i) = buildIPcoordinates(:,i)/real(size(connectivity_cell_reshaped,1),pReal)
+    buildIPcoordinates(:,i) = buildIPcoordinates(:,i)/real(size(connectivity_cell_reshaped,1),pREAL)
   end do
 
 end function buildIPcoordinates
@@ -978,10 +978,10 @@ end function buildIPcoordinates
 pure function IPvolume(elem,node)
 
   type(tElement),                intent(in) :: elem
-  real(pReal), dimension(:,:),   intent(in) :: node
+  real(pREAL), dimension(:,:),   intent(in) :: node
 
-  real(pReal), dimension(elem%nIPs,size(connectivity_cell,3)) :: IPvolume
-  real(pReal), dimension(3) :: x0,x1,x2,x3,x4,x5,x6,x7
+  real(pREAL), dimension(elem%nIPs,size(connectivity_cell,3)) :: IPvolume
+  real(pREAL), dimension(3) :: x0,x1,x2,x3,x4,x5,x6,x7
 
   integer :: e,i
 
@@ -1022,7 +1022,7 @@ pure function IPvolume(elem,node)
           IPvolume(i,e) = dot_product((x7-x1)+(x6-x0),math_cross((x7-x2),        (x3-x0))) &
                         + dot_product((x6-x0),        math_cross((x7-x2)+(x5-x0),(x7-x4))) &
                         + dot_product((x7-x1),        math_cross((x5-x0),        (x7-x4)+(x3-x0)))
-          IPvolume(i,e) = IPvolume(i,e)/12.0_pReal
+          IPvolume(i,e) = IPvolume(i,e)/12.0_pREAL
       end select
     end do
   end do
@@ -1037,11 +1037,11 @@ pure function IPareaNormal(elem,nElem,node)
 
   type(tElement),                intent(in) :: elem
   integer,                       intent(in) :: nElem
-  real(pReal), dimension(:,:),   intent(in) :: node
+  real(pREAL), dimension(:,:),   intent(in) :: node
 
-  real(pReal), dimension(3,elem%nIPneighbors,elem%nIPs,nElem) :: ipAreaNormal
+  real(pREAL), dimension(3,elem%nIPneighbors,elem%nIPs,nElem) :: ipAreaNormal
 
-  real(pReal), dimension (3,size(elem%cellFace,1)) :: nodePos
+  real(pREAL), dimension (3,size(elem%cellFace,1)) :: nodePos
   integer :: e,i,f,n,m
 
   m = size(elem%cellFace,1)
@@ -1055,7 +1055,7 @@ pure function IPareaNormal(elem,nElem,node)
           case (1,2)                                                                                ! 2D 3 or 4 node
             IPareaNormal(1,f,i,e) =   nodePos(2,2) - nodePos(2,1)                                   ! x_normal =  y_connectingVector
             IPareaNormal(2,f,i,e) = -(nodePos(1,2) - nodePos(1,1))                                  ! y_normal = -x_connectingVector
-            IPareaNormal(3,f,i,e) = 0.0_pReal
+            IPareaNormal(3,f,i,e) = 0.0_pREAL
           case (3)                                                                                  ! 3D 4node
             IPareaNormal(1:3,f,i,e) = math_cross(nodePos(1:3,2) - nodePos(1:3,1), &
                                                  nodePos(1:3,3) - nodePos(1:3,1))
@@ -1063,11 +1063,11 @@ pure function IPareaNormal(elem,nElem,node)
             ! Get the normal of the quadrilateral face as the average of four normals of triangular
             ! subfaces. Since the face consists only of two triangles, the sum has to be divided
             ! by two. This procedure tries to compensate for probable non-planar cell surfaces
-            IPareaNormal(1:3,f,i,e) = 0.0_pReal
+            IPareaNormal(1:3,f,i,e) = 0.0_pREAL
             do n = 1, m
               IPareaNormal(1:3,f,i,e) = IPareaNormal(1:3,f,i,e) &
                                       + math_cross(nodePos(1:3,mod(n+0,m)+1) - nodePos(1:3,n), &
-                                                   nodePos(1:3,mod(n+1,m)+1) - nodePos(1:3,n)) * 0.5_pReal
+                                                   nodePos(1:3,mod(n+1,m)+1) - nodePos(1:3,n)) * 0.5_pREAL
             end do
         end select
       end do

src/Marc/materialpoint_Marc.f90

@@ -27,11 +27,11 @@ module materialpoint_Marc
   implicit none(type,external)
   private
 
-  real(pReal), dimension (:,:,:),   allocatable, private :: &
+  real(pREAL), dimension (:,:,:),   allocatable, private :: &
     materialpoint_cs                                                                                !< Cauchy stress
-  real(pReal), dimension (:,:,:,:), allocatable, private :: &
+  real(pREAL), dimension (:,:,:,:), allocatable, private :: &
     materialpoint_dcsdE                                                                             !< Cauchy stress tangent
-  real(pReal), dimension (:,:,:,:), allocatable, private :: &
+  real(pREAL), dimension (:,:,:,:), allocatable, private :: &
     materialpoint_dcsdE_knownGood                                                                   !< known good tangent
 
   integer,                                       public :: &
@@ -95,9 +95,9 @@ subroutine materialpoint_init()
 
   print'(/,1x,a)', '<<<+-  materialpoint init  -+>>>'; flush(IO_STDOUT)
 
-  allocate(materialpoint_cs(               6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)
-  allocate(materialpoint_dcsdE(          6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)
-  allocate(materialpoint_dcsdE_knownGood(6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)
+  allocate(materialpoint_cs(               6,discretization_nIPs,discretization_Nelems), source= 0.0_pREAL)
+  allocate(materialpoint_dcsdE(          6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pREAL)
+  allocate(materialpoint_dcsdE_knownGood(6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pREAL)
 
 
 end subroutine materialpoint_init
@@ -110,25 +110,25 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
 
   integer, intent(in) ::                              elFE, &                                       !< FE element number
                                                       ip                                            !< integration point number
-  real(pReal), intent(in) ::                          dt                                            !< time increment
-  real(pReal), dimension (3,3), intent(in) ::         ffn, &                                        !< deformation gradient for t=t0
+  real(pREAL), intent(in) ::                          dt                                            !< time increment
+  real(pREAL), dimension (3,3), intent(in) ::         ffn, &                                        !< deformation gradient for t=t0
                                                       ffn1                                          !< deformation gradient for t=t1
   integer, intent(in) ::                              mode                                          !< computation mode  1: regular computation plus aging of results
-  real(pReal), intent(in) ::                          temperature_inp                               !< temperature
-  real(pReal), dimension(6), intent(out) ::           cauchyStress                                  !< stress as 6 vector
-  real(pReal), dimension(6,6), intent(out) ::         jacobian                                      !< jacobian as 66 tensor (Consistent tangent dcs/dE)
+  real(pREAL), intent(in) ::                          temperature_inp                               !< temperature
+  real(pREAL), dimension(6), intent(out) ::           cauchyStress                                  !< stress as 6 vector
+  real(pREAL), dimension(6,6), intent(out) ::         jacobian                                      !< jacobian as 66 tensor (Consistent tangent dcs/dE)
 
-  real(pReal)                                         J_inverse, &                                  ! inverse of Jacobian
+  real(pREAL)                                         J_inverse, &                                  ! inverse of Jacobian
                                                       rnd
-  real(pReal), dimension (3,3) ::                     Kirchhoff                                     ! Piola-Kirchhoff stress
-  real(pReal), dimension (3,3,3,3) ::                 H_sym, &
+  real(pREAL), dimension (3,3) ::                     Kirchhoff                                     ! Piola-Kirchhoff stress
+  real(pREAL), dimension (3,3,3,3) ::                 H_sym, &
                                                       H
 
   integer                                             elCP, &                                       ! crystal plasticity element number
                                                       i, j, k, l, m, n, ph, homog, mySource,ce
 
-  real(pReal), parameter ::                          ODD_STRESS    = 1e15_pReal, &                  !< return value for stress if terminallyIll
-                                                     ODD_JACOBIAN  = 1e50_pReal                     !< return value for jacobian if terminallyIll
+  real(pREAL), parameter ::                          ODD_STRESS    = 1e15_pREAL, &                  !< return value for stress if terminallyIll
+                                                     ODD_JACOBIAN  = 1e50_pREAL                     !< return value for jacobian if terminallyIll
 
 
   elCP = discretization_Marc_FEM2DAMASK_elem(elFE)
@@ -149,7 +149,7 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
 
     validCalculation: if (terminallyIll) then
       call random_number(rnd)
-      if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
+      if (rnd < 0.5_pREAL) rnd = rnd - 1.0_pREAL
       materialpoint_cs(1:6,ip,elCP)        = ODD_STRESS * rnd
       materialpoint_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6)
 
@@ -161,7 +161,7 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
       terminalIllness: if (terminallyIll) then
 
         call random_number(rnd)
-        if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
+        if (rnd < 0.5_pREAL) rnd = rnd - 1.0_pREAL
         materialpoint_cs(1:6,ip,elCP)        = ODD_STRESS * rnd
         materialpoint_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6)
 
@@ -169,22 +169,22 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
 
         ! translate from P to sigma
         Kirchhoff = matmul(homogenization_P(1:3,1:3,ce), transpose(homogenization_F(1:3,1:3,ce)))
-        J_inverse  = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ce))
+        J_inverse  = 1.0_pREAL / math_det33(homogenization_F(1:3,1:3,ce))
         materialpoint_cs(1:6,ip,elCP) = math_sym33to6(J_inverse * Kirchhoff,weighted=.false.)
 
         !  translate from dP/dF to dCS/dE
-        H = 0.0_pReal
+        H = 0.0_pREAL
         do i=1,3; do j=1,3; do k=1,3; do l=1,3; do m=1,3; do n=1,3
           H(i,j,k,l) = H(i,j,k,l) &
                      +  homogenization_F(j,m,ce) * homogenization_F(l,n,ce) &
                                                  * homogenization_dPdF(i,m,k,n,ce) &
                      -  math_delta(j,l) * homogenization_F(i,m,ce) * homogenization_P(k,m,ce) &
-                     +  0.5_pReal * (  Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
+                     +  0.5_pREAL * (  Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
                                      + Kirchhoff(j,k)*math_delta(i,l) + Kirchhoff(i,l)*math_delta(j,k))
         end do; end do; end do; end do; end do; end do
 
         forall(i=1:3, j=1:3,k=1:3,l=1:3) &
-          H_sym(i,j,k,l) = 0.25_pReal * (H(i,j,k,l) + H(j,i,k,l) + H(i,j,l,k) + H(j,i,l,k))
+          H_sym(i,j,k,l) = 0.25_pREAL * (H(i,j,k,l) + H(j,i,k,l) + H(i,j,l,k) + H(j,i,l,k))
 
         materialpoint_dcsde(1:6,1:6,ip,elCP) = math_sym3333to66(J_inverse * H_sym,weighted=.false.)
 
@@ -193,7 +193,7 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
 
   end if
 
-  if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pReal)) &
+  if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pREAL)) &
     call IO_warning(601,label1='element (CP)',ID1=elCP,label2='IP',ID2=ip)
 
   cauchyStress = materialpoint_cs   (1:6,    ip,elCP)
@@ -219,7 +219,7 @@ end subroutine materialpoint_forward
 subroutine materialpoint_result(inc,time)
 
   integer,     intent(in) :: inc
-  real(pReal), intent(in) :: time
+  real(pREAL), intent(in) :: time
 
   call result_openJobFile()
   call result_addIncrement(inc,time)

src/YAML_types.f90

@@ -183,7 +183,7 @@ subroutine selfTest()
     s = '1'
     if (s%asInt() /= 1)                error stop 'tScalar_asInt'
     if (s_pointer%asInt() /= 1)        error stop 'tScalar_asInt(pointer)'
-    if (dNeq(s%asReal(),1.0_pReal))    error stop 'tScalar_asReal'
+    if (dNeq(s%asReal(),1.0_pREAL))    error stop 'tScalar_asReal'
     s = 'true'
     if (.not. s%asBool())              error stop 'tScalar_asBool'
     if (.not. s_pointer%asBool())      error stop 'tScalar_asBool(pointer)'
@@ -209,11 +209,11 @@ subroutine selfTest()
     call l%append(s1)
     call l%append(s2)
     if (l%length /= 2)                                 error stop 'tList%len'
-    if (dNeq(l%get_asReal(1),1.0_pReal))               error stop 'tList_get_asReal'
+    if (dNeq(l%get_asReal(1),1.0_pREAL))               error stop 'tList_get_asReal'
     if (l%get_asInt(1) /= 1)                           error stop 'tList_get_asInt'
     if (l%get_asStr(2) /= '2')                         error stop 'tList_get_asStr'
     if (any(l%as1dInt() /= [1,2]))                     error stop 'tList_as1dInt'
-    if (any(dNeq(l%as1dReal(),real([1.0,2.0],pReal)))) error stop 'tList_as1dReal'
+    if (any(dNeq(l%as1dReal(),real([1.0,2.0],pREAL)))) error stop 'tList_as1dReal'
     s1 = 'true'
     s2 = 'false'
     if (any(l%as1dBool() .neqv. [.true.,.false.]))     error stop 'tList_as1dBool'
@@ -253,7 +253,7 @@ subroutine selfTest()
     if (d%asFormattedStr() /= '{one-two: [1, 2], three: 3, four: 4}') &
                                                       error stop 'tDict_asFormattedStr'
     if (d%get_asInt('three') /= 3)                    error stop 'tDict_get_asInt'
-    if (dNeq(d%get_asReal('three'),3.0_pReal))        error stop 'tDict_get_asReal'
+    if (dNeq(d%get_asReal('three'),3.0_pREAL))        error stop 'tDict_get_asReal'
     if (d%get_asStr('three') /= '3')                  error stop 'tDict_get_asStr'
     if (any(d%get_as1dInt('one-two') /= [1,2]))       error stop 'tDict_get_as1dInt'
     call d%set('one-two',s4)
@@ -376,7 +376,7 @@ end function tNode_asDict
 function tScalar_asReal(self)
 
   class(tScalar), intent(in), target :: self
-  real(pReal) :: tScalar_asReal
+  real(pREAL) :: tScalar_asReal
 
 
   tScalar_asReal = IO_strAsReal(self%value)
@@ -481,7 +481,7 @@ end subroutine tList_append
 function tList_as1dReal(self)
 
   class(tList), intent(in), target :: self
-  real(pReal), dimension(:), allocatable :: tList_as1dReal
+  real(pREAL), dimension(:), allocatable :: tList_as1dReal
 
   integer :: i
   type(tItem),   pointer :: item
@@ -505,7 +505,7 @@ end function tList_as1dReal
 function tList_as2dReal(self)
 
   class(tList), intent(in), target :: self
-  real(pReal), dimension(:,:), allocatable :: tList_as2dReal
+  real(pREAL), dimension(:,:), allocatable :: tList_as2dReal
 
   integer :: i
   type(tList), pointer :: row_data
@@ -724,7 +724,7 @@ function tList_get_asReal(self,i) result(nodeAsReal)
 
   class(tList), intent(in) :: self
   integer,      intent(in) :: i
-  real(pReal) :: nodeAsReal
+  real(pREAL) :: nodeAsReal
 
   class(tScalar),  pointer :: scalar
 
@@ -742,7 +742,7 @@ function tList_get_as1dReal(self,i) result(nodeAs1dReal)
 
   class(tList), intent(in) :: self
   integer,      intent(in) :: i
-  real(pReal), dimension(:), allocatable :: nodeAs1dReal
+  real(pREAL), dimension(:), allocatable :: nodeAs1dReal
 
   class(tList),  pointer :: list
 
@@ -1124,8 +1124,8 @@ function tDict_get_asReal(self,k,defaultVal) result(nodeAsReal)
 
   class(tDict),     intent(in) :: self
   character(len=*), intent(in) :: k
-  real(pReal),      intent(in), optional :: defaultVal
-  real(pReal) :: nodeAsReal
+  real(pREAL),      intent(in), optional :: defaultVal
+  real(pREAL) :: nodeAsReal
 
   type(tScalar), pointer :: scalar
 
@@ -1149,9 +1149,9 @@ function tDict_get_as1dReal(self,k,defaultVal,requiredSize) result(nodeAs1dReal)
 
   class(tDict),     intent(in) :: self
   character(len=*), intent(in) :: k
-  real(pReal),      intent(in), dimension(:), optional :: defaultVal
+  real(pREAL),      intent(in), dimension(:), optional :: defaultVal
   integer,          intent(in),               optional :: requiredSize
-  real(pReal), dimension(:), allocatable :: nodeAs1dReal
+  real(pREAL), dimension(:), allocatable :: nodeAs1dReal
 
   type(tList), pointer :: list
 
@@ -1179,9 +1179,9 @@ function tDict_get_as2dReal(self,k,defaultVal,requiredShape) result(nodeAs2dReal
 
   class(tDict),     intent(in) :: self
   character(len=*), intent(in) :: k
-  real(pReal),      intent(in), dimension(:,:), optional :: defaultVal
+  real(pREAL),      intent(in), dimension(:,:), optional :: defaultVal
   integer,          intent(in), dimension(2),   optional :: requiredShape
-  real(pReal), dimension(:,:), allocatable :: nodeAs2dReal
+  real(pREAL), dimension(:,:), allocatable :: nodeAs2dReal
 
   type(tList), pointer :: list
 

src/constants.f90

@@ -8,9 +8,9 @@ module constants
   implicit none(type,external)
   public
 
-  real(pReal), parameter :: &
-    T_ROOM = 293.15_pReal, &                                                                        !< Room temperature (20°C) in K (https://en.wikipedia.org/wiki/ISO_1)
-    K_B = 1.380649e-23_pReal, &                                                                     !< Boltzmann constant in J/Kelvin (https://doi.org/10.1351/goldbook)
-    N_A = 6.02214076e23_pReal                                                                       !< Avogadro constant in 1/mol (https://doi.org/10.1351/goldbook)
+  real(pREAL), parameter :: &
+    T_ROOM = 293.15_pREAL, &                                                                        !< Room temperature (20°C) in K (https://en.wikipedia.org/wiki/ISO_1)
+    K_B = 1.380649e-23_pREAL, &                                                                     !< Boltzmann constant in J/Kelvin (https://doi.org/10.1351/goldbook)
+    N_A = 6.02214076e23_pREAL                                                                       !< Avogadro constant in 1/mol (https://doi.org/10.1351/goldbook)
 
 end module constants

src/discretization.f90

@@ -18,7 +18,7 @@ module discretization
   integer,     public, protected, dimension(:),   allocatable :: &
     discretization_materialAt                                                                       !ToDo: discretization_ID_material
 
-  real(pReal), public, protected, dimension(:,:), allocatable :: &
+  real(pREAL), public, protected, dimension(:,:), allocatable :: &
     discretization_IPcoords0, &
     discretization_IPcoords, &
     discretization_NodeCoords0, &
@@ -44,7 +44,7 @@ subroutine discretization_init(materialAt,&
 
   integer,     dimension(:),   intent(in) :: &
     materialAt
-  real(pReal), dimension(:,:), intent(in) :: &
+  real(pREAL), dimension(:,:), intent(in) :: &
     IPcoords0, &
     NodeCoords0
   integer, optional,           intent(in) :: &
@@ -78,7 +78,7 @@ end subroutine discretization_init
 !--------------------------------------------------------------------------------------------------
 subroutine discretization_result()
 
-  real(pReal), dimension(:,:), allocatable :: u
+  real(pREAL), dimension(:,:), allocatable :: u
 
   call result_closeGroup(result_addGroup('current/geometry'))
 
@@ -98,7 +98,7 @@ end subroutine discretization_result
 !--------------------------------------------------------------------------------------------------
 subroutine discretization_setIPcoords(IPcoords)
 
-  real(pReal), dimension(:,:), intent(in) :: IPcoords
+  real(pREAL), dimension(:,:), intent(in) :: IPcoords
 
   discretization_IPcoords = IPcoords
 
@@ -110,7 +110,7 @@ end subroutine discretization_setIPcoords
 !--------------------------------------------------------------------------------------------------
 subroutine discretization_setNodeCoords(NodeCoords)
 
-  real(pReal), dimension(:,:), intent(in) :: NodeCoords
+  real(pREAL), dimension(:,:), intent(in) :: NodeCoords
 
   discretization_NodeCoords = NodeCoords
 

src/geometry_plastic_nonlocal.f90

@@ -18,13 +18,13 @@ module geometry_plastic_nonlocal
   integer,     dimension(:,:,:,:), allocatable, protected :: &
     geometry_plastic_nonlocal_IPneighborhood                                                        !< 6 or less neighboring IPs as [element ID, IP ID, face ID that point to me]
 
-  real(pReal), dimension(:,:),     allocatable, protected :: &
+  real(pREAL), dimension(:,:),     allocatable, protected :: &
     geometry_plastic_nonlocal_IPvolume0                                                             !< volume associated with IP (initially!)
 
-  real(pReal), dimension(:,:,:),   allocatable, protected :: &
+  real(pREAL), dimension(:,:,:),   allocatable, protected :: &
     geometry_plastic_nonlocal_IParea0                                                               !< area of interface to neighboring IP (initially!)
 
-  real(pReal), dimension(:,:,:,:), allocatable, protected :: &
+  real(pREAL), dimension(:,:,:,:), allocatable, protected :: &
     geometry_plastic_nonlocal_IPareaNormal0                                                         !< area normal of interface to neighboring IP (initially!)
 
 
@@ -54,7 +54,7 @@ end subroutine geometry_plastic_nonlocal_setIPneighborhood
 !---------------------------------------------------------------------------------------------------
 subroutine geometry_plastic_nonlocal_setIPvolume(IPvolume)
 
-  real(pReal), dimension(:,:), intent(in) :: IPvolume
+  real(pREAL), dimension(:,:), intent(in) :: IPvolume
 
   geometry_plastic_nonlocal_IPvolume0 = IPvolume
 
@@ -67,7 +67,7 @@ end subroutine geometry_plastic_nonlocal_setIPvolume
 !---------------------------------------------------------------------------------------------------
 subroutine geometry_plastic_nonlocal_setIParea(IParea)
 
-  real(pReal), dimension(:,:,:), intent(in) :: IParea
+  real(pREAL), dimension(:,:,:), intent(in) :: IParea
 
   geometry_plastic_nonlocal_IParea0 = IParea
 
@@ -80,7 +80,7 @@ end subroutine geometry_plastic_nonlocal_setIParea
 !---------------------------------------------------------------------------------------------------
 subroutine geometry_plastic_nonlocal_setIPareaNormal(IPareaNormal)
 
-  real(pReal), dimension(:,:,:,:), intent(in) :: IPareaNormal
+  real(pREAL), dimension(:,:,:,:), intent(in) :: IPareaNormal
 
   geometry_plastic_nonlocal_IPareaNormal0 = IPareaNormal
 
@@ -117,7 +117,7 @@ subroutine geometry_plastic_nonlocal_result()
   call result_openJobFile()
 
   writeVolume: block
-    real(pReal), dimension(:), allocatable :: temp
+    real(pREAL), dimension(:), allocatable :: temp
     shp = shape(geometry_plastic_nonlocal_IPvolume0)
     temp = reshape(geometry_plastic_nonlocal_IPvolume0,[shp(1)*shp(2)])
     call result_writeDataset(temp,'geometry','v_0',&
@@ -125,7 +125,7 @@ subroutine geometry_plastic_nonlocal_result()
   end block writeVolume
 
   writeAreas: block
-    real(pReal), dimension(:,:), allocatable :: temp
+    real(pREAL), dimension(:,:), allocatable :: temp
     shp = shape(geometry_plastic_nonlocal_IParea0)
     temp = reshape(geometry_plastic_nonlocal_IParea0,[shp(1),shp(2)*shp(3)])
     call result_writeDataset(temp,'geometry','a_0',&
@@ -133,7 +133,7 @@ subroutine geometry_plastic_nonlocal_result()
   end block writeAreas
 
   writeNormals: block
-    real(pReal), dimension(:,:,:), allocatable :: temp
+    real(pREAL), dimension(:,:,:), allocatable :: temp
     shp = shape(geometry_plastic_nonlocal_IPareaNormal0)
     temp = reshape(geometry_plastic_nonlocal_IPareaNormal0,[shp(1),shp(2),shp(3)*shp(4)])
     call result_writeDataset(temp,'geometry','n_0',&

src/grid/DAMASK_grid.f90

@@ -40,7 +40,7 @@ program DAMASK_grid
     type(tRotation)          :: rot                                                                 !< rotation of BC
     type(tBoundaryCondition) :: stress, &                                                           !< stress BC
                                 deformation                                                         !< deformation BC (dot_F, F, or L)
-    real(pReal) ::              t, &                                                                !< length of increment
+    real(pREAL) ::              t, &                                                                !< length of increment
                                 r                                                                   !< ratio of geometric progression
     integer ::                  N, &                                                                !< number of increments
                                 f_out, &                                                            !< frequency of result writes
@@ -63,12 +63,12 @@ program DAMASK_grid
 ! loop variables, convergence etc.
   integer, parameter :: &
     subStepFactor = 2                                                                               !< for each substep, divide the last time increment by 2.0
-  real(pReal) :: &
-    t = 0.0_pReal, &                                                                                !< elapsed time
-    t_0 = 0.0_pReal, &                                                                              !< begin of interval
-    Delta_t = 1.0_pReal, &                                                                          !< current time interval
-    Delta_t_prev = 0.0_pReal, &                                                                     !< previous time interval
-    t_remaining = 0.0_pReal                                                                         !< remaining time of current load case
+  real(pREAL) :: &
+    t = 0.0_pREAL, &                                                                                !< elapsed time
+    t_0 = 0.0_pREAL, &                                                                              !< begin of interval
+    Delta_t = 1.0_pREAL, &                                                                          !< current time interval
+    Delta_t_prev = 0.0_pREAL, &                                                                     !< previous time interval
+    t_remaining = 0.0_pREAL                                                                         !< remaining time of current load case
   logical :: &
     guess, &                                                                                        !< guess along former trajectory
     stagIterate, &
@@ -234,14 +234,14 @@ program DAMASK_grid
           call getMaskedTensor(loadCases(l)%stress%values,loadCases(l)%stress%mask,step_mech%get_list(m))
 #endif
       end select
-      call loadCases(l)%rot%fromAxisAngle(step_mech%get_as1dReal('R',defaultVal = real([0.0,0.0,1.0,0.0],pReal)),degrees=.true.)
+      call loadCases(l)%rot%fromAxisAngle(step_mech%get_as1dReal('R',defaultVal = real([0.0,0.0,1.0,0.0],pREAL)),degrees=.true.)
     end do readMech
     if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/dot_F/F missing')
 
     step_discretization => load_step%get_dict('discretization')
     loadCases(l)%t = step_discretization%get_asReal('t')
     loadCases(l)%N = step_discretization%get_asInt  ('N')
-    loadCases(l)%r = step_discretization%get_asReal('r',defaultVal= 1.0_pReal)
+    loadCases(l)%r = step_discretization%get_asReal('r',defaultVal= 1.0_pREAL)
 
     loadCases(l)%f_restart = load_step%get_asInt('f_restart', defaultVal=huge(0))
     if (load_step%get_asStr('f_out',defaultVal='n/a') == 'none') then
@@ -279,7 +279,7 @@ program DAMASK_grid
           if (loadCases(l)%stress%mask(i,j)) then
             write(IO_STDOUT,'(2x,12a)',advance='no') '     x      '
           else
-            write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal
+            write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pREAL
           end if
           end do; write(IO_STDOUT,'(/)',advance='no')
         end do
@@ -288,13 +288,13 @@ program DAMASK_grid
         write(IO_STDOUT,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'R:',&
                  transpose(loadCases(l)%rot%asMatrix())
 
-      if (loadCases(l)%r <= 0.0_pReal) errorID = 833
-      if (loadCases(l)%t < 0.0_pReal)  errorID = 834
+      if (loadCases(l)%r <= 0.0_pREAL) errorID = 833
+      if (loadCases(l)%t < 0.0_pREAL)  errorID = 834
       if (loadCases(l)%N < 1)          errorID = 835
       if (loadCases(l)%f_out < 1)      errorID = 836
       if (loadCases(l)%f_restart < 1)  errorID = 839
 
-      if (dEq(loadCases(l)%r,1.0_pReal,1.e-9_pReal)) then
+      if (dEq(loadCases(l)%r,1.0_pREAL,1.e-9_pREAL)) then
         print'(2x,a)', 'r: 1 (constant step width)'
       else
         print'(2x,a,1x,f0.3)', 'r:', loadCases(l)%r
@@ -345,7 +345,7 @@ program DAMASK_grid
   writeUndeformed: if (CLI_restartInc < 1) then
     print'(/,1x,a)', '... writing initial configuration to file .................................'
     flush(IO_STDOUT)
-    call materialpoint_result(0,0.0_pReal)
+    call materialpoint_result(0,0.0_pREAL)
   end if writeUndeformed
 
   loadCaseLooping: do l = 1, size(loadCases)
@@ -358,13 +358,13 @@ program DAMASK_grid
 !--------------------------------------------------------------------------------------------------
 ! forwarding time
       Delta_t_prev = Delta_t                                                                        ! last time intervall that brought former inc to an end
-      if (dEq(loadCases(l)%r,1.0_pReal,1.e-9_pReal)) then                                           ! linear scale
-        Delta_t = loadCases(l)%t/real(loadCases(l)%N,pReal)
+      if (dEq(loadCases(l)%r,1.0_pREAL,1.e-9_pREAL)) then                                           ! linear scale
+        Delta_t = loadCases(l)%t/real(loadCases(l)%N,pREAL)
       else
         Delta_t = loadCases(l)%t * (loadCases(l)%r**(inc-1)-loadCases(l)%r**inc) &
-                                 / (1.0_pReal-loadCases(l)%r**loadCases(l)%N)
+                                 / (1.0_pREAL-loadCases(l)%r**loadCases(l)%N)
       end if
-      Delta_t = Delta_t * real(subStepFactor,pReal)**real(-cutBackLevel,pReal)                      ! depending on cut back level, decrease time step
+      Delta_t = Delta_t * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL)                      ! depending on cut back level, decrease time step
 
       skipping: if (totalIncsCounter <= CLI_restartInc) then                                  ! not yet at restart inc?
         t = t + Delta_t                                                                             ! just advance time, skip already performed calculation
@@ -450,7 +450,7 @@ program DAMASK_grid
             stepFraction = (stepFraction - 1) * subStepFactor                                       ! adjust to new denominator
             cutBackLevel = cutBackLevel + 1
             t = t - Delta_t
-            Delta_t = Delta_t/real(subStepFactor,pReal)                                             ! cut timestep
+            Delta_t = Delta_t/real(subStepFactor,pREAL)                                             ! cut timestep
             print'(/,1x,a)', 'cutting back '
           else                                                                                      ! no more options to continue
             if (worldrank == 0) close(statUnit)
@@ -513,7 +513,7 @@ contains
 
 subroutine getMaskedTensor(values,mask,tensor)
 
-  real(pReal), intent(out), dimension(3,3) :: values
+  real(pREAL), intent(out), dimension(3,3) :: values
   logical,     intent(out), dimension(3,3) :: mask
   type(tList), pointer :: tensor
 
@@ -521,7 +521,7 @@ subroutine getMaskedTensor(values,mask,tensor)
   integer :: i,j
 
 
-  values = 0.0_pReal
+  values = 0.0_pREAL
   do i = 1,3
     row => tensor%get_list(i)
     do j = 1,3

src/grid/VTI.f90

@@ -50,7 +50,7 @@ function VTI_readDataset_real(fileContent,label) result(dataset)
   character(len=*), intent(in) :: &
     label, &
     fileContent
-  real(pReal),  dimension(:), allocatable :: &
+  real(pREAL),  dimension(:), allocatable :: &
     dataset
 
   character(len=:), allocatable :: dataType, headerType, base64Str
@@ -143,7 +143,7 @@ subroutine VTI_readCellsSizeOrigin(cells,geomSize,origin, &
 
   integer,     dimension(3), intent(out) :: &
     cells                                                                                           ! # of cells (across all processes!)
-  real(pReal), dimension(3), intent(out) :: &
+  real(pREAL), dimension(3), intent(out) :: &
     geomSize, &                                                                                     ! size (across all processes!)
     origin                                                                                          ! origin (across all processes!)
   character(len=*),          intent(in) :: &
@@ -156,7 +156,7 @@ subroutine VTI_readCellsSizeOrigin(cells,geomSize,origin, &
 
 
   cells = -1
-  geomSize = -1.0_pReal
+  geomSize = -1.0_pREAL
 
   inFile = .false.
   inImage = .false.
@@ -198,11 +198,11 @@ end subroutine VTI_readCellsSizeOrigin
 subroutine cellsSizeOrigin(c,s,o,header)
 
   integer, dimension(3),     intent(out) :: c
-  real(pReal), dimension(3), intent(out) :: s,o
+  real(pREAL), dimension(3), intent(out) :: s,o
   character(len=*),          intent(in) :: header
 
   character(len=:), allocatable :: temp
-  real(pReal), dimension(3) :: delta
+  real(pREAL), dimension(3) :: delta
   integer :: i
 
 
@@ -217,7 +217,7 @@ subroutine cellsSizeOrigin(c,s,o,header)
 
   temp = getXMLValue(header,'Spacing')
   delta = [(IO_realValue(temp,IO_strPos(temp),i),i=1,3)]
-  s = delta * real(c,pReal)
+  s = delta * real(c,pREAL)
 
   temp = getXMLValue(header,'Origin')
   o = [(IO_realValue(temp,IO_strPos(temp),i),i=1,3)]
@@ -255,7 +255,7 @@ end function as_Int
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Interpret Base64 string in vtk XML file as real of kind pReal.
+!> @brief Interpret Base64 string in vtk XML file as real of kind pREAL.
 !--------------------------------------------------------------------------------------------------
 function as_real(base64Str,headerType,compressed,dataType)
 
@@ -264,18 +264,18 @@ function as_real(base64Str,headerType,compressed,dataType)
                                   dataType                                                          ! data type (Int32, Int64, Float32, Float64)
   logical,          intent(in) :: compressed                                                        ! indicate whether data is zlib compressed
 
-  real(pReal), dimension(:), allocatable :: as_real
+  real(pREAL), dimension(:), allocatable :: as_real
 
 
   select case(dataType)
     case('Int32')
-      as_real = real(prec_bytesToC_INT32_T(asBytes(base64Str,headerType,compressed)),pReal)
+      as_real = real(prec_bytesToC_INT32_T(asBytes(base64Str,headerType,compressed)),pREAL)
     case('Int64')
-      as_real = real(prec_bytesToC_INT64_T(asBytes(base64Str,headerType,compressed)),pReal)
+      as_real = real(prec_bytesToC_INT64_T(asBytes(base64Str,headerType,compressed)),pREAL)
     case('Float32')
-      as_real = real(prec_bytesToC_FLOAT  (asBytes(base64Str,headerType,compressed)),pReal)
+      as_real = real(prec_bytesToC_FLOAT  (asBytes(base64Str,headerType,compressed)),pREAL)
     case('Float64')
-      as_real = real(prec_bytesToC_DOUBLE (asBytes(base64Str,headerType,compressed)),pReal)
+      as_real = real(prec_bytesToC_DOUBLE (asBytes(base64Str,headerType,compressed)),pREAL)
     case default
       call IO_error(844,ext_msg='unknown data type: '//trim(dataType))
   end select

src/grid/discretization_grid.f90

@@ -35,9 +35,9 @@ module discretization_grid
   integer,                   public, protected :: &
     cells3, &                                                                                       !< (local) cells in 3rd direction
     cells3Offset                                                                                    !< (local) cells offset in 3rd direction
-  real(pReal), dimension(3), public, protected :: &
+  real(pREAL), dimension(3), public, protected :: &
     geomSize                                                                                        !< (global) physical size
-  real(pReal),               public, protected :: &
+  real(pREAL),               public, protected :: &
     size3, &                                                                                        !< (local) size in 3rd direction
     size3offset                                                                                     !< (local) size offset in 3rd direction
 
@@ -55,7 +55,7 @@ subroutine discretization_grid_init(restart)
 
   logical, intent(in) :: restart
 
-  real(pReal), dimension(3) :: &
+  real(pREAL), dimension(3) :: &
     mySize, &                                                                                       !< domain size of this process
     origin                                                                                          !< (global) distance to origin
   integer,     dimension(3) :: &
@@ -119,8 +119,8 @@ subroutine discretization_grid_init(restart)
 
   cells3       = int(z)
   cells3Offset = int(z_offset)
-  size3       = geomSize(3)*real(cells3,pReal)      /real(cells(3),pReal)
-  size3Offset = geomSize(3)*real(cells3Offset,pReal)/real(cells(3),pReal)
+  size3       = geomSize(3)*real(cells3,pREAL)      /real(cells(3),pREAL)
+  size3Offset = geomSize(3)*real(cells3Offset,pREAL)/real(cells(3),pREAL)
   myGrid = [cells(1:2),cells3]
   mySize = [geomSize(1:2),size3]
 
@@ -156,7 +156,7 @@ subroutine discretization_grid_init(restart)
 
 !--------------------------------------------------------------------------------------------------
 ! geometry information required by the nonlocal CP model
-  call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pReal)),j=1,product(myGrid))], &
+  call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pREAL)),j=1,product(myGrid))], &
                                                      [1,product(myGrid)]))
   call geometry_plastic_nonlocal_setIParea        (cellSurfaceArea(mySize,myGrid))
   call geometry_plastic_nonlocal_setIPareaNormal  (cellSurfaceNormal(product(myGrid)))
@@ -171,10 +171,10 @@ end subroutine discretization_grid_init
 function IPcoordinates0(cells,geomSize,cells3Offset)
 
   integer,     dimension(3), intent(in) :: cells                                                    ! cells (for this process!)
-  real(pReal), dimension(3), intent(in) :: geomSize                                                 ! size (for this process!)
+  real(pREAL), dimension(3), intent(in) :: geomSize                                                 ! size (for this process!)
   integer,                   intent(in) :: cells3Offset                                             ! cells(3) offset
 
-  real(pReal), dimension(3,product(cells))  :: ipCoordinates0
+  real(pREAL), dimension(3,product(cells))  :: ipCoordinates0
 
   integer :: &
     a,b,c, &
@@ -184,7 +184,7 @@ function IPcoordinates0(cells,geomSize,cells3Offset)
   i = 0
   do c = 1, cells(3); do b = 1, cells(2); do a = 1, cells(1)
     i = i + 1
-    IPcoordinates0(1:3,i) = geomSize/real(cells,pReal) * (real([a,b,cells3Offset+c],pReal) -0.5_pReal)
+    IPcoordinates0(1:3,i) = geomSize/real(cells,pREAL) * (real([a,b,cells3Offset+c],pREAL) -0.5_pREAL)
   end do; end do; end do
 
 end function IPcoordinates0
@@ -196,10 +196,10 @@ end function IPcoordinates0
 pure function nodes0(cells,geomSize,cells3Offset)
 
   integer,     dimension(3), intent(in) :: cells                                                    ! cells (for this process!)
-  real(pReal), dimension(3), intent(in) :: geomSize                                                 ! size (for this process!)
+  real(pREAL), dimension(3), intent(in) :: geomSize                                                 ! size (for this process!)
   integer,                   intent(in) :: cells3Offset                                             ! cells(3) offset
 
-  real(pReal), dimension(3,product(cells+1)) :: nodes0
+  real(pREAL), dimension(3,product(cells+1)) :: nodes0
 
   integer :: &
     a,b,c, &
@@ -208,7 +208,7 @@ pure function nodes0(cells,geomSize,cells3Offset)
   n = 0
   do c = 0, cells3; do b = 0, cells(2); do a = 0, cells(1)
     n = n + 1
-    nodes0(1:3,n) = geomSize/real(cells,pReal) * real([a,b,cells3Offset+c],pReal)
+    nodes0(1:3,n) = geomSize/real(cells,pREAL) * real([a,b,cells3Offset+c],pREAL)
   end do; end do; end do
 
 end function nodes0
@@ -219,15 +219,15 @@ end function nodes0
 !--------------------------------------------------------------------------------------------------
 pure function cellSurfaceArea(geomSize,cells)
 
-  real(pReal), dimension(3), intent(in) :: geomSize                                                 ! size (for this process!)
+  real(pREAL), dimension(3), intent(in) :: geomSize                                                 ! size (for this process!)
   integer,     dimension(3), intent(in) :: cells                                                    ! cells (for this process!)
 
-  real(pReal), dimension(6,1,product(cells)) :: cellSurfaceArea
+  real(pREAL), dimension(6,1,product(cells)) :: cellSurfaceArea
 
 
-  cellSurfaceArea(1:2,1,:) = geomSize(2)/real(cells(2),pReal) * geomSize(3)/real(cells(3),pReal)
-  cellSurfaceArea(3:4,1,:) = geomSize(3)/real(cells(3),pReal) * geomSize(1)/real(cells(1),pReal)
-  cellSurfaceArea(5:6,1,:) = geomSize(1)/real(cells(1),pReal) * geomSize(2)/real(cells(2),pReal)
+  cellSurfaceArea(1:2,1,:) = geomSize(2)/real(cells(2),pREAL) * geomSize(3)/real(cells(3),pREAL)
+  cellSurfaceArea(3:4,1,:) = geomSize(3)/real(cells(3),pREAL) * geomSize(1)/real(cells(1),pREAL)
+  cellSurfaceArea(5:6,1,:) = geomSize(1)/real(cells(1),pREAL) * geomSize(2)/real(cells(2),pREAL)
 
 end function cellSurfaceArea
 
@@ -239,14 +239,14 @@ pure function cellSurfaceNormal(nElems)
 
   integer, intent(in) :: nElems
 
-  real(pReal), dimension(3,6,1,nElems) :: cellSurfaceNormal
+  real(pREAL), dimension(3,6,1,nElems) :: cellSurfaceNormal
 
-  cellSurfaceNormal(1:3,1,1,:) = spread([+1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
-  cellSurfaceNormal(1:3,2,1,:) = spread([-1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
-  cellSurfaceNormal(1:3,3,1,:) = spread([ 0.0_pReal,+1.0_pReal, 0.0_pReal],2,nElems)
-  cellSurfaceNormal(1:3,4,1,:) = spread([ 0.0_pReal,-1.0_pReal, 0.0_pReal],2,nElems)
-  cellSurfaceNormal(1:3,5,1,:) = spread([ 0.0_pReal, 0.0_pReal,+1.0_pReal],2,nElems)
-  cellSurfaceNormal(1:3,6,1,:) = spread([ 0.0_pReal, 0.0_pReal,-1.0_pReal],2,nElems)
+  cellSurfaceNormal(1:3,1,1,:) = spread([+1.0_pREAL, 0.0_pREAL, 0.0_pREAL],2,nElems)
+  cellSurfaceNormal(1:3,2,1,:) = spread([-1.0_pREAL, 0.0_pREAL, 0.0_pREAL],2,nElems)
+  cellSurfaceNormal(1:3,3,1,:) = spread([ 0.0_pREAL,+1.0_pREAL, 0.0_pREAL],2,nElems)
+  cellSurfaceNormal(1:3,4,1,:) = spread([ 0.0_pREAL,-1.0_pREAL, 0.0_pREAL],2,nElems)
+  cellSurfaceNormal(1:3,5,1,:) = spread([ 0.0_pREAL, 0.0_pREAL,+1.0_pREAL],2,nElems)
+  cellSurfaceNormal(1:3,6,1,:) = spread([ 0.0_pREAL, 0.0_pREAL,-1.0_pREAL],2,nElems)
 
 end function cellSurfaceNormal
 
@@ -314,9 +314,9 @@ end function IPneighborhood
 function discretization_grid_getInitialCondition(label) result(ic)
 
   character(len=*), intent(in) :: label
-  real(pReal), dimension(cells(1),cells(2),cells3) :: ic
+  real(pREAL), dimension(cells(1),cells(2),cells3) :: ic
 
-  real(pReal), dimension(:), allocatable :: ic_global, ic_local
+  real(pREAL), dimension(:), allocatable :: ic_global, ic_local
   integer(MPI_INTEGER_KIND) :: err_MPI
 
   integer, dimension(worldsize) :: &

src/grid/grid_damage_spectral.f90

@@ -35,7 +35,7 @@ module grid_damage_spectral
   type :: tNumerics
     integer :: &
       itmax                                                                                         !< maximum number of iterations
-    real(pReal) :: &
+    real(pREAL) :: &
       phi_min, &                                                                                    !< non-zero residual damage
       eps_damage_atol, &                                                                            !< absolute tolerance for damage evolution
       eps_damage_rtol                                                                               !< relative tolerance for damage evolution
@@ -48,7 +48,7 @@ module grid_damage_spectral
 ! PETSc data
   SNES :: SNES_damage
   Vec  :: solution_vec
-  real(pReal), dimension(:,:,:), allocatable :: &
+  real(pREAL), dimension(:,:,:), allocatable :: &
     phi, &                                                                                          !< field of current damage
     phi_lastInc, &                                                                                  !< field of previous damage
     phi_stagInc                                                                                     !< field of staggered damage
@@ -56,8 +56,8 @@ module grid_damage_spectral
 !--------------------------------------------------------------------------------------------------
 ! reference diffusion tensor, mobility etc.
   integer                     :: totalIter = 0                                                      !< total iteration in current increment
-  real(pReal), dimension(3,3) :: K_ref
-  real(pReal)                 :: mu_ref
+  real(pREAL), dimension(3,3) :: K_ref
+  real(pREAL)                 :: mu_ref
 
   public :: &
     grid_damage_spectral_init, &
@@ -75,12 +75,12 @@ subroutine grid_damage_spectral_init()
   PetscInt, dimension(0:worldsize-1) :: localK
   integer :: i, j, k, ce
   DM :: damage_grid
-  real(pReal), dimension(:,:,:), pointer :: phi_PETSc
+  real(pREAL), dimension(:,:,:), pointer :: phi_PETSc
   Vec :: uBound, lBound
   integer(MPI_INTEGER_KIND) :: err_MPI
   PetscErrorCode :: err_PETSc
   integer(HID_T) :: fileHandle, groupHandle
-  real(pReal), dimension(1,product(cells(1:2))*cells3) :: tempN
+  real(pREAL), dimension(1,product(cells(1:2))*cells3) :: tempN
   type(tDict), pointer :: &
     num_grid, &
     num_generic
@@ -98,16 +98,16 @@ subroutine grid_damage_spectral_init()
 ! read numerical parameters and do sanity checks
   num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
   num%itmax           = num_grid%get_asInt   ('itmax',defaultVal=250)
-  num%eps_damage_atol = num_grid%get_asReal ('eps_damage_atol',defaultVal=1.0e-2_pReal)
-  num%eps_damage_rtol = num_grid%get_asReal ('eps_damage_rtol',defaultVal=1.0e-6_pReal)
+  num%eps_damage_atol = num_grid%get_asReal ('eps_damage_atol',defaultVal=1.0e-2_pREAL)
+  num%eps_damage_rtol = num_grid%get_asReal ('eps_damage_rtol',defaultVal=1.0e-6_pREAL)
 
   num_generic => config_numerics%get_dict('generic',defaultVal=emptyDict)
-  num%phi_min = num_generic%get_asReal('phi_min', defaultVal=1.0e-6_pReal)
+  num%phi_min = num_generic%get_asReal('phi_min', defaultVal=1.0e-6_pREAL)
 
-  if (num%phi_min < 0.0_pReal) call IO_error(301,ext_msg='phi_min')
+  if (num%phi_min < 0.0_pREAL) call IO_error(301,ext_msg='phi_min')
   if (num%itmax <= 1)                    call IO_error(301,ext_msg='itmax')
-  if (num%eps_damage_atol <= 0.0_pReal)  call IO_error(301,ext_msg='eps_damage_atol')
-  if (num%eps_damage_rtol <= 0.0_pReal)  call IO_error(301,ext_msg='eps_damage_rtol')
+  if (num%eps_damage_atol <= 0.0_pREAL)  call IO_error(301,ext_msg='eps_damage_atol')
+  if (num%eps_damage_rtol <= 0.0_pREAL)  call IO_error(301,ext_msg='eps_damage_rtol')
 
 !--------------------------------------------------------------------------------------------------
 ! set default and user defined options for PETSc
@@ -162,9 +162,9 @@ subroutine grid_damage_spectral_init()
     CHKERRQ(err_PETSc)
     call DMGetGlobalVector(damage_grid,uBound,err_PETSc)
     CHKERRQ(err_PETSc)
-    call VecSet(lBound,0.0_pReal,err_PETSc)
+    call VecSet(lBound,0.0_pREAL,err_PETSc)
     CHKERRQ(err_PETSc)
-    call VecSet(uBound,1.0_pReal,err_PETSc)
+    call VecSet(uBound,1.0_pREAL,err_PETSc)
     CHKERRQ(err_PETSc)
     call SNESVISetVariableBounds(SNES_damage,lBound,uBound,err_PETSc)                               ! variable bounds for variational inequalities
     CHKERRQ(err_PETSc)
@@ -208,7 +208,7 @@ end subroutine grid_damage_spectral_init
 !--------------------------------------------------------------------------------------------------
 function grid_damage_spectral_solution(Delta_t) result(solution)
 
-  real(pReal), intent(in) :: &
+  real(pREAL), intent(in) :: &
     Delta_t                                                                                         !< increment in time for current solution
   integer :: i, j, k, ce
   type(tSolutionState) :: solution
@@ -275,7 +275,7 @@ subroutine grid_damage_spectral_forward(cutBack)
 
   integer :: i, j, k, ce
   DM :: dm_local
-  real(pReal),  dimension(:,:,:), pointer :: phi_PETSc
+  real(pREAL),  dimension(:,:,:), pointer :: phi_PETSc
   PetscErrorCode :: err_PETSc
 
 
@@ -341,15 +341,15 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
 
   DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
     residual_subdomain
-  real(pReal), dimension(cells(1),cells(2),cells3), intent(in) :: &
+  real(pREAL), dimension(cells(1),cells(2),cells3), intent(in) :: &
     x_scal
-  real(pReal), dimension(cells(1),cells(2),cells3), intent(out) :: &
+  real(pREAL), dimension(cells(1),cells(2),cells3), intent(out) :: &
     r                                                                                               !< residual
   PetscObject :: dummy
   PetscErrorCode, intent(out) :: err_PETSc
 
   integer :: i, j, k, ce
-  real(pReal), dimension(3,cells(1),cells(2),cells3) :: vectorField
+  real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField
 
 
   phi = x_scal
@@ -384,8 +384,8 @@ subroutine updateReference()
   integer(MPI_INTEGER_KIND) :: err_MPI
 
 
-  K_ref = 0.0_pReal
-  mu_ref = 0.0_pReal
+  K_ref = 0.0_pREAL
+  mu_ref = 0.0_pREAL
   do ce = 1, product(cells(1:2))*cells3
     K_ref  = K_ref  + homogenization_K_phi(ce)
     mu_ref = mu_ref + homogenization_mu_phi(ce)

src/grid/grid_mech_FEM.f90

@@ -41,7 +41,7 @@ module grid_mechanical_FEM
     integer :: &
       itmin, &                                                                                      !< minimum number of iterations
       itmax                                                                                         !< maximum number of iterations
-    real(pReal) :: &
+    real(pREAL) :: &
       eps_div_atol, &                                                                               !< absolute tolerance for equilibrium
       eps_div_rtol, &                                                                               !< relative tolerance for equilibrium
       eps_stress_atol, &                                                                            !< absolute tolerance for fullfillment of stress BC
@@ -58,27 +58,27 @@ module grid_mechanical_FEM
 
 !--------------------------------------------------------------------------------------------------
 ! common pointwise data
-  real(pReal), dimension(:,:,:,:,:), allocatable :: F, P_current, F_lastInc
-  real(pReal) :: detJ
-  real(pReal), dimension(3)   :: delta
-  real(pReal), dimension(3,8) :: BMat
-  real(pReal), dimension(8,8) :: HGMat
+  real(pREAL), dimension(:,:,:,:,:), allocatable :: F, P_current, F_lastInc
+  real(pREAL) :: detJ
+  real(pREAL), dimension(3)   :: delta
+  real(pREAL), dimension(3,8) :: BMat
+  real(pREAL), dimension(8,8) :: HGMat
 
 !--------------------------------------------------------------------------------------------------
 ! stress, stiffness and compliance average etc.
-  real(pReal), dimension(3,3) :: &
-    F_aimDot = 0.0_pReal, &                                                                         !< assumed rate of average deformation gradient
+  real(pREAL), dimension(3,3) :: &
+    F_aimDot = 0.0_pREAL, &                                                                         !< assumed rate of average deformation gradient
     F_aim = math_I3, &                                                                              !< current prescribed deformation gradient
     F_aim_lastInc = math_I3, &                                                                      !< previous average deformation gradient
-    P_av = 0.0_pReal, &                                                                             !< average 1st Piola--Kirchhoff stress
-    P_aim = 0.0_pReal
+    P_av = 0.0_pREAL, &                                                                             !< average 1st Piola--Kirchhoff stress
+    P_aim = 0.0_pREAL
   character(len=:), allocatable :: incInfo                                                          !< time and increment information
-  real(pReal), dimension(3,3,3,3) :: &
-    C_volAvg = 0.0_pReal, &                                                                         !< current volume average stiffness
-    C_volAvgLastInc = 0.0_pReal, &                                                                  !< previous volume average stiffness
-    S = 0.0_pReal                                                                                   !< current compliance (filled up with zeros)
+  real(pREAL), dimension(3,3,3,3) :: &
+    C_volAvg = 0.0_pREAL, &                                                                         !< current volume average stiffness
+    C_volAvgLastInc = 0.0_pREAL, &                                                                  !< previous volume average stiffness
+    S = 0.0_pREAL                                                                                   !< current compliance (filled up with zeros)
 
-  real(pReal) :: &
+  real(pREAL) :: &
     err_BC                                                                                          !< deviation from stress BC
 
   integer :: &
@@ -98,19 +98,19 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine grid_mechanical_FEM_init
 
-  real(pReal), parameter :: HGCoeff = 0.0e-2_pReal
-  real(pReal), parameter, dimension(4,8) :: &
-    HGcomp = reshape([ 1.0_pReal, 1.0_pReal, 1.0_pReal,-1.0_pReal, &
-                       1.0_pReal,-1.0_pReal,-1.0_pReal, 1.0_pReal, &
-                      -1.0_pReal, 1.0_pReal,-1.0_pReal, 1.0_pReal, &
-                      -1.0_pReal,-1.0_pReal, 1.0_pReal,-1.0_pReal, &
-                      -1.0_pReal,-1.0_pReal, 1.0_pReal, 1.0_pReal, &
-                      -1.0_pReal, 1.0_pReal,-1.0_pReal,-1.0_pReal, &
-                       1.0_pReal,-1.0_pReal,-1.0_pReal,-1.0_pReal, &
-                       1.0_pReal, 1.0_pReal, 1.0_pReal, 1.0_pReal], [4,8])
-  real(pReal), dimension(3,3,3,3) :: devNull
-  real(pReal), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
-  real(pReal), dimension(3,product(cells(1:2))*cells3) :: temp3n
+  real(pREAL), parameter :: HGCoeff = 0.0e-2_pREAL
+  real(pREAL), parameter, dimension(4,8) :: &
+    HGcomp = reshape([ 1.0_pREAL, 1.0_pREAL, 1.0_pREAL,-1.0_pREAL, &
+                       1.0_pREAL,-1.0_pREAL,-1.0_pREAL, 1.0_pREAL, &
+                      -1.0_pREAL, 1.0_pREAL,-1.0_pREAL, 1.0_pREAL, &
+                      -1.0_pREAL,-1.0_pREAL, 1.0_pREAL,-1.0_pREAL, &
+                      -1.0_pREAL,-1.0_pREAL, 1.0_pREAL, 1.0_pREAL, &
+                      -1.0_pREAL, 1.0_pREAL,-1.0_pREAL,-1.0_pREAL, &
+                       1.0_pREAL,-1.0_pREAL,-1.0_pREAL,-1.0_pREAL, &
+                       1.0_pREAL, 1.0_pREAL, 1.0_pREAL, 1.0_pREAL], [4,8])
+  real(pREAL), dimension(3,3,3,3) :: devNull
+  real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
+  real(pREAL), dimension(3,product(cells(1:2))*cells3) :: temp3n
   PetscErrorCode :: err_PETSc
   integer(MPI_INTEGER_KIND) :: err_MPI
   PetscScalar, pointer, dimension(:,:,:,:) :: &
@@ -129,17 +129,17 @@ subroutine grid_mechanical_FEM_init
 ! read numerical parameters and do sanity checks
   num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
 
-  num%eps_div_atol    = num_grid%get_asReal('eps_div_atol',   defaultVal=1.0e-4_pReal)
-  num%eps_div_rtol    = num_grid%get_asReal('eps_div_rtol',   defaultVal=5.0e-4_pReal)
-  num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pReal)
-  num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pReal)
+  num%eps_div_atol    = num_grid%get_asReal('eps_div_atol',   defaultVal=1.0e-4_pREAL)
+  num%eps_div_rtol    = num_grid%get_asReal('eps_div_rtol',   defaultVal=5.0e-4_pREAL)
+  num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
+  num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
   num%itmin           = num_grid%get_asInt ('itmin',defaultVal=1)
   num%itmax           = num_grid%get_asInt ('itmax',defaultVal=250)
 
-  if (num%eps_div_atol <= 0.0_pReal)             extmsg = trim(extmsg)//' eps_div_atol'
-  if (num%eps_div_rtol < 0.0_pReal)              extmsg = trim(extmsg)//' eps_div_rtol'
-  if (num%eps_stress_atol <= 0.0_pReal)          extmsg = trim(extmsg)//' eps_stress_atol'
-  if (num%eps_stress_rtol < 0.0_pReal)           extmsg = trim(extmsg)//' eps_stress_rtol'
+  if (num%eps_div_atol <= 0.0_pREAL)             extmsg = trim(extmsg)//' eps_div_atol'
+  if (num%eps_div_rtol < 0.0_pREAL)              extmsg = trim(extmsg)//' eps_div_rtol'
+  if (num%eps_stress_atol <= 0.0_pREAL)          extmsg = trim(extmsg)//' eps_stress_atol'
+  if (num%eps_stress_rtol < 0.0_pREAL)           extmsg = trim(extmsg)//' eps_stress_rtol'
   if (num%itmax <= 1)                            extmsg = trim(extmsg)//' itmax'
   if (num%itmin > num%itmax .or. num%itmin < 1)  extmsg = trim(extmsg)//' itmin'
 
@@ -157,9 +157,9 @@ subroutine grid_mechanical_FEM_init
 
 !--------------------------------------------------------------------------------------------------
 ! allocate global fields
-  allocate(F (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
-  allocate(P_current (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
-  allocate(F_lastInc (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
+  allocate(F (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+  allocate(P_current (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+  allocate(F_lastInc (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
 
 !--------------------------------------------------------------------------------------------------
 ! initialize solver specific parts of PETSc
@@ -184,7 +184,7 @@ subroutine grid_mechanical_FEM_init
   CHKERRQ(err_PETSc)
   call DMsetUp(mechanical_grid,err_PETSc)
   CHKERRQ(err_PETSc)
-  call DMDASetUniformCoordinates(mechanical_grid,0.0_pReal,geomSize(1),0.0_pReal,geomSize(2),0.0_pReal,geomSize(3),err_PETSc)
+  call DMDASetUniformCoordinates(mechanical_grid,0.0_pREAL,geomSize(1),0.0_pREAL,geomSize(2),0.0_pREAL,geomSize(3),err_PETSc)
   CHKERRQ(err_PETSc)
   call DMCreateGlobalVector(mechanical_grid,solution_current,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -207,18 +207,18 @@ subroutine grid_mechanical_FEM_init
 
 !--------------------------------------------------------------------------------------------------
 ! init fields
-  call VecSet(solution_current,0.0_pReal,err_PETSc)
+  call VecSet(solution_current,0.0_pREAL,err_PETSc)
   CHKERRQ(err_PETSc)
-  call VecSet(solution_lastInc,0.0_pReal,err_PETSc)
+  call VecSet(solution_lastInc,0.0_pREAL,err_PETSc)
   CHKERRQ(err_PETSc)
-  call VecSet(solution_rate   ,0.0_pReal,err_PETSc)
+  call VecSet(solution_rate   ,0.0_pREAL,err_PETSc)
   CHKERRQ(err_PETSc)
   call DMDAVecGetArrayF90(mechanical_grid,solution_current,u,err_PETSc)
   CHKERRQ(err_PETSc)
   call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
   CHKERRQ(err_PETSc)
 
-  delta = geomSize/real(cells,pReal)                                                                ! grid spacing
+  delta = geomSize/real(cells,pREAL)                                                                ! grid spacing
   detJ = product(delta)                                                                             ! cell volume
 
   BMat = reshape(real([-delta(1)**(-1),-delta(2)**(-1),-delta(3)**(-1), &
@@ -228,10 +228,10 @@ subroutine grid_mechanical_FEM_init
                        -delta(1)**(-1),-delta(2)**(-1), delta(3)**(-1), &
                         delta(1)**(-1),-delta(2)**(-1), delta(3)**(-1), &
                        -delta(1)**(-1), delta(2)**(-1), delta(3)**(-1), &
-                        delta(1)**(-1), delta(2)**(-1), delta(3)**(-1)],pReal), [3,8])/4.0_pReal    ! shape function derivative matrix
+                        delta(1)**(-1), delta(2)**(-1), delta(3)**(-1)],pREAL), [3,8])/4.0_pREAL    ! shape function derivative matrix
 
   HGMat = matmul(transpose(HGcomp),HGcomp) &
-        * HGCoeff*(delta(1)*delta(2) + delta(2)*delta(3) + delta(3)*delta(1))/16.0_pReal            ! hourglass stabilization matrix
+        * HGCoeff*(delta(1)*delta(2) + delta(2)*delta(3) + delta(3)*delta(1))/16.0_pREAL            ! hourglass stabilization matrix
 
 !--------------------------------------------------------------------------------------------------
 ! init fields
@@ -271,7 +271,7 @@ subroutine grid_mechanical_FEM_init
   call utilities_updateCoords(F)
   call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, &                            ! stress field, stress avg, global average of stiffness and (min+max)/2
                                       F, &                                                          ! target F
-                                      0.0_pReal)                                                    ! time increment
+                                      0.0_pREAL)                                                    ! time increment
   call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc)
   CHKERRQ(err_PETSc)
   call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
@@ -340,7 +340,7 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
   logical,                  intent(in) :: &
     cutBack, &
     guess
-  real(pReal),              intent(in) :: &
+  real(pREAL),              intent(in) :: &
     Delta_t_old, &
     Delta_t, &
     t_remaining                                                                                     !< remaining time of current load case
@@ -365,29 +365,29 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
   else
     C_volAvgLastInc    = C_volAvg
 
-    F_aimDot = merge(merge(.0_pReal,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pReal,guess) ! estimate deformation rate for prescribed stress components
+    F_aimDot = merge(merge(.0_pREAL,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pREAL,guess) ! estimate deformation rate for prescribed stress components
     F_aim_lastInc = F_aim
 
     !-----------------------------------------------------------------------------------------------
     ! calculate rate for aim
     if     (deformation_BC%myType=='L') then                                                        ! calculate F_aimDot from given L and current F
       F_aimDot = F_aimDot &
-               + matmul(merge(.0_pReal,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
+               + matmul(merge(.0_pREAL,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
     elseif (deformation_BC%myType=='dot_F') then                                                    ! F_aimDot is prescribed
       F_aimDot = F_aimDot &
-               + merge(.0_pReal,deformation_BC%values,deformation_BC%mask)
+               + merge(.0_pREAL,deformation_BC%values,deformation_BC%mask)
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
-               + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
+               + merge(.0_pREAL,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
     end if
 
     if (guess) then
-      call VecWAXPY(solution_rate,-1.0_pReal,solution_lastInc,solution_current,err_PETSc)
+      call VecWAXPY(solution_rate,-1.0_pREAL,solution_lastInc,solution_current,err_PETSc)
       CHKERRQ(err_PETSc)
-      call VecScale(solution_rate,1.0_pReal/Delta_t_old,err_PETSc)
+      call VecScale(solution_rate,1.0_pREAL/Delta_t_old,err_PETSc)
       CHKERRQ(err_PETSc)
     else
-      call VecSet(solution_rate,0.0_pReal,err_PETSc)
+      call VecSet(solution_rate,0.0_pREAL,err_PETSc)
       CHKERRQ(err_PETSc)
     end if
     call VecCopy(solution_current,solution_lastInc,err_PETSc)
@@ -402,9 +402,9 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
 ! update average and local deformation gradients
   F_aim = F_aim_lastInc + F_aimDot * Delta_t
   if (stress_BC%myType=='P')     P_aim = P_aim &
-                                       + merge(.0_pReal,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
+                                       + merge(.0_pREAL,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
   if (stress_BC%myType=='dot_P') P_aim = P_aim &
-                                       + merge(.0_pReal,stress_BC%values,stress_BC%mask)*Delta_t
+                                       + merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
 
   call VecAXPY(solution_current,Delta_t,solution_rate,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -493,7 +493,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,e
   SNESConvergedReason :: reason
   PetscObject :: dummy
   PetscErrorCode :: err_PETSc
-  real(pReal) :: &
+  real(pREAL) :: &
     err_div, &
     divTol, &
     BCTol
@@ -502,7 +502,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,e
   divTol = max(maxval(abs(P_av))*num%eps_div_rtol, num%eps_div_atol)
   BCTol  = max(maxval(abs(P_av))*num%eps_stress_rtol, num%eps_stress_atol)
 
-  if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pReal)) &
+  if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pREAL)) &
        .or. terminallyIll) then
     reason = 1
   elseif (totalIter >= num%itmax) then
@@ -534,14 +534,14 @@ subroutine formResidual(da_local,x_local, &
   PetscObject :: dummy
   PetscErrorCode :: err_PETSc
 
-  real(pReal), pointer,dimension(:,:,:,:) :: x_scal, r
-  real(pReal), dimension(8,3) :: x_elem,  f_elem
+  real(pREAL), pointer,dimension(:,:,:,:) :: x_scal, r
+  real(pREAL), dimension(8,3) :: x_elem,  f_elem
   PetscInt             :: i, ii, j, jj, k, kk, ctr, ele
   PetscInt :: &
     PETScIter, &
     nfuncs
   integer(MPI_INTEGER_KIND) :: err_MPI
-  real(pReal), dimension(3,3,3,3) :: devNull
+  real(pREAL), dimension(3,3,3,3) :: devNull
 
   call SNESGetNumberFunctionEvals(SNES_mechanical,nfuncs,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -556,7 +556,7 @@ subroutine formResidual(da_local,x_local, &
   newIteration: if (totalIter <= PETScIter) then
     totalIter = totalIter + 1
     print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax
-    if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+    if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
       print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
       'deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
     print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
@@ -590,7 +590,7 @@ subroutine formResidual(da_local,x_local, &
 !--------------------------------------------------------------------------------------------------
 ! stress BC handling
   F_aim = F_aim - math_mul3333xx33(S, P_av - P_aim)                                                 ! S = 0.0 for no bc
-  err_BC = maxval(abs(merge(.0_pReal,P_av - P_aim,params%stress_mask)))
+  err_BC = maxval(abs(merge(.0_pREAL,P_av - P_aim,params%stress_mask)))
 
 !--------------------------------------------------------------------------------------------------
 ! constructing residual
@@ -599,7 +599,7 @@ subroutine formResidual(da_local,x_local, &
   call DMDAVecGetArrayF90(da_local,x_local,x_scal,err_PETSc)
   CHKERRQ(err_PETSc)
   ele = 0
-  r = 0.0_pReal
+  r = 0.0_pREAL
   do k = cells3Offset+1, cells3Offset+cells3; do j = 1, cells(2); do i = 1, cells(1)
     ctr = 0
     do kk = -1, 0; do jj = -1, 0; do ii = -1, 0
@@ -610,7 +610,7 @@ subroutine formResidual(da_local,x_local, &
     f_elem = matmul(transpose(BMat),transpose(P_current(1:3,1:3,i,j,k-cells3Offset)))*detJ + &
              matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,ele) + &
                                    homogenization_dPdF(2,2,2,2,ele) + &
-                                   homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
+                                   homogenization_dPdF(3,3,3,3,ele))/3.0_pREAL
     ctr = 0
     do kk = -1, 0; do jj = -1, 0; do ii = -1, 0
       ctr = ctr + 1
@@ -623,16 +623,16 @@ subroutine formResidual(da_local,x_local, &
 !--------------------------------------------------------------------------------------------------
 ! applying boundary conditions
   if (cells3Offset == 0) then
-    r(0:2,0,       0,       0) = 0.0_pReal
-    r(0:2,cells(1),0,       0) = 0.0_pReal
-    r(0:2,0,       cells(2),0) = 0.0_pReal
-    r(0:2,cells(1),cells(2),0) = 0.0_pReal
+    r(0:2,0,       0,       0) = 0.0_pREAL
+    r(0:2,cells(1),0,       0) = 0.0_pREAL
+    r(0:2,0,       cells(2),0) = 0.0_pREAL
+    r(0:2,cells(1),cells(2),0) = 0.0_pREAL
   end if
   if (cells3+cells3Offset == cells(3)) then
-    r(0:2,0,       0,       cells(3)) = 0.0_pReal
-    r(0:2,cells(1),0,       cells(3)) = 0.0_pReal
-    r(0:2,0,       cells(2),cells(3)) = 0.0_pReal
-    r(0:2,cells(1),cells(2),cells(3)) = 0.0_pReal
+    r(0:2,0,       0,       cells(3)) = 0.0_pREAL
+    r(0:2,cells(1),0,       cells(3)) = 0.0_pREAL
+    r(0:2,0,       cells(2),cells(3)) = 0.0_pREAL
+    r(0:2,cells(1),cells(2),cells(3)) = 0.0_pREAL
   end if
   call DMDAVecRestoreArrayF90(da_local,f_local,r,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -652,17 +652,17 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,err_PETSc)
   PetscErrorCode                       :: err_PETSc
 
   MatStencil,dimension(4,24)           :: row, col
-  real(pReal),pointer,dimension(:,:,:,:) :: x_scal
-  real(pReal),dimension(24,24)         :: K_ele
-  real(pReal),dimension(9,24)          :: BMatFull
+  real(pREAL),pointer,dimension(:,:,:,:) :: x_scal
+  real(pREAL),dimension(24,24)         :: K_ele
+  real(pREAL),dimension(9,24)          :: BMatFull
   PetscInt                             :: i, ii, j, jj, k, kk, ctr, ce
   PetscInt,dimension(3),parameter      :: rows = [0, 1, 2]
-  real(pReal)                          :: diag
+  real(pREAL)                          :: diag
   MatNullSpace                         :: matnull
   Vec                                  :: coordinates
 
 
-  BMatFull = 0.0_pReal
+  BMatFull = 0.0_pREAL
   BMatFull(1:3,1 :8 ) = BMat
   BMatFull(4:6,9 :16) = BMat
   BMatFull(7:9,17:24) = BMat
@@ -692,16 +692,16 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,err_PETSc)
     end do; end do; end do
     row = col
     ce = ce + 1
-    K_ele = 0.0_pReal
+    K_ele = 0.0_pREAL
     K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,ce) + &
                                 homogenization_dPdF(2,2,2,2,ce) + &
-                                homogenization_dPdF(3,3,3,3,ce))/3.0_pReal
+                                homogenization_dPdF(3,3,3,3,ce))/3.0_pREAL
     K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,ce) + &
                                 homogenization_dPdF(2,2,2,2,ce) + &
-                                homogenization_dPdF(3,3,3,3,ce))/3.0_pReal
+                                homogenization_dPdF(3,3,3,3,ce))/3.0_pREAL
     K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,ce) + &
                                 homogenization_dPdF(2,2,2,2,ce) + &
-                                homogenization_dPdF(3,3,3,3,ce))/3.0_pReal
+                                homogenization_dPdF(3,3,3,3,ce))/3.0_pREAL
     K_ele = K_ele + &
             matmul(transpose(BMatFull), &
                    matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,ce), &

src/grid/grid_mech_spectral_basic.f90

@@ -40,7 +40,7 @@ module grid_mechanical_spectral_basic
     integer :: &
       itmin, &                                                                                      !< minimum number of iterations
       itmax                                                                                         !< maximum number of iterations
-    real(pReal) :: &
+    real(pREAL) :: &
       eps_div_atol, &                                                                               !< absolute tolerance for equilibrium
       eps_div_rtol, &                                                                               !< relative tolerance for equilibrium
       eps_stress_atol, &                                                                            !< absolute tolerance for fullfillment of stress BC
@@ -57,28 +57,28 @@ module grid_mechanical_spectral_basic
 
 !--------------------------------------------------------------------------------------------------
 ! common pointwise data
-  real(pReal), dimension(:,:,:,:,:), allocatable ::  &
+  real(pREAL), dimension(:,:,:,:,:), allocatable ::  &
     F_lastInc, &                                                                                    !< field of previous compatible deformation gradients
     Fdot                                                                                            !< field of assumed rate of compatible deformation gradient
 
 !--------------------------------------------------------------------------------------------------
 ! stress, stiffness and compliance average etc.
-  real(pReal), dimension(3,3) :: &
-    F_aimDot = 0.0_pReal, &                                                                         !< assumed rate of average deformation gradient
+  real(pREAL), dimension(3,3) :: &
+    F_aimDot = 0.0_pREAL, &                                                                         !< assumed rate of average deformation gradient
     F_aim = math_I3, &                                                                              !< current prescribed deformation gradient
     F_aim_lastInc = math_I3, &                                                                      !< previous average deformation gradient
-    P_av = 0.0_pReal, &                                                                             !< average 1st Piola--Kirchhoff stress
-    P_aim = 0.0_pReal
+    P_av = 0.0_pREAL, &                                                                             !< average 1st Piola--Kirchhoff stress
+    P_aim = 0.0_pREAL
   character(len=:), allocatable :: incInfo                                                          !< time and increment information
-  real(pReal), dimension(3,3,3,3) :: &
-    C_volAvg = 0.0_pReal, &                                                                         !< current volume average stiffness
-    C_volAvgLastInc = 0.0_pReal, &                                                                  !< previous volume average stiffness
-    C_minMaxAvg = 0.0_pReal, &                                                                      !< current (min+max)/2 stiffness
-    C_minMaxAvgLastInc = 0.0_pReal, &                                                               !< previous (min+max)/2 stiffness
-    C_minMaxAvgRestart = 0.0_pReal, &                                                               !< (min+max)/2 stiffnes (restart)
-    S = 0.0_pReal                                                                                   !< current compliance (filled up with zeros)
+  real(pREAL), dimension(3,3,3,3) :: &
+    C_volAvg = 0.0_pREAL, &                                                                         !< current volume average stiffness
+    C_volAvgLastInc = 0.0_pREAL, &                                                                  !< previous volume average stiffness
+    C_minMaxAvg = 0.0_pREAL, &                                                                      !< current (min+max)/2 stiffness
+    C_minMaxAvgLastInc = 0.0_pREAL, &                                                               !< previous (min+max)/2 stiffness
+    C_minMaxAvgRestart = 0.0_pREAL, &                                                               !< (min+max)/2 stiffnes (restart)
+    S = 0.0_pREAL                                                                                   !< current compliance (filled up with zeros)
 
-  real(pReal) :: &
+  real(pREAL) :: &
     err_BC, &                                                                                       !< deviation from stress BC
     err_div                                                                                         !< RMS of div of P
 
@@ -105,13 +105,13 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine grid_mechanical_spectral_basic_init()
 
-  real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: P
+  real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
   PetscErrorCode :: err_PETSc
   integer(MPI_INTEGER_KIND) :: err_MPI
-  real(pReal), pointer, dimension(:,:,:,:) :: &
+  real(pREAL), pointer, dimension(:,:,:,:) :: &
     F                                                                                               ! pointer to solution data
   PetscInt, dimension(0:worldsize-1) :: localK
-  real(pReal), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
+  real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
   integer(HID_T) :: fileHandle, groupHandle
   type(tDict), pointer :: &
     num_grid
@@ -132,17 +132,17 @@ subroutine grid_mechanical_spectral_basic_init()
   num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
 
   num%update_gamma    = num_grid%get_asBool('update_gamma',   defaultVal=.false.)
-  num%eps_div_atol    = num_grid%get_asReal('eps_div_atol',   defaultVal=1.0e-4_pReal)
-  num%eps_div_rtol    = num_grid%get_asReal('eps_div_rtol',   defaultVal=5.0e-4_pReal)
-  num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pReal)
-  num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pReal)
+  num%eps_div_atol    = num_grid%get_asReal('eps_div_atol',   defaultVal=1.0e-4_pREAL)
+  num%eps_div_rtol    = num_grid%get_asReal('eps_div_rtol',   defaultVal=5.0e-4_pREAL)
+  num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
+  num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
   num%itmin           = num_grid%get_asInt ('itmin',defaultVal=1)
   num%itmax           = num_grid%get_asInt ('itmax',defaultVal=250)
 
-  if (num%eps_div_atol <= 0.0_pReal)             extmsg = trim(extmsg)//' eps_div_atol'
-  if (num%eps_div_rtol < 0.0_pReal)              extmsg = trim(extmsg)//' eps_div_rtol'
-  if (num%eps_stress_atol <= 0.0_pReal)          extmsg = trim(extmsg)//' eps_stress_atol'
-  if (num%eps_stress_rtol < 0.0_pReal)           extmsg = trim(extmsg)//' eps_stress_rtol'
+  if (num%eps_div_atol <= 0.0_pREAL)             extmsg = trim(extmsg)//' eps_div_atol'
+  if (num%eps_div_rtol < 0.0_pREAL)              extmsg = trim(extmsg)//' eps_div_rtol'
+  if (num%eps_stress_atol <= 0.0_pREAL)          extmsg = trim(extmsg)//' eps_stress_atol'
+  if (num%eps_stress_rtol < 0.0_pREAL)           extmsg = trim(extmsg)//' eps_stress_rtol'
   if (num%itmax <= 1)                            extmsg = trim(extmsg)//' itmax'
   if (num%itmin > num%itmax .or. num%itmin < 1)  extmsg = trim(extmsg)//' itmin'
 
@@ -157,8 +157,8 @@ subroutine grid_mechanical_spectral_basic_init()
 
 !--------------------------------------------------------------------------------------------------
 ! allocate global fields
-  allocate(F_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
-  allocate(Fdot     (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
+  allocate(F_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+  allocate(Fdot     (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
 
 !--------------------------------------------------------------------------------------------------
 ! initialize solver specific parts of PETSc
@@ -231,7 +231,7 @@ subroutine grid_mechanical_spectral_basic_init()
   call utilities_updateCoords(reshape(F,shape(F_lastInc)))
   call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, &                                ! stress field, stress avg, global average of stiffness and (min+max)/2
                                       reshape(F,shape(F_lastInc)), &                                ! target F
-                                      0.0_pReal)                                                    ! time increment
+                                      0.0_pREAL)                                                    ! time increment
   call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc)                                          ! deassociate pointer
   CHKERRQ(err_PETSc)
 
@@ -305,7 +305,7 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
   logical,                  intent(in) :: &
     cutBack, &
     guess
-  real(pReal),              intent(in) :: &
+  real(pREAL),              intent(in) :: &
     Delta_t_old, &
     Delta_t, &
     t_remaining                                                                                     !< remaining time of current load case
@@ -315,7 +315,7 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
   type(tRotation),           intent(in) :: &
     rotation_BC
   PetscErrorCode :: err_PETSc
-  real(pReal), pointer, dimension(:,:,:,:) :: F
+  real(pREAL), pointer, dimension(:,:,:,:) :: F
 
 
   call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
@@ -328,20 +328,20 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
     C_volAvgLastInc    = C_volAvg
     C_minMaxAvgLastInc = C_minMaxAvg
 
-    F_aimDot = merge(merge(.0_pReal,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pReal,guess) ! estimate deformation rate for prescribed stress components
+    F_aimDot = merge(merge(.0_pREAL,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pREAL,guess) ! estimate deformation rate for prescribed stress components
     F_aim_lastInc = F_aim
 
     !-----------------------------------------------------------------------------------------------
     ! calculate rate for aim
     if     (deformation_BC%myType=='L') then                                                        ! calculate F_aimDot from given L and current F
       F_aimDot = F_aimDot &
-               + matmul(merge(.0_pReal,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
+               + matmul(merge(.0_pREAL,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
     elseif (deformation_BC%myType=='dot_F') then                                                    ! F_aimDot is prescribed
       F_aimDot = F_aimDot &
-               + merge(.0_pReal,deformation_BC%values,deformation_BC%mask)
+               + merge(.0_pREAL,deformation_BC%values,deformation_BC%mask)
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
-               + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
+               + merge(.0_pREAL,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
     end if
 
     Fdot = utilities_calculateRate(guess, &
@@ -356,9 +356,9 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
 ! update average and local deformation gradients
   F_aim = F_aim_lastInc + F_aimDot * Delta_t
   if (stress_BC%myType=='P')     P_aim = P_aim &
-                                       + merge(.0_pReal,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
+                                       + merge(.0_pREAL,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
   if (stress_BC%myType=='dot_P') P_aim = P_aim &
-                                       + merge(.0_pReal,stress_BC%values,stress_BC%mask)*Delta_t
+                                       + merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
 
   F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, &                                      ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
               rotation_BC%rotate(F_aim,active=.true.)),[9,cells(1),cells(2),cells3])
@@ -380,7 +380,7 @@ end subroutine grid_mechanical_spectral_basic_forward
 subroutine grid_mechanical_spectral_basic_updateCoords
 
   PetscErrorCode :: err_PETSc
-  real(pReal), dimension(:,:,:,:), pointer :: F
+  real(pREAL), dimension(:,:,:,:), pointer :: F
 
   call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -398,7 +398,7 @@ subroutine grid_mechanical_spectral_basic_restartWrite
 
   PetscErrorCode :: err_PETSc
   integer(HID_T) :: fileHandle, groupHandle
-  real(pReal), dimension(:,:,:,:), pointer :: F
+  real(pREAL), dimension(:,:,:,:), pointer :: F
 
   call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -448,14 +448,14 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
   SNESConvergedReason :: reason
   PetscObject :: dummy
   PetscErrorCode :: err_PETSc
-  real(pReal) :: &
+  real(pREAL) :: &
     divTol, &
     BCTol
 
   divTol = max(maxval(abs(P_av))*num%eps_div_rtol, num%eps_div_atol)
   BCTol = max(maxval(abs(P_av))*num%eps_stress_rtol, num%eps_stress_atol)
 
-  if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pReal)) &
+  if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pREAL)) &
        .or. terminallyIll) then
     reason = 1
   elseif (totalIter >= num%itmax) then
@@ -484,14 +484,14 @@ subroutine formResidual(residual_subdomain, F, &
 
   DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
     residual_subdomain                                                                              !< DMDA info (needs to be named "in" for macros like XRANGE to work)
-  real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: &
+  real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: &
     F                                                                                               !< deformation gradient field
-  real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(out) :: &
+  real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(out) :: &
     r                                                                                               !< residuum field
   PetscObject :: dummy
   PetscErrorCode :: err_PETSc
 
-  real(pReal),  dimension(3,3) :: &
+  real(pREAL),  dimension(3,3) :: &
     deltaF_aim
   PetscInt :: &
     PETScIter, &
@@ -509,7 +509,7 @@ subroutine formResidual(residual_subdomain, F, &
   newIteration: if (totalIter <= PETScIter) then
     totalIter = totalIter + 1
     print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
-    if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+    if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
       print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
       'deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
     print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
@@ -528,7 +528,7 @@ subroutine formResidual(residual_subdomain, F, &
 
   deltaF_aim = math_mul3333xx33(S, P_av - P_aim)                                                    ! S = 0.0 for no bc
   F_aim = F_aim - deltaF_aim
-  err_BC = maxval(abs(merge(.0_pReal,P_av - P_aim,params%stress_mask)))
+  err_BC = maxval(abs(merge(.0_pREAL,P_av - P_aim,params%stress_mask)))
 
   r = utilities_GammaConvolution(r,params%rotation_BC%rotate(deltaF_aim,active=.true.))
 

src/grid/grid_mech_spectral_polarisation.f90

@@ -40,14 +40,14 @@ module grid_mechanical_spectral_polarisation
     integer :: &
       itmin, &                                                                                      !< minimum number of iterations
       itmax                                                                                         !< maximum number of iterations
-    real(pReal) :: &
+    real(pREAL) :: &
       eps_div_atol, &                                                                               !< absolute tolerance for equilibrium
       eps_div_rtol, &                                                                               !< relative tolerance for equilibrium
       eps_curl_atol, &                                                                              !< absolute tolerance for compatibility
       eps_curl_rtol, &                                                                              !< relative tolerance for compatibility
       eps_stress_atol, &                                                                            !< absolute tolerance for fullfillment of stress BC
       eps_stress_rtol                                                                               !< relative tolerance for fullfillment of stress BC
-    real(pReal) :: &
+    real(pREAL) :: &
       alpha, &                                                                                      !< polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
       beta                                                                                          !< polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
   end type tNumerics
@@ -62,7 +62,7 @@ module grid_mechanical_spectral_polarisation
 
 !--------------------------------------------------------------------------------------------------
 ! common pointwise data
-  real(pReal), dimension(:,:,:,:,:), allocatable :: &
+  real(pREAL), dimension(:,:,:,:,:), allocatable :: &
     F_lastInc, &                                                                                    !< field of previous compatible deformation gradients
     F_tau_lastInc, &                                                                                !< field of previous incompatible deformation gradient
     Fdot, &                                                                                         !< field of assumed rate of compatible deformation gradient
@@ -70,25 +70,25 @@ module grid_mechanical_spectral_polarisation
 
 !--------------------------------------------------------------------------------------------------
 ! stress, stiffness and compliance average etc.
-  real(pReal), dimension(3,3) :: &
-    F_aimDot = 0.0_pReal, &                                                                         !< assumed rate of average deformation gradient
+  real(pREAL), dimension(3,3) :: &
+    F_aimDot = 0.0_pREAL, &                                                                         !< assumed rate of average deformation gradient
     F_aim = math_I3, &                                                                              !< current prescribed deformation gradient
     F_aim_lastInc = math_I3, &                                                                      !< previous average deformation gradient
-    F_av = 0.0_pReal, &                                                                             !< average incompatible def grad field
-    P_av = 0.0_pReal, &                                                                             !< average 1st Piola--Kirchhoff stress
-    P_aim = 0.0_pReal
+    F_av = 0.0_pREAL, &                                                                             !< average incompatible def grad field
+    P_av = 0.0_pREAL, &                                                                             !< average 1st Piola--Kirchhoff stress
+    P_aim = 0.0_pREAL
   character(len=:), allocatable :: incInfo                                                          !< time and increment information
-  real(pReal), dimension(3,3,3,3) :: &
-    C_volAvg = 0.0_pReal, &                                                                         !< current volume average stiffness
-    C_volAvgLastInc = 0.0_pReal, &                                                                  !< previous volume average stiffness
-    C_minMaxAvg = 0.0_pReal, &                                                                      !< current (min+max)/2 stiffness
-    C_minMaxAvgLastInc = 0.0_pReal, &                                                               !< previous (min+max)/2 stiffness
-    C_minMaxAvgRestart = 0.0_pReal, &                                                              !< (min+max)/2 stiffnes (restart)
-    S = 0.0_pReal, &                                                                                !< current compliance (filled up with zeros)
-    C_scale = 0.0_pReal, &
-    S_scale = 0.0_pReal
+  real(pREAL), dimension(3,3,3,3) :: &
+    C_volAvg = 0.0_pREAL, &                                                                         !< current volume average stiffness
+    C_volAvgLastInc = 0.0_pREAL, &                                                                  !< previous volume average stiffness
+    C_minMaxAvg = 0.0_pREAL, &                                                                      !< current (min+max)/2 stiffness
+    C_minMaxAvgLastInc = 0.0_pREAL, &                                                               !< previous (min+max)/2 stiffness
+    C_minMaxAvgRestart = 0.0_pREAL, &                                                              !< (min+max)/2 stiffnes (restart)
+    S = 0.0_pREAL, &                                                                                !< current compliance (filled up with zeros)
+    C_scale = 0.0_pREAL, &
+    S_scale = 0.0_pREAL
 
-  real(pReal) :: &
+  real(pREAL) :: &
     err_BC, &                                                                                       !< deviation from stress BC
     err_curl, &                                                                                     !< RMS of curl of F
     err_div                                                                                         !< RMS of div of P
@@ -116,15 +116,15 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine grid_mechanical_spectral_polarisation_init()
 
-  real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: P
+  real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
   PetscErrorCode :: err_PETSc
   integer(MPI_INTEGER_KIND) :: err_MPI
-  real(pReal), pointer, dimension(:,:,:,:) :: &
+  real(pREAL), pointer, dimension(:,:,:,:) :: &
     FandF_tau, &                                                                                    ! overall pointer to solution data
     F, &                                                                                            ! specific (sub)pointer
     F_tau                                                                                           ! specific (sub)pointer
   PetscInt, dimension(0:worldsize-1) :: localK
-  real(pReal), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
+  real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
   integer(HID_T) :: fileHandle, groupHandle
   type(tDict), pointer :: &
     num_grid
@@ -143,27 +143,27 @@ subroutine grid_mechanical_spectral_polarisation_init()
   num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
 
   num%update_gamma    = num_grid%get_asBool('update_gamma',   defaultVal=.false.)
-  num%eps_div_atol    = num_grid%get_asReal('eps_div_atol',   defaultVal=1.0e-4_pReal)
-  num%eps_div_rtol    = num_grid%get_asReal('eps_div_rtol',   defaultVal=5.0e-4_pReal)
-  num%eps_curl_atol   = num_grid%get_asReal('eps_curl_atol',  defaultVal=1.0e-10_pReal)
-  num%eps_curl_rtol   = num_grid%get_asReal('eps_curl_rtol',  defaultVal=5.0e-4_pReal)
-  num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pReal)
-  num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pReal)
+  num%eps_div_atol    = num_grid%get_asReal('eps_div_atol',   defaultVal=1.0e-4_pREAL)
+  num%eps_div_rtol    = num_grid%get_asReal('eps_div_rtol',   defaultVal=5.0e-4_pREAL)
+  num%eps_curl_atol   = num_grid%get_asReal('eps_curl_atol',  defaultVal=1.0e-10_pREAL)
+  num%eps_curl_rtol   = num_grid%get_asReal('eps_curl_rtol',  defaultVal=5.0e-4_pREAL)
+  num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
+  num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
   num%itmin           = num_grid%get_asInt ('itmin',          defaultVal=1)
   num%itmax           = num_grid%get_asInt ('itmax',          defaultVal=250)
-  num%alpha           = num_grid%get_asReal('alpha',          defaultVal=1.0_pReal)
-  num%beta            = num_grid%get_asReal('beta',           defaultVal=1.0_pReal)
+  num%alpha           = num_grid%get_asReal('alpha',          defaultVal=1.0_pREAL)
+  num%beta            = num_grid%get_asReal('beta',           defaultVal=1.0_pREAL)
 
-  if (num%eps_div_atol <= 0.0_pReal)                      extmsg = trim(extmsg)//' eps_div_atol'
-  if (num%eps_div_rtol < 0.0_pReal)                       extmsg = trim(extmsg)//' eps_div_rtol'
-  if (num%eps_curl_atol <= 0.0_pReal)                     extmsg = trim(extmsg)//' eps_curl_atol'
-  if (num%eps_curl_rtol < 0.0_pReal)                      extmsg = trim(extmsg)//' eps_curl_rtol'
-  if (num%eps_stress_atol <= 0.0_pReal)                   extmsg = trim(extmsg)//' eps_stress_atol'
-  if (num%eps_stress_rtol < 0.0_pReal)                    extmsg = trim(extmsg)//' eps_stress_rtol'
+  if (num%eps_div_atol <= 0.0_pREAL)                      extmsg = trim(extmsg)//' eps_div_atol'
+  if (num%eps_div_rtol < 0.0_pREAL)                       extmsg = trim(extmsg)//' eps_div_rtol'
+  if (num%eps_curl_atol <= 0.0_pREAL)                     extmsg = trim(extmsg)//' eps_curl_atol'
+  if (num%eps_curl_rtol < 0.0_pREAL)                      extmsg = trim(extmsg)//' eps_curl_rtol'
+  if (num%eps_stress_atol <= 0.0_pREAL)                   extmsg = trim(extmsg)//' eps_stress_atol'
+  if (num%eps_stress_rtol < 0.0_pREAL)                    extmsg = trim(extmsg)//' eps_stress_rtol'
   if (num%itmax <= 1)                                     extmsg = trim(extmsg)//' itmax'
   if (num%itmin > num%itmax .or. num%itmin < 1)           extmsg = trim(extmsg)//' itmin'
-  if (num%alpha <= 0.0_pReal .or. num%alpha >  2.0_pReal) extmsg = trim(extmsg)//' alpha'
-  if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal)     extmsg = trim(extmsg)//' beta'
+  if (num%alpha <= 0.0_pREAL .or. num%alpha >  2.0_pREAL) extmsg = trim(extmsg)//' alpha'
+  if (num%beta < 0.0_pREAL .or. num%beta > 2.0_pREAL)     extmsg = trim(extmsg)//' beta'
 
   if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
 
@@ -176,10 +176,10 @@ subroutine grid_mechanical_spectral_polarisation_init()
 
 !--------------------------------------------------------------------------------------------------
 ! allocate global fields
-  allocate(F_lastInc    (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
-  allocate(Fdot         (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
-  allocate(F_tau_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
-  allocate(F_tauDot     (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
+  allocate(F_lastInc    (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+  allocate(Fdot         (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+  allocate(F_tau_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+  allocate(F_tauDot     (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
 
 !--------------------------------------------------------------------------------------------------
 ! initialize solver specific parts of PETSc
@@ -252,15 +252,15 @@ subroutine grid_mechanical_spectral_polarisation_init()
   elseif (CLI_restartInc == 0) then restartRead
     F_lastInc = spread(spread(spread(math_I3,3,cells(1)),4,cells(2)),5,cells3)                      ! initialize to identity
     F = reshape(F_lastInc,[9,cells(1),cells(2),cells3])
-    F_tau = 2.0_pReal*F
-    F_tau_lastInc = 2.0_pReal*F_lastInc
+    F_tau = 2.0_pREAL*F
+    F_tau_lastInc = 2.0_pREAL*F_lastInc
   end if restartRead
 
   homogenization_F0 = reshape(F_lastInc, [3,3,product(cells(1:2))*cells3])                          ! set starting condition for homogenization_mechanical_response
   call utilities_updateCoords(reshape(F,shape(F_lastInc)))
   call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, &                                ! stress field, stress avg, global average of stiffness and (min+max)/2
                                       reshape(F,shape(F_lastInc)), &                                ! target F
-                                      0.0_pReal)                                                    ! time increment
+                                      0.0_pREAL)                                                    ! time increment
   call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc)                                  ! deassociate pointer
   CHKERRQ(err_PETSc)
 
@@ -340,7 +340,7 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
   logical,                  intent(in) :: &
     cutBack, &
     guess
-  real(pReal),              intent(in) :: &
+  real(pREAL),              intent(in) :: &
     Delta_t_old, &
     Delta_t, &
     t_remaining                                                                                     !< remaining time of current load case
@@ -350,9 +350,9 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
   type(tRotation),           intent(in) :: &
     rotation_BC
   PetscErrorCode :: err_PETSc
-  real(pReal), pointer, dimension(:,:,:,:) :: FandF_tau, F, F_tau
+  real(pREAL), pointer, dimension(:,:,:,:) :: FandF_tau, F, F_tau
   integer :: i, j, k
-  real(pReal), dimension(3,3) :: F_lambda33
+  real(pREAL), dimension(3,3) :: F_lambda33
 
 
   call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
@@ -367,20 +367,20 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
     C_volAvgLastInc    = C_volAvg
     C_minMaxAvgLastInc = C_minMaxAvg
 
-    F_aimDot = merge(merge(.0_pReal,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pReal,guess)  ! estimate deformation rate for prescribed stress components
+    F_aimDot = merge(merge(.0_pREAL,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pREAL,guess)  ! estimate deformation rate for prescribed stress components
     F_aim_lastInc = F_aim
 
     !-----------------------------------------------------------------------------------------------
     ! calculate rate for aim
     if     (deformation_BC%myType=='L') then                                                        ! calculate F_aimDot from given L and current F
       F_aimDot = F_aimDot &
-               + matmul(merge(.0_pReal,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
+               + matmul(merge(.0_pREAL,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
     elseif (deformation_BC%myType=='dot_F') then                                                    ! F_aimDot is prescribed
       F_aimDot = F_aimDot &
-               + merge(.0_pReal,deformation_BC%values,deformation_BC%mask)
+               + merge(.0_pREAL,deformation_BC%values,deformation_BC%mask)
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
-               + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
+               + merge(.0_pREAL,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
     end if
 
     Fdot     = utilities_calculateRate(guess, &
@@ -399,9 +399,9 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
 ! update average and local deformation gradients
   F_aim = F_aim_lastInc + F_aimDot * Delta_t
   if (stress_BC%myType=='P')     P_aim = P_aim &
-                                      + merge(.0_pReal,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
+                                      + merge(.0_pREAL,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
   if (stress_BC%myType=='dot_P') P_aim = P_aim &
-                                      + merge(.0_pReal,stress_BC%values,stress_BC%mask)*Delta_t
+                                      + merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
 
   F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, &                                      ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
                                      rotation_BC%rotate(F_aim,active=.true.)),&
@@ -413,7 +413,7 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
     do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
        F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3])
        F_lambda33 = math_I3 &
-                  + math_mul3333xx33(S_scale,0.5_pReal*matmul(F_lambda33, &
+                  + math_mul3333xx33(S_scale,0.5_pREAL*matmul(F_lambda33, &
                     math_mul3333xx33(C_scale,matmul(transpose(F_lambda33),F_lambda33)-math_I3)))
        F_tau(1:9,i,j,k) = reshape(F_lambda33,[9])+F(1:9,i,j,k)
     end do; end do; end do
@@ -437,7 +437,7 @@ end subroutine grid_mechanical_spectral_polarisation_forward
 subroutine grid_mechanical_spectral_polarisation_updateCoords
 
   PetscErrorCode :: err_PETSc
-  real(pReal), dimension(:,:,:,:), pointer :: FandF_tau
+  real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau
 
   call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -455,7 +455,7 @@ subroutine grid_mechanical_spectral_polarisation_restartWrite
 
   PetscErrorCode :: err_PETSc
   integer(HID_T) :: fileHandle, groupHandle
-  real(pReal), dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau
+  real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau
 
   call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -509,7 +509,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
   SNESConvergedReason :: reason
   PetscObject :: dummy
   PetscErrorCode :: err_PETSc
-  real(pReal) :: &
+  real(pREAL) :: &
     curlTol, &
     divTol, &
     BCTol
@@ -518,7 +518,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
   divTol = max(maxval(abs(P_av))*num%eps_div_rtol, num%eps_div_atol)
   BCTol = max(maxval(abs(P_av))*num%eps_stress_rtol, num%eps_stress_atol)
 
-  if ((totalIter >= num%itmin .and. all([err_div/divTol, err_curl/curlTol, err_BC/BCTol] < 1.0_pReal)) &
+  if ((totalIter >= num%itmin .and. all([err_div/divTol, err_curl/curlTol, err_BC/BCTol] < 1.0_pREAL)) &
        .or. terminallyIll) then
     reason = 1
   elseif (totalIter >= num%itmax) then
@@ -548,14 +548,14 @@ subroutine formResidual(residual_subdomain, FandF_tau, &
                         r, dummy,err_PETSc)
 
   DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: residual_subdomain                              !< DMDA info (needs to be named "in" for macros like XRANGE to work)
-  real(pReal), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(in) :: &
+  real(pREAL), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(in) :: &
     FandF_tau                                                                                       !< deformation gradient field
-  real(pReal), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(out) :: &
+  real(pREAL), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(out) :: &
     r                                                                                               !< residuum field
   PetscObject :: dummy
   PetscErrorCode :: err_PETSc
 
-  real(pReal), pointer, dimension(:,:,:,:,:) :: &
+  real(pREAL), pointer, dimension(:,:,:,:,:) :: &
     F, &
     F_tau, &
     r_F, &
@@ -587,7 +587,7 @@ subroutine formResidual(residual_subdomain, FandF_tau, &
   newIteration: if (totalIter <= PETScIter) then
     totalIter = totalIter + 1
     print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
-    if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+    if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
       print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
       'deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
     print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &

src/grid/grid_thermal_spectral.f90

@@ -35,7 +35,7 @@ module grid_thermal_spectral
   type :: tNumerics
     integer :: &
       itmax                                                                                         !< maximum number of iterations
-    real(pReal) :: &
+    real(pREAL) :: &
       eps_thermal_atol, &                                                                           !< absolute tolerance for thermal equilibrium
       eps_thermal_rtol                                                                              !< relative tolerance for thermal equilibrium
   end type tNumerics
@@ -47,7 +47,7 @@ module grid_thermal_spectral
 ! PETSc data
   SNES :: SNES_thermal
   Vec :: solution_vec
-  real(pReal), dimension(:,:,:), allocatable :: &
+  real(pREAL), dimension(:,:,:), allocatable :: &
     T, &                                                                                            !< field of current temperature
     T_lastInc, &                                                                                    !< field of previous temperature
     T_stagInc, &                                                                                    !< field of staggered temperature
@@ -55,8 +55,8 @@ module grid_thermal_spectral
 !--------------------------------------------------------------------------------------------------
 ! reference diffusion tensor, mobility etc.
   integer                     :: totalIter = 0                                                      !< total iteration in current increment
-  real(pReal), dimension(3,3) :: K_ref
-  real(pReal)                 :: mu_ref
+  real(pREAL), dimension(3,3) :: K_ref
+  real(pREAL)                 :: mu_ref
 
   public :: &
     grid_thermal_spectral_init, &
@@ -74,11 +74,11 @@ subroutine grid_thermal_spectral_init()
   PetscInt, dimension(0:worldsize-1) :: localK
   integer :: i, j, k, ce
   DM :: thermal_grid
-  real(pReal), dimension(:,:,:), pointer :: T_PETSc
+  real(pREAL), dimension(:,:,:), pointer :: T_PETSc
   integer(MPI_INTEGER_KIND) :: err_MPI
   PetscErrorCode :: err_PETSc
   integer(HID_T) :: fileHandle, groupHandle
-  real(pReal), dimension(1,product(cells(1:2))*cells3) :: tempN
+  real(pREAL), dimension(1,product(cells(1:2))*cells3) :: tempN
   type(tDict), pointer :: &
     num_grid
 
@@ -93,12 +93,12 @@ subroutine grid_thermal_spectral_init()
 ! read numerical parameters and do sanity checks
   num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
   num%itmax            = num_grid%get_asInt ('itmax',           defaultVal=250)
-  num%eps_thermal_atol = num_grid%get_asReal('eps_thermal_atol',defaultVal=1.0e-2_pReal)
-  num%eps_thermal_rtol = num_grid%get_asReal('eps_thermal_rtol',defaultVal=1.0e-6_pReal)
+  num%eps_thermal_atol = num_grid%get_asReal('eps_thermal_atol',defaultVal=1.0e-2_pREAL)
+  num%eps_thermal_rtol = num_grid%get_asReal('eps_thermal_rtol',defaultVal=1.0e-6_pREAL)
 
   if (num%itmax <= 1)                    call IO_error(301,ext_msg='itmax')
-  if (num%eps_thermal_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_thermal_atol')
-  if (num%eps_thermal_rtol <= 0.0_pReal) call IO_error(301,ext_msg='eps_thermal_rtol')
+  if (num%eps_thermal_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_thermal_atol')
+  if (num%eps_thermal_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_thermal_rtol')
 
 !--------------------------------------------------------------------------------------------------
 ! set default and user defined options for PETSc
@@ -113,7 +113,7 @@ subroutine grid_thermal_spectral_init()
   T = discretization_grid_getInitialCondition('T')
   T_lastInc = T
   T_stagInc = T
-  dotT_lastInc = 0.0_pReal * T
+  dotT_lastInc = 0.0_pREAL * T
 
 !--------------------------------------------------------------------------------------------------
 ! initialize solver specific parts of PETSc
@@ -165,7 +165,7 @@ subroutine grid_thermal_spectral_init()
   ce = 0
   do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
     ce = ce + 1
-    call homogenization_thermal_setField(T(i,j,k),0.0_pReal,ce)
+    call homogenization_thermal_setField(T(i,j,k),0.0_pREAL,ce)
   end do; end do; end do
 
   call DMDAVecGetArrayF90(thermal_grid,solution_vec,T_PETSc,err_PETSc)
@@ -184,7 +184,7 @@ end subroutine grid_thermal_spectral_init
 !--------------------------------------------------------------------------------------------------
 function grid_thermal_spectral_solution(Delta_t) result(solution)
 
-  real(pReal), intent(in) :: &
+  real(pREAL), intent(in) :: &
     Delta_t                                                                                         !< increment in time for current solution
   integer :: i, j, k, ce
   type(tSolutionState) :: solution
@@ -251,7 +251,7 @@ subroutine grid_thermal_spectral_forward(cutBack)
 
   integer :: i, j, k, ce
   DM :: dm_local
-  real(pReal),  dimension(:,:,:), pointer :: T_PETSc
+  real(pREAL),  dimension(:,:,:), pointer :: T_PETSc
   PetscErrorCode :: err_PETSc
 
 
@@ -290,7 +290,7 @@ subroutine grid_thermal_spectral_restartWrite
   PetscErrorCode :: err_PETSc
   DM :: dm_local
   integer(HID_T) :: fileHandle, groupHandle
-  real(pReal), dimension(:,:,:), pointer :: T
+  real(pREAL), dimension(:,:,:), pointer :: T
 
   call SNESGetDM(SNES_thermal,dm_local,err_PETSc);
   CHKERRQ(err_PETSc)
@@ -321,15 +321,15 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
 
   DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
     residual_subdomain
-  real(pReal), dimension(cells(1),cells(2),cells3), intent(in) :: &
+  real(pREAL), dimension(cells(1),cells(2),cells3), intent(in) :: &
     x_scal
-  real(pReal), dimension(cells(1),cells(2),cells3), intent(out) :: &
+  real(pREAL), dimension(cells(1),cells(2),cells3), intent(out) :: &
     r                                                                                                     !< residual
   PetscObject :: dummy
   PetscErrorCode, intent(out) :: err_PETSc
 
   integer :: i, j, k, ce
-  real(pReal), dimension(3,cells(1),cells(2),cells3) :: vectorField
+  real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField
 
 
   T = x_scal
@@ -364,8 +364,8 @@ subroutine updateReference()
   integer(MPI_INTEGER_KIND) :: err_MPI
 
 
-  K_ref = 0.0_pReal
-  mu_ref = 0.0_pReal
+  K_ref = 0.0_pREAL
+  mu_ref = 0.0_pREAL
   do ce = 1, product(cells(1:2))*cells3
     K_ref  = K_ref  + homogenization_K_T(ce)
     mu_ref = mu_ref + homogenization_mu_T(ce)

src/grid/spectral_utilities.f90

@@ -32,8 +32,8 @@ module spectral_utilities
 
 !--------------------------------------------------------------------------------------------------
 ! grid related information
-  real(pReal), protected, public               :: wgt                                               !< weighting factor 1/Nelems
-  real(pReal), protected, public, dimension(3) :: scaledGeomSize                                    !< scaled geometry size for calculation of divergence
+  real(pREAL), protected, public               :: wgt                                               !< weighting factor 1/Nelems
+  real(pREAL), protected, public, dimension(3) :: scaledGeomSize                                    !< scaled geometry size for calculation of divergence
   integer :: &
     cells1Red, &                                                                                    !< cells(1)/2+1
     cells2, &                                                                                       !< (local) cells in 2nd direction
@@ -48,10 +48,10 @@ module spectral_utilities
   complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:,:),     pointer     :: tensorField_fourier           !< tensor field in Fourier space
   complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:),       pointer     :: vectorField_fourier           !< vector field in Fourier space
   complex(C_DOUBLE_COMPLEX), dimension(:,:,:),         pointer     :: scalarField_fourier           !< scalar field in Fourier space
-  complex(pReal),            dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat                     !< gamma operator (field) for spectral method
-  complex(pReal),            dimension(:,:,:,:),       allocatable :: xi1st                         !< wave vector field for first derivatives
-  complex(pReal),            dimension(:,:,:,:),       allocatable :: xi2nd                         !< wave vector field for second derivatives
-  real(pReal),               dimension(3,3,3,3)                    :: C_ref                         !< mechanic reference stiffness
+  complex(pREAL),            dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat                     !< gamma operator (field) for spectral method
+  complex(pREAL),            dimension(:,:,:,:),       allocatable :: xi1st                         !< wave vector field for first derivatives
+  complex(pREAL),            dimension(:,:,:,:),       allocatable :: xi2nd                         !< wave vector field for second derivatives
+  real(pREAL),               dimension(3,3,3,3)                    :: C_ref                         !< mechanic reference stiffness
 
 
 !--------------------------------------------------------------------------------------------------
@@ -76,16 +76,16 @@ module spectral_utilities
   end type tSolutionState
 
   type, public :: tBoundaryCondition                                                                !< set of parameters defining a boundary condition
-    real(pReal), dimension(3,3)   :: values = 0.0_pReal
+    real(pREAL), dimension(3,3)   :: values = 0.0_pREAL
     logical,     dimension(3,3)   :: mask   = .true.
     character(len=:), allocatable :: myType
   end type tBoundaryCondition
 
   type, public :: tSolutionParams
-    real(pReal), dimension(3,3) :: stress_BC
+    real(pREAL), dimension(3,3) :: stress_BC
     logical, dimension(3,3)     :: stress_mask
     type(tRotation)             :: rotation_BC
-    real(pReal) :: Delta_t
+    real(pREAL) :: Delta_t
   end type tSolutionParams
 
   type :: tNumerics
@@ -172,7 +172,7 @@ subroutine spectral_utilities_init()
   CHKERRQ(err_PETSc)
 
   cells1Red = cells(1)/2 + 1
-  wgt = real(product(cells),pReal)**(-1)
+  wgt = real(product(cells),pREAL)**(-1)
 
   num%memory_efficient      = num_grid%get_asInt('memory_efficient',      defaultVal=1) > 0         ! ToDo: should be logical in YAML file
   num%divergence_correction = num_grid%get_asInt('divergence_correction', defaultVal=2)
@@ -201,9 +201,9 @@ subroutine spectral_utilities_init()
     end do
   elseif (num%divergence_correction == 2) then
     do j = 1, 3
-     if (      j /= int(minloc(geomSize/real(cells,pReal),1)) &
-         .and. j /= int(maxloc(geomSize/real(cells,pReal),1))) &
-       scaledGeomSize = geomSize/geomSize(j)*real(cells(j),pReal)
+     if (      j /= int(minloc(geomSize/real(cells,pREAL),1)) &
+         .and. j /= int(maxloc(geomSize/real(cells,pREAL),1))) &
+       scaledGeomSize = geomSize/geomSize(j)*real(cells(j),pREAL)
     end do
   else
     scaledGeomSize = geomSize
@@ -225,8 +225,8 @@ subroutine spectral_utilities_init()
 
 !--------------------------------------------------------------------------------------------------
 ! general initialization of FFTW (see manual on fftw.org for more details)
-  if (pReal /= C_DOUBLE .or. kind(1) /= C_INT) error stop 'C and Fortran datatypes do not match'
-  call fftw_set_timelimit(num_grid%get_asReal('fftw_timelimit',defaultVal=300.0_pReal))
+  if (pREAL /= C_DOUBLE .or. kind(1) /= C_INT) error stop 'C and Fortran datatypes do not match'
+  call fftw_set_timelimit(num_grid%get_asReal('fftw_timelimit',defaultVal=300.0_pREAL))
 
   print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT)
 
@@ -268,8 +268,8 @@ subroutine spectral_utilities_init()
 
 !--------------------------------------------------------------------------------------------------
 ! allocation
-  allocate (xi1st (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pReal,0.0_pReal,pReal))          ! frequencies for first derivatives, only half the size for first dimension
-  allocate (xi2nd (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pReal,0.0_pReal,pReal))          ! frequencies for second derivatives, only half the size for first dimension
+  allocate (xi1st (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pREAL,0.0_pREAL,pREAL))          ! frequencies for first derivatives, only half the size for first dimension
+  allocate (xi2nd (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pREAL,0.0_pREAL,pREAL))          ! frequencies for second derivatives, only half the size for first dimension
 
 !--------------------------------------------------------------------------------------------------
 ! tensor MPI fftw plans
@@ -321,16 +321,16 @@ subroutine spectral_utilities_init()
             xi2nd(1:3,i,k,j-cells2Offset) = utilities_getFreqDerivative(k_s)
             where(mod(cells,2)==0 .and. [i,j,k] == cells/2+1 .and. &
                   spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID)                               ! for even grids, set the Nyquist Freq component to 0.0
-              xi1st(1:3,i,k,j-cells2Offset) = cmplx(0.0_pReal,0.0_pReal,pReal)
+              xi1st(1:3,i,k,j-cells2Offset) = cmplx(0.0_pREAL,0.0_pREAL,pREAL)
             elsewhere
               xi1st(1:3,i,k,j-cells2Offset) = xi2nd(1:3,i,k,j-cells2Offset)
             endwhere
   end do; end do; end do
 
   if (num%memory_efficient) then                                                                    ! allocate just single fourth order tensor
-    allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pReal,0.0_pReal,pReal))
+    allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pREAL,0.0_pREAL,pREAL))
   else                                                                                              ! precalculation of gamma_hat field
-    allocate (gamma_hat(3,3,3,3,cells1Red,cells(3),cells2), source = cmplx(0.0_pReal,0.0_pReal,pReal))
+    allocate (gamma_hat(3,3,3,3,cells1Red,cells(3),cells2), source = cmplx(0.0_pREAL,0.0_pREAL,pREAL))
   end if
 
   call selfTest()
@@ -346,10 +346,10 @@ end subroutine spectral_utilities_init
 !---------------------------------------------------------------------------------------------------
 subroutine utilities_updateGamma(C)
 
-  real(pReal), intent(in), dimension(3,3,3,3) :: C                                                  !< input stiffness to store as reference stiffness
+  real(pREAL), intent(in), dimension(3,3,3,3) :: C                                                  !< input stiffness to store as reference stiffness
 
-  complex(pReal),              dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
-  real(pReal),                 dimension(6,6) :: A, A_inv
+  complex(pREAL),              dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
+  real(pREAL),                 dimension(6,6) :: A, A_inv
   integer :: &
     i, j, k, &
     l, m, n, o
@@ -359,7 +359,7 @@ subroutine utilities_updateGamma(C)
   C_ref = C/wgt
 
   if (.not. num%memory_efficient) then
-    gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal)                                                    ! for the singular point and any non invertible A
+    gamma_hat = cmplx(0.0_pREAL,0.0_pREAL,pREAL)                                                    ! for the singular point and any non invertible A
     !$OMP PARALLEL DO PRIVATE(l,m,n,o,temp33_cmplx,xiDyad_cmplx,A,A_inv,err)
     do j = cells2Offset+1, cells2Offset+cells2; do k = 1, cells(3); do i = 1, cells1Red
       if (any([i,j,k] /= 1)) then                                                                   ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
@@ -368,19 +368,19 @@ subroutine utilities_updateGamma(C)
           xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j-cells2Offset))*xi1st(m,i,k,j-cells2Offset)
         end do
         do concurrent(l = 1:3, m = 1:3)
-          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
         end do
 #else
         forall(l = 1:3, m = 1:3) &
           xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j-cells2Offset))*xi1st(m,i,k,j-cells2Offset)
         forall(l = 1:3, m = 1:3) &
-          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
 #endif
         A(1:3,1:3) = temp33_cmplx%re; A(4:6,4:6) =  temp33_cmplx%re
         A(1:3,4:6) = temp33_cmplx%im; A(4:6,1:3) = -temp33_cmplx%im
-        if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pReal) then
+        if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pREAL) then
           call math_invert(A_inv, err, A)
-          temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal)
+          temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pREAL)
 #ifndef __INTEL_COMPILER
           do concurrent(l=1:3, m=1:3, n=1:3, o=1:3)
             gamma_hat(l,m,n,o,i,k,j-cells2Offset) = temp33_cmplx(l,n) * xiDyad_cmplx(o,m)
@@ -404,12 +404,12 @@ end subroutine utilities_updateGamma
 !--------------------------------------------------------------------------------------------------
 function utilities_GammaConvolution(field, fieldAim) result(gammaField)
 
-  real(pReal), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: field
-  real(pReal), intent(in), dimension(3,3) :: fieldAim                                               !< desired average value of the field after convolution
-  real(pReal),             dimension(3,3,cells(1),cells(2),cells3) :: gammaField
+  real(pREAL), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: field
+  real(pREAL), intent(in), dimension(3,3) :: fieldAim                                               !< desired average value of the field after convolution
+  real(pREAL),             dimension(3,3,cells(1),cells(2),cells3) :: gammaField
 
-  complex(pReal), dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
-  real(pReal),    dimension(6,6) :: A, A_inv
+  complex(pREAL), dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
+  real(pREAL),    dimension(6,6) :: A, A_inv
   integer :: &
     i, j, k, &
     l, m, n, o
@@ -419,7 +419,7 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
   print'(/,1x,a)', '... doing gamma convolution ...............................................'
   flush(IO_STDOUT)
 
-  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
   tensorField_real(1:3,1:3,1:cells(1),            1:cells(2),1:cells3) = field
   call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
 
@@ -432,19 +432,19 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
           xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j))*xi1st(m,i,k,j)
         end do
         do concurrent(l = 1:3, m = 1:3)
-          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
         end do
 #else
         forall(l = 1:3, m = 1:3) &
           xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j))*xi1st(m,i,k,j)
         forall(l = 1:3, m = 1:3) &
-          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+          temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
 #endif
         A(1:3,1:3) = temp33_cmplx%re; A(4:6,4:6) =  temp33_cmplx%re
         A(1:3,4:6) = temp33_cmplx%im; A(4:6,1:3) = -temp33_cmplx%im
-        if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pReal) then
+        if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pREAL) then
           call math_invert(A_inv, err, A)
-          temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal)
+          temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pREAL)
 #ifndef __INTEL_COMPILER
           do concurrent(l=1:3, m=1:3, n=1:3, o=1:3)
             gamma_hat(l,m,n,o,1,1,1) = temp33_cmplx(l,n)*xiDyad_cmplx(o,m)
@@ -460,7 +460,7 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
 #endif
           tensorField_fourier(1:3,1:3,i,k,j) = temp33_cmplx
         else
-          tensorField_fourier(1:3,1:3,i,k,j) = cmplx(0.0_pReal,0.0_pReal,pReal)
+          tensorField_fourier(1:3,1:3,i,k,j) = cmplx(0.0_pREAL,0.0_pREAL,pREAL)
         end if
       end if
     end do; end do; end do
@@ -481,7 +481,7 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
     !$OMP END PARALLEL DO
   end if memoryEfficient
 
-  if (cells3Offset == 0) tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim,0.0_pReal,pReal)
+  if (cells3Offset == 0) tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim,0.0_pREAL,pREAL)
 
   call fftw_mpi_execute_dft_c2r(planTensorBack,tensorField_fourier,tensorField_real)
   gammaField = tensorField_real(1:3,1:3,1:cells(1),1:cells(2),1:cells3)
@@ -494,24 +494,24 @@ end function utilities_GammaConvolution
 !--------------------------------------------------------------------------------------------------
 function utilities_GreenConvolution(field, D_ref, mu_ref, Delta_t) result(greenField)
 
-  real(pReal), intent(in), dimension(cells(1),cells(2),cells3) :: field
-  real(pReal), dimension(3,3), intent(in) :: D_ref
-  real(pReal),                 intent(in) :: mu_ref, Delta_t
-  real(pReal), dimension(cells(1),cells(2),cells3) :: greenField
+  real(pREAL), intent(in), dimension(cells(1),cells(2),cells3) :: field
+  real(pREAL), dimension(3,3), intent(in) :: D_ref
+  real(pREAL),                 intent(in) :: mu_ref, Delta_t
+  real(pREAL), dimension(cells(1),cells(2),cells3) :: greenField
 
-  complex(pReal)                          :: GreenOp_hat
+  complex(pREAL)                          :: GreenOp_hat
   integer                                 :: i, j, k
 
 
-  scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+  scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
   scalarField_real(1:cells(1),            1:cells(2),1:cells3) = field
   call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
 
   !$OMP PARALLEL DO PRIVATE(GreenOp_hat)
   do j = 1, cells2; do k = 1, cells(3); do i = 1, cells1Red
-    GreenOp_hat = cmplx(wgt,0.0_pReal,pReal) &
-                / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal,pReal) &
-                   * sum(conjg(xi1st(1:3,i,k,j))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,k,j))))
+    GreenOp_hat = cmplx(wgt,0.0_pREAL,pREAL) &
+                / (cmplx(mu_ref,0.0_pREAL,pREAL) + cmplx(Delta_t,0.0_pREAL,pREAL) &
+                   * sum(conjg(xi1st(1:3,i,k,j))* matmul(cmplx(D_ref,0.0_pREAL,pREAL),xi1st(1:3,i,k,j))))
     scalarField_fourier(i,k,j) = scalarField_fourier(i,k,j)*GreenOp_hat
   end do; end do; end do
   !$OMP END PARALLEL DO
@@ -525,28 +525,28 @@ end function utilities_GreenConvolution
 !--------------------------------------------------------------------------------------------------
 !> @brief Calculate root mean square of divergence.
 !--------------------------------------------------------------------------------------------------
-real(pReal) function utilities_divergenceRMS(tensorField)
+real(pREAL) function utilities_divergenceRMS(tensorField)
 
-  real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
+  real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
 
   integer :: i, j, k
   integer(MPI_INTEGER_KIND) :: err_MPI
-  complex(pReal), dimension(3) :: rescaledGeom
+  complex(pREAL), dimension(3) :: rescaledGeom
 
 
-  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
   tensorField_real(1:3,1:3,1:cells(1),            1:cells(2),1:cells3) = tensorField
   call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
 
-  rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal,pReal)
+  rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pREAL,pREAL)
 
 !--------------------------------------------------------------------------------------------------
 ! calculating RMS divergence criterion in Fourier space
-  utilities_divergenceRMS = 0.0_pReal
+  utilities_divergenceRMS = 0.0_pREAL
   do j = 1, cells2; do k = 1, cells(3)
     do i = 2, cells1Red -1                                                                          ! Has somewhere a conj. complex counterpart. Therefore count it twice.
       utilities_divergenceRMS = utilities_divergenceRMS &
-            + 2.0_pReal*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,k,j), &                     ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2, i.e. do not take square root and square again
+            + 2.0_pREAL*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,k,j), &                     ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2, i.e. do not take square root and square again
                                           conjg(-xi1st(1:3,i,k,j))*rescaledGeom))**2) &             ! --> sum squared L_2 norm of vector
                         +sum(aimag(matmul(tensorField_fourier(1:3,1:3,i,k,j),&
                                           conjg(-xi1st(1:3,i,k,j))*rescaledGeom))**2))
@@ -564,7 +564,7 @@ real(pReal) function utilities_divergenceRMS(tensorField)
   call MPI_Allreduce(MPI_IN_PLACE,utilities_divergenceRMS,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   utilities_divergenceRMS = sqrt(utilities_divergenceRMS) * wgt                                     ! RMS in real space calculated with Parsevals theorem from Fourier space
-  if (cells(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal                  ! counted twice in case of cells(1) == 1
+  if (cells(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pREAL                  ! counted twice in case of cells(1) == 1
 
 end function utilities_divergenceRMS
 
@@ -572,25 +572,25 @@ end function utilities_divergenceRMS
 !--------------------------------------------------------------------------------------------------
 !> @brief Calculate root mean square of curl.
 !--------------------------------------------------------------------------------------------------
-real(pReal) function utilities_curlRMS(tensorField)
+real(pREAL) function utilities_curlRMS(tensorField)
 
-  real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
+  real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
 
   integer  ::  i, j, k, l
   integer(MPI_INTEGER_KIND) :: err_MPI
-  complex(pReal), dimension(3,3) :: curl_fourier
-  complex(pReal), dimension(3)   :: rescaledGeom
+  complex(pREAL), dimension(3,3) :: curl_fourier
+  complex(pREAL), dimension(3)   :: rescaledGeom
 
 
-  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
   tensorField_real(1:3,1:3,1:cells(1),            1:cells(2),1:cells3) = tensorField
   call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
 
-  rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal,pReal)
+  rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pREAL,pREAL)
 
 !--------------------------------------------------------------------------------------------------
 ! calculating max curl criterion in Fourier space
-  utilities_curlRMS = 0.0_pReal
+  utilities_curlRMS = 0.0_pREAL
 
   do j = 1, cells2; do k = 1, cells(3);
     do i = 2, cells1Red - 1
@@ -603,7 +603,7 @@ real(pReal) function utilities_curlRMS(tensorField)
                              -tensorField_fourier(l,1,i,k,j)*xi1st(2,i,k,j)*rescaledGeom(2))
       end do
       utilities_curlRMS = utilities_curlRMS &
-                        +2.0_pReal*sum(curl_fourier%re**2+curl_fourier%im**2)                       ! Has somewhere a conj. complex counterpart. Therefore count it twice.
+                        +2.0_pREAL*sum(curl_fourier%re**2+curl_fourier%im**2)                       ! Has somewhere a conj. complex counterpart. Therefore count it twice.
     end do
     do l = 1, 3
        curl_fourier = (+tensorField_fourier(l,3,1,k,j)*xi1st(2,1,k,j)*rescaledGeom(2) &
@@ -630,7 +630,7 @@ real(pReal) function utilities_curlRMS(tensorField)
   call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   utilities_curlRMS = sqrt(utilities_curlRMS) * wgt                                                 ! RMS in real space calculated with Parsevals theorem from Fourier space
-  if (cells(1) == 1) utilities_curlRMS = utilities_curlRMS * 0.5_pReal                              ! counted twice in case of cells(1) == 1
+  if (cells(1) == 1) utilities_curlRMS = utilities_curlRMS * 0.5_pREAL                              ! counted twice in case of cells(1) == 1
 
 end function utilities_curlRMS
 
@@ -640,17 +640,17 @@ end function utilities_curlRMS
 !--------------------------------------------------------------------------------------------------
 function utilities_maskedCompliance(rot_BC,mask_stress,C)
 
-  real(pReal),                dimension(3,3,3,3) :: utilities_maskedCompliance                      !< masked compliance
-  real(pReal),    intent(in), dimension(3,3,3,3) :: C                                               !< current average stiffness
+  real(pREAL),                dimension(3,3,3,3) :: utilities_maskedCompliance                      !< masked compliance
+  real(pREAL),    intent(in), dimension(3,3,3,3) :: C                                               !< current average stiffness
   type(tRotation), intent(in)                    :: rot_BC                                          !< rotation of load frame
   logical,        intent(in), dimension(3,3)     :: mask_stress                                     !< mask of stress BC
 
   integer :: i, j
   logical, dimension(9)   :: mask_stressVector
   logical, dimension(9,9) :: mask
-  real(pReal), dimension(9,9) :: temp99_real
+  real(pREAL), dimension(9,9) :: temp99_real
   integer :: size_reduced = 0
-  real(pReal),              dimension(:,:), allocatable ::  &
+  real(pREAL),              dimension(:,:), allocatable ::  &
     s_reduced, &                                                                                    !< reduced compliance matrix (depending on number of stress BC)
     c_reduced, &                                                                                    !< reduced stiffness (depending on number of stress BC)
     sTimesC                                                                                         !< temp variable to check inversion
@@ -674,7 +674,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
 !--------------------------------------------------------------------------------------------------
 ! check if inversion was successful
     sTimesC = matmul(c_reduced,s_reduced)
-    errmatinv = errmatinv .or. any(dNeq(sTimesC,math_eye(size_reduced),1.0e-12_pReal))
+    errmatinv = errmatinv .or. any(dNeq(sTimesC,math_eye(size_reduced),1.0e-12_pREAL))
     if (errmatinv) then
       write(formatString, '(i2)') size_reduced
       formatString = '(/,1x,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
@@ -682,9 +682,9 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
       print trim(formatString), 'S (load) ', transpose(s_reduced)
       if (errmatinv) error stop 'matrix inversion error'
     end if
-    temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pReal),[9,9])
+    temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pREAL),[9,9])
   else
-    temp99_real = 0.0_pReal
+    temp99_real = 0.0_pREAL
   end if
 
   utilities_maskedCompliance = math_99to3333(temp99_Real)
@@ -697,13 +697,13 @@ end function utilities_maskedCompliance
 !--------------------------------------------------------------------------------------------------
 function utilities_scalarGradient(field) result(grad)
 
-  real(pReal), intent(in), dimension(  cells(1),cells(2),cells3) :: field
-  real(pReal),             dimension(3,cells(1),cells(2),cells3) :: grad
+  real(pREAL), intent(in), dimension(  cells(1),cells(2),cells3) :: field
+  real(pREAL),             dimension(3,cells(1),cells(2),cells3) :: grad
 
   integer :: i, j, k
 
 
-  scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+  scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
   scalarField_real(1:cells(1),            1:cells(2),1:cells3) = field
   call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
   do j = 1, cells2;  do k = 1, cells(3);  do i = 1,cells1Red
@@ -720,11 +720,11 @@ end function utilities_scalarGradient
 !--------------------------------------------------------------------------------------------------
 function utilities_vectorDivergence(field) result(div)
 
-  real(pReal), intent(in), dimension(3,cells(1),cells(2),cells3) :: field
-  real(pReal),             dimension(  cells(1),cells(2),cells3) :: div
+  real(pREAL), intent(in), dimension(3,cells(1),cells(2),cells3) :: field
+  real(pREAL),             dimension(  cells(1),cells(2),cells3) :: div
 
 
-  vectorField_real(1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+  vectorField_real(1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
   vectorField_real(1:3,1:cells(1),            1:cells(2),1:cells3) = field
   call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
   scalarField_fourier(1:cells1Red,1:cells(3),1:cells2) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(3),1:cells2) &
@@ -741,19 +741,19 @@ end function utilities_vectorDivergence
 subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
                                           F,Delta_t,rotation_BC)
 
-  real(pReal),    intent(out), dimension(3,3,3,3)                   :: C_volAvg, C_minmaxAvg        !< average stiffness
-  real(pReal),    intent(out), dimension(3,3)                       :: P_av                         !< average PK stress
-  real(pReal),    intent(out), dimension(3,3,cells(1),cells(2),cells3) :: P                         !< PK stress
-  real(pReal),    intent(in),  dimension(3,3,cells(1),cells(2),cells3) :: F                         !< deformation gradient target
-  real(pReal),    intent(in)                                        :: Delta_t                      !< loading time
+  real(pREAL),    intent(out), dimension(3,3,3,3)                   :: C_volAvg, C_minmaxAvg        !< average stiffness
+  real(pREAL),    intent(out), dimension(3,3)                       :: P_av                         !< average PK stress
+  real(pREAL),    intent(out), dimension(3,3,cells(1),cells(2),cells3) :: P                         !< PK stress
+  real(pREAL),    intent(in),  dimension(3,3,cells(1),cells(2),cells3) :: F                         !< deformation gradient target
+  real(pREAL),    intent(in)                                        :: Delta_t                      !< loading time
   type(tRotation), intent(in),  optional                            :: rotation_BC                  !< rotation of load frame
 
 
   integer :: i
   integer(MPI_INTEGER_KIND) :: err_MPI
-  real(pReal), dimension(3,3,3,3) :: dPdF_max,      dPdF_min
-  real(pReal)                     :: dPdF_norm_max, dPdF_norm_min
-  real(pReal), dimension(2) :: valueAndRank                                                         !< pair of min/max norm of dPdF to synchronize min/max of dPdF
+  real(pREAL), dimension(3,3,3,3) :: dPdF_max,      dPdF_min
+  real(pREAL)                     :: dPdF_norm_max, dPdF_norm_min
+  real(pREAL), dimension(2) :: valueAndRank                                                         !< pair of min/max norm of dPdF to synchronize min/max of dPdF
 
   print'(/,1x,a)', '... evaluating constitutive response ......................................'
   flush(IO_STDOUT)
@@ -771,19 +771,19 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
   call MPI_Allreduce(MPI_IN_PLACE,P_av,9_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   if (present(rotation_BC)) then
-    if (any(dNeq(rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+    if (any(dNeq(rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
       print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-      'Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal
+      'Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pREAL
     P_av = rotation_BC%rotate(P_av)
   end if
   print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-    'Piola--Kirchhoff stress       / MPa =', transpose(P_av)*1.e-6_pReal
+    'Piola--Kirchhoff stress       / MPa =', transpose(P_av)*1.e-6_pREAL
   flush(IO_STDOUT)
 
-  dPdF_max = 0.0_pReal
-  dPdF_norm_max = 0.0_pReal
-  dPdF_min = huge(1.0_pReal)
-  dPdF_norm_min = huge(1.0_pReal)
+  dPdF_max = 0.0_pREAL
+  dPdF_norm_max = 0.0_pREAL
+  dPdF_min = huge(1.0_pREAL)
+  dPdF_norm_min = huge(1.0_pREAL)
   do i = 1, product(cells(1:2))*cells3
     if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2)) then
       dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,i)
@@ -795,19 +795,19 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
     end if
   end do
 
-  valueAndRank = [dPdF_norm_max,real(worldrank,pReal)]
+  valueAndRank = [dPdF_norm_max,real(worldrank,pREAL)]
   call MPI_Allreduce(MPI_IN_PLACE,valueAndRank,1_MPI_INTEGER_KIND,MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   call MPI_Bcast(dPdF_max,81_MPI_INTEGER_KIND,MPI_DOUBLE,int(valueAndRank(2),MPI_INTEGER_KIND),MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
 
-  valueAndRank = [dPdF_norm_min,real(worldrank,pReal)]
+  valueAndRank = [dPdF_norm_min,real(worldrank,pREAL)]
   call MPI_Allreduce(MPI_IN_PLACE,valueAndRank,1_MPI_INTEGER_KIND,MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   call MPI_Bcast(dPdF_min,81_MPI_INTEGER_KIND,MPI_DOUBLE,int(valueAndRank(2),MPI_INTEGER_KIND),MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
 
-  C_minmaxAvg = 0.5_pReal*(dPdF_max + dPdF_min)
+  C_minmaxAvg = 0.5_pREAL*(dPdF_max + dPdF_min)
 
   C_volAvg = sum(homogenization_dPdF,dim=5)
   call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
@@ -823,16 +823,16 @@ end subroutine utilities_constitutiveResponse
 !--------------------------------------------------------------------------------------------------
 pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate)
 
-  real(pReal), intent(in), dimension(3,3) :: &
+  real(pREAL), intent(in), dimension(3,3) :: &
     avRate                                                                                          !< homogeneous addon
-  real(pReal), intent(in) :: &
+  real(pREAL), intent(in) :: &
     dt                                                                                              !< Delta_t between field0 and field
   logical, intent(in) :: &
     heterogeneous                                                                                   !< calculate field of rates
-  real(pReal), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: &
+  real(pREAL), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: &
     field0, &                                                                                       !< data of previous step
     field                                                                                           !< data of current step
-  real(pReal),             dimension(3,3,cells(1),cells(2),cells3) :: &
+  real(pREAL),             dimension(3,3,cells(1),cells(2),cells3) :: &
     utilities_calculateRate
 
 
@@ -849,17 +849,17 @@ end function utilities_calculateRate
 !--------------------------------------------------------------------------------------------------
 function utilities_forwardField(Delta_t,field_lastInc,rate,aim)
 
-  real(pReal), intent(in) :: &
+  real(pREAL), intent(in) :: &
     Delta_t                                                                                         !< Delta_t of current step
-  real(pReal), intent(in),           dimension(3,3,cells(1),cells(2),cells3) :: &
+  real(pREAL), intent(in),           dimension(3,3,cells(1),cells(2),cells3) :: &
     field_lastInc, &                                                                                !< initial field
     rate                                                                                            !< rate by which to forward
-  real(pReal), intent(in), optional, dimension(3,3) :: &
+  real(pREAL), intent(in), optional, dimension(3,3) :: &
     aim                                                                                             !< average field value aim
 
-  real(pReal),                       dimension(3,3,cells(1),cells(2),cells3) :: &
+  real(pREAL),                       dimension(3,3,cells(1),cells(2),cells3) :: &
     utilities_forwardField
-  real(pReal),                       dimension(3,3) :: fieldDiff                                    !< <a + adot*t> - aim
+  real(pREAL),                       dimension(3,3) :: fieldDiff                                    !< <a + adot*t> - aim
   integer(MPI_INTEGER_KIND) :: err_MPI
 
 
@@ -885,42 +885,42 @@ pure function utilities_getFreqDerivative(k_s)
 
   integer, intent(in),  dimension(3) :: k_s                                                         !< indices of frequency
 
-  complex(pReal),       dimension(3) :: utilities_getFreqDerivative
+  complex(pREAL),       dimension(3) :: utilities_getFreqDerivative
 
 
   select case (spectral_derivative_ID)
     case (DERIVATIVE_CONTINUOUS_ID)
-      utilities_getFreqDerivative = cmplx(0.0_pReal, TAU*real(k_s,pReal)/geomSize,pReal)
+      utilities_getFreqDerivative = cmplx(0.0_pREAL, TAU*real(k_s,pREAL)/geomSize,pREAL)
 
     case (DERIVATIVE_CENTRAL_DIFF_ID)
-      utilities_getFreqDerivative = cmplx(0.0_pReal, sin(TAU*real(k_s,pReal)/real(cells,pReal)), pReal)/ &
-                                    cmplx(2.0_pReal*geomSize/real(cells,pReal), 0.0_pReal, pReal)
+      utilities_getFreqDerivative = cmplx(0.0_pREAL, sin(TAU*real(k_s,pREAL)/real(cells,pREAL)), pREAL)/ &
+                                    cmplx(2.0_pREAL*geomSize/real(cells,pREAL), 0.0_pREAL, pREAL)
 
     case (DERIVATIVE_FWBW_DIFF_ID)
       utilities_getFreqDerivative(1) = &
-                               cmplx(cos(TAU*real(k_s(1),pReal)/real(cells(1),pReal)) - 1.0_pReal, &
-                                     sin(TAU*real(k_s(1),pReal)/real(cells(1),pReal)), pReal)* &
-                               cmplx(cos(TAU*real(k_s(2),pReal)/real(cells(2),pReal)) + 1.0_pReal, &
-                                     sin(TAU*real(k_s(2),pReal)/real(cells(2),pReal)), pReal)* &
-                               cmplx(cos(TAU*real(k_s(3),pReal)/real(cells(3),pReal)) + 1.0_pReal, &
-                                     sin(TAU*real(k_s(3),pReal)/real(cells(3),pReal)), pReal)/ &
-                               cmplx(4.0_pReal*geomSize(1)/real(cells(1),pReal), 0.0_pReal, pReal)
+                               cmplx(cos(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)) - 1.0_pREAL, &
+                                     sin(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)), pREAL)* &
+                               cmplx(cos(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)) + 1.0_pREAL, &
+                                     sin(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)), pREAL)* &
+                               cmplx(cos(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)) + 1.0_pREAL, &
+                                     sin(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)), pREAL)/ &
+                               cmplx(4.0_pREAL*geomSize(1)/real(cells(1),pREAL), 0.0_pREAL, pREAL)
       utilities_getFreqDerivative(2) = &
-                               cmplx(cos(TAU*real(k_s(1),pReal)/real(cells(1),pReal)) + 1.0_pReal, &
-                                     sin(TAU*real(k_s(1),pReal)/real(cells(1),pReal)), pReal)* &
-                               cmplx(cos(TAU*real(k_s(2),pReal)/real(cells(2),pReal)) - 1.0_pReal, &
-                                     sin(TAU*real(k_s(2),pReal)/real(cells(2),pReal)), pReal)* &
-                               cmplx(cos(TAU*real(k_s(3),pReal)/real(cells(3),pReal)) + 1.0_pReal, &
-                                     sin(TAU*real(k_s(3),pReal)/real(cells(3),pReal)), pReal)/ &
-                               cmplx(4.0_pReal*geomSize(2)/real(cells(2),pReal), 0.0_pReal, pReal)
+                               cmplx(cos(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)) + 1.0_pREAL, &
+                                     sin(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)), pREAL)* &
+                               cmplx(cos(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)) - 1.0_pREAL, &
+                                     sin(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)), pREAL)* &
+                               cmplx(cos(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)) + 1.0_pREAL, &
+                                     sin(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)), pREAL)/ &
+                               cmplx(4.0_pREAL*geomSize(2)/real(cells(2),pREAL), 0.0_pREAL, pREAL)
       utilities_getFreqDerivative(3) = &
-                               cmplx(cos(TAU*real(k_s(1),pReal)/real(cells(1),pReal)) + 1.0_pReal, &
-                                     sin(TAU*real(k_s(1),pReal)/real(cells(1),pReal)), pReal)* &
-                               cmplx(cos(TAU*real(k_s(2),pReal)/real(cells(2),pReal)) + 1.0_pReal, &
-                                     sin(TAU*real(k_s(2),pReal)/real(cells(2),pReal)), pReal)* &
-                               cmplx(cos(TAU*real(k_s(3),pReal)/real(cells(3),pReal)) - 1.0_pReal, &
-                                     sin(TAU*real(k_s(3),pReal)/real(cells(3),pReal)), pReal)/ &
-                               cmplx(4.0_pReal*geomSize(3)/real(cells(3),pReal), 0.0_pReal, pReal)
+                               cmplx(cos(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)) + 1.0_pREAL, &
+                                     sin(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)), pREAL)* &
+                               cmplx(cos(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)) + 1.0_pREAL, &
+                                     sin(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)), pREAL)* &
+                               cmplx(cos(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)) - 1.0_pREAL, &
+                                     sin(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)), pREAL)/ &
+                               cmplx(4.0_pREAL*geomSize(3)/real(cells(3),pREAL), 0.0_pREAL, pREAL)
   end select
 
 end function utilities_getFreqDerivative
@@ -932,11 +932,11 @@ end function utilities_getFreqDerivative
 !--------------------------------------------------------------------------------------------------
 subroutine utilities_updateCoords(F)
 
-  real(pReal),   dimension(3,3,cells(1),cells(2),cells3), intent(in) :: F
+  real(pREAL),   dimension(3,3,cells(1),cells(2),cells3), intent(in) :: F
 
-  real(pReal),   dimension(3,  cells(1),cells(2),cells3)             :: x_p                         !< Point/cell center coordinates
-  real(pReal),   dimension(3,  cells(1),cells(2),0:cells3+1)         :: u_tilde_p_padded            !< Fluctuation of cell center displacement (padded along z for MPI)
-  real(pReal),   dimension(3,  cells(1)+1,cells(2)+1,cells3+1)       :: x_n                         !< Node coordinates
+  real(pREAL),   dimension(3,  cells(1),cells(2),cells3)             :: x_p                         !< Point/cell center coordinates
+  real(pREAL),   dimension(3,  cells(1),cells(2),0:cells3+1)         :: u_tilde_p_padded            !< Fluctuation of cell center displacement (padded along z for MPI)
+  real(pREAL),   dimension(3,  cells(1)+1,cells(2)+1,cells3+1)       :: x_n                         !< Node coordinates
   integer :: &
     i,j,k,n, &
     c
@@ -950,8 +950,8 @@ subroutine utilities_updateCoords(F)
   integer, dimension(4) :: request
   integer, dimension(MPI_STATUS_SIZE,4) :: status
 #endif
-  real(pReal),   dimension(3)   :: step
-  real(pReal),   dimension(3,3) :: Favg
+  real(pREAL),   dimension(3)   :: step
+  real(pREAL),   dimension(3,3) :: Favg
   integer,       dimension(3)   :: me
   integer, dimension(3,8) :: &
     neighbor = reshape([ &
@@ -965,10 +965,10 @@ subroutine utilities_updateCoords(F)
                         0, 1, 1  ], [3,8])
 
 
-  step = geomSize/real(cells, pReal)
+  step = geomSize/real(cells, pREAL)
 
   tensorField_real(1:3,1:3,1:cells(1),            1:cells(2),1:cells3) = F
-  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
   call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
 
  !--------------------------------------------------------------------------------------------------
@@ -985,7 +985,7 @@ subroutine utilities_updateCoords(F)
       vectorField_fourier(1:3,i,k,j) = matmul(tensorField_fourier(1:3,1:3,i,k,j),xi2nd(1:3,i,k,j)) &
                                      / sum(conjg(-xi2nd(1:3,i,k,j))*xi2nd(1:3,i,k,j))
     else
-      vectorField_fourier(1:3,i,k,j) = cmplx(0.0,0.0,pReal)
+      vectorField_fourier(1:3,i,k,j) = cmplx(0.0,0.0,pREAL)
     end if
   end do; end do; end do
   !$OMP END PARALLEL DO
@@ -1021,13 +1021,13 @@ subroutine utilities_updateCoords(F)
 
  !--------------------------------------------------------------------------------------------------
  ! calculate nodal positions
-  x_n = 0.0_pReal
+  x_n = 0.0_pREAL
   do j = 0,cells(2); do k = 0,cells3; do i = 0,cells(1)
-    x_n(1:3,i+1,j+1,k+1) = matmul(Favg,step*(real([i,j,k+cells3Offset],pReal)))
+    x_n(1:3,i+1,j+1,k+1) = matmul(Favg,step*(real([i,j,k+cells3Offset],pREAL)))
     averageFluct: do n = 1,8
       me = [i+neighbor(1,n),j+neighbor(2,n),k+neighbor(3,n)]
       x_n(1:3,i+1,j+1,k+1) = x_n(1:3,i+1,j+1,k+1) &
-                           + u_tilde_p_padded(1:3,modulo(me(1)-1,cells(1))+1,modulo(me(2)-1,cells(2))+1,me(3))*0.125_pReal
+                           + u_tilde_p_padded(1:3,modulo(me(1)-1,cells(1))+1,modulo(me(2)-1,cells(2))+1,me(3))*0.125_pREAL
     end do averageFluct
   end do; end do; end do
 
@@ -1035,7 +1035,7 @@ subroutine utilities_updateCoords(F)
  ! calculate cell center/point positions
   do k = 1,cells3; do j = 1,cells(2); do i = 1,cells(1)
     x_p(1:3,i,j,k) = u_tilde_p_padded(1:3,i,j,k) &
-                   + matmul(Favg,step*(real([i,j,k+cells3Offset],pReal)-0.5_pReal))
+                   + matmul(Favg,step*(real([i,j,k+cells3Offset],pREAL)-0.5_pREAL))
   end do; end do; end do
 
   call discretization_setNodeCoords(reshape(x_n,[3,(cells(1)+1)*(cells(2)+1)*(cells3+1)]))
@@ -1049,62 +1049,62 @@ end subroutine utilities_updateCoords
 !--------------------------------------------------------------------------------------------------
 subroutine selfTest()
 
-  real(pReal), allocatable, dimension(:,:,:,:,:) :: tensorField_real_
-  real(pReal), allocatable, dimension(:,:,:,:) :: vectorField_real_
-  real(pReal), allocatable, dimension(:,:,:) :: scalarField_real_
-  real(pReal), dimension(3,3) :: tensorSum
-  real(pReal), dimension(3) :: vectorSum
-  real(pReal) :: scalarSum
-  real(pReal), dimension(3,3) :: r
+  real(pREAL), allocatable, dimension(:,:,:,:,:) :: tensorField_real_
+  real(pREAL), allocatable, dimension(:,:,:,:) :: vectorField_real_
+  real(pREAL), allocatable, dimension(:,:,:) :: scalarField_real_
+  real(pREAL), dimension(3,3) :: tensorSum
+  real(pREAL), dimension(3) :: vectorSum
+  real(pREAL) :: scalarSum
+  real(pREAL), dimension(3,3) :: r
   integer(MPI_INTEGER_KIND) :: err_MPI
 
 
   call random_number(tensorField_real)
-  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
+  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
   tensorField_real_ = tensorField_real
   call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
   call MPI_Allreduce(sum(sum(sum(tensorField_real_,dim=5),dim=4),dim=3),tensorSum,9_MPI_INTEGER_KIND, &
                      MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   if (worldrank==0) then
-    if (any(dNeq(tensorSum/tensorField_fourier(:,:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) &
+    if (any(dNeq(tensorSum/tensorField_fourier(:,:,1,1,1)%re,1.0_pREAL,1.0e-12_pREAL))) &
       error stop 'mismatch avg tensorField FFT <-> real'
   end if
   call fftw_mpi_execute_dft_c2r(planTensorBack,tensorField_fourier,tensorField_real)
-  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
-  if (maxval(abs(tensorField_real_ - tensorField_real*wgt))>5.0e-15_pReal) &
+  tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
+  if (maxval(abs(tensorField_real_ - tensorField_real*wgt))>5.0e-15_pREAL) &
     error stop 'mismatch tensorField FFT/invFFT <-> real'
 
   call random_number(vectorField_real)
-  vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
+  vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
   vectorField_real_ = vectorField_real
   call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
   call MPI_Allreduce(sum(sum(sum(vectorField_real_,dim=4),dim=3),dim=2),vectorSum,3_MPI_INTEGER_KIND, &
                      MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   if (worldrank==0) then
-    if (any(dNeq(vectorSum/vectorField_fourier(:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) &
+    if (any(dNeq(vectorSum/vectorField_fourier(:,1,1,1)%re,1.0_pREAL,1.0e-12_pREAL))) &
       error stop 'mismatch avg vectorField FFT <-> real'
   end if
   call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real)
-  vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
-  if (maxval(abs(vectorField_real_ - vectorField_real*wgt))>5.0e-15_pReal) &
+  vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
+  if (maxval(abs(vectorField_real_ - vectorField_real*wgt))>5.0e-15_pREAL) &
     error stop 'mismatch vectorField FFT/invFFT <-> real'
 
   call random_number(scalarField_real)
-  scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
+  scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
   scalarField_real_ = scalarField_real
   call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
   call MPI_Allreduce(sum(sum(sum(scalarField_real_,dim=3),dim=2),dim=1),scalarSum,1_MPI_INTEGER_KIND, &
                      MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
   if (worldrank==0) then
-    if (dNeq(scalarSum/scalarField_fourier(1,1,1)%re,1.0_pReal,1.0e-12_pReal)) &
+    if (dNeq(scalarSum/scalarField_fourier(1,1,1)%re,1.0_pREAL,1.0e-12_pREAL)) &
       error stop 'mismatch avg scalarField FFT <-> real'
   end if
   call fftw_mpi_execute_dft_c2r(planScalarBack,scalarField_fourier,scalarField_real)
-  scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
-  if (maxval(abs(scalarField_real_ - scalarField_real*wgt))>5.0e-15_pReal) &
+  scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
+  if (maxval(abs(scalarField_real_ - scalarField_real*wgt))>5.0e-15_pREAL) &
     error stop 'mismatch scalarField FFT/invFFT <-> real'
 
   call random_number(r)
@@ -1112,54 +1112,54 @@ subroutine selfTest()
   if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
 
   scalarField_real_ = r(1,1)
-  if (maxval(abs(utilities_scalarGradient(scalarField_real_)))>5.0e-9_pReal)   error stop 'non-zero grad(const)'
+  if (maxval(abs(utilities_scalarGradient(scalarField_real_)))>5.0e-9_pREAL)   error stop 'non-zero grad(const)'
 
   vectorField_real_ = spread(spread(spread(r(1,:),2,cells(1)),3,cells(2)),4,cells3)
-  if (maxval(abs(utilities_vectorDivergence(vectorField_real_)))>5.0e-9_pReal) error stop 'non-zero div(const)'
+  if (maxval(abs(utilities_vectorDivergence(vectorField_real_)))>5.0e-9_pREAL) error stop 'non-zero div(const)'
 
   tensorField_real_ = spread(spread(spread(r,3,cells(1)),4,cells(2)),5,cells3)
-  if (utilities_divergenceRMS(tensorField_real_)>5.0e-14_pReal) error stop 'non-zero RMS div(const)'
-  if (utilities_curlRMS(tensorField_real_)>5.0e-14_pReal)       error stop 'non-zero RMS curl(const)'
+  if (utilities_divergenceRMS(tensorField_real_)>5.0e-14_pREAL) error stop 'non-zero RMS div(const)'
+  if (utilities_curlRMS(tensorField_real_)>5.0e-14_pREAL)       error stop 'non-zero RMS curl(const)'
 
   if (cells(1) > 2 .and.  spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID) then
     scalarField_real_ = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
     vectorField_real_ = utilities_scalarGradient(scalarField_real_)/TAU*geomSize(1)
     scalarField_real_ = -spread(spread(planeSine  (cells(1)),2,cells(2)),3,cells3)
-    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'grad cosine'
+    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'grad cosine'
     scalarField_real_ = spread(spread(planeSine  (cells(1)),2,cells(2)),3,cells3)
     vectorField_real_ = utilities_scalarGradient(scalarField_real_)/TAU*geomSize(1)
     scalarField_real_ = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
-    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'grad sine'
+    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'grad sine'
 
-    vectorField_real_(2:3,:,:,:) = 0.0_pReal
+    vectorField_real_(2:3,:,:,:) = 0.0_pREAL
     vectorField_real_(1,:,:,:) = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
     scalarField_real_ = utilities_vectorDivergence(vectorField_real_)/TAU*geomSize(1)
     vectorField_real_(1,:,:,:) =-spread(spread(planeSine(  cells(1)),2,cells(2)),3,cells3)
-    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'div cosine'
-    vectorField_real_(2:3,:,:,:) = 0.0_pReal
+    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'div cosine'
+    vectorField_real_(2:3,:,:,:) = 0.0_pREAL
     vectorField_real_(1,:,:,:) = spread(spread(planeSine(  cells(1)),2,cells(2)),3,cells3)
     scalarField_real_ = utilities_vectorDivergence(vectorField_real_)/TAU*geomSize(1)
     vectorField_real_(1,:,:,:) = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
-    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'div sine'
+    if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'div sine'
   end if
 
   contains
 
     function planeCosine(n)
       integer, intent(in) :: n
-      real(pReal), dimension(n) :: planeCosine
+      real(pREAL), dimension(n) :: planeCosine
 
 
-      planeCosine = cos(real(math_range(n),pReal)/real(n,pReal)*TAU-TAU/real(n*2,pReal))
+      planeCosine = cos(real(math_range(n),pREAL)/real(n,pREAL)*TAU-TAU/real(n*2,pREAL))
 
     end function planeCosine
 
     function planeSine(n)
       integer, intent(in) :: n
-      real(pReal), dimension(n) :: planeSine
+      real(pREAL), dimension(n) :: planeSine
 
 
-      planeSine = sin(real(math_range(n),pReal)/real(n,pReal)*TAU-TAU/real(n*2,pReal))
+      planeSine = sin(real(math_range(n),pREAL)/real(n,pREAL)*TAU-TAU/real(n*2,pREAL))
 
     end function planeSine
 

src/homogenization.f90

@@ -25,7 +25,7 @@ module homogenization
     integer :: &
       sizeState        = 0                                                                          !< size of state
     ! http://stackoverflow.com/questions/3948210
-    real(pReal), pointer,     dimension(:,:), contiguous :: &                                       !< is basically an allocatable+target, but in a type needs to be pointer
+    real(pREAL), pointer,     dimension(:,:), contiguous :: &                                       !< is basically an allocatable+target, but in a type needs to be pointer
       state0, &
       state
   end type
@@ -51,12 +51,12 @@ module homogenization
 
 !--------------------------------------------------------------------------------------------------
 ! General variables for the homogenization at a  material point
-  real(pReal),   dimension(:,:,:),     allocatable, public :: &
+  real(pREAL),   dimension(:,:,:),     allocatable, public :: &
     homogenization_F0, &                                                                            !< def grad of IP at start of FE increment
     homogenization_F                                                                                !< def grad of IP to be reached at end of FE increment
-  real(pReal),   dimension(:,:,:),     allocatable, public :: & !, protected :: &                   Issue with ifort
+  real(pREAL),   dimension(:,:,:),     allocatable, public :: & !, protected :: &                   Issue with ifort
     homogenization_P                                                                                !< first P--K stress of IP
-  real(pReal),   dimension(:,:,:,:,:), allocatable, public :: & !, protected ::  &
+  real(pREAL),   dimension(:,:,:,:,:), allocatable, public :: & !, protected ::  &
     homogenization_dPdF                                                                             !< tangent of first P--K stress at IP
 
 
@@ -81,7 +81,7 @@ module homogenization
     end subroutine damage_init
 
     module subroutine mechanical_partition(subF,ce)
-      real(pReal), intent(in), dimension(3,3) :: &
+      real(pREAL), intent(in), dimension(3,3) :: &
         subF
       integer,     intent(in) :: &
         ce
@@ -96,7 +96,7 @@ module homogenization
     end subroutine damage_partition
 
     module subroutine mechanical_homogenize(Delta_t,ce)
-     real(pReal), intent(in) :: Delta_t
+     real(pREAL), intent(in) :: Delta_t
      integer, intent(in) :: &
        ce                                                                                           !< cell
     end subroutine mechanical_homogenize
@@ -117,9 +117,9 @@ module homogenization
     end subroutine thermal_result
 
     module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy)
-      real(pReal), intent(in) :: &
+      real(pREAL), intent(in) :: &
         subdt                                                                                       !< current time step
-      real(pReal), intent(in), dimension(3,3) :: &
+      real(pREAL), intent(in), dimension(3,3) :: &
         subF
       integer,     intent(in) :: &
         ce                                                                                          !< cell
@@ -132,22 +132,22 @@ module homogenization
 
     module function homogenization_mu_T(ce) result(mu)
       integer, intent(in) :: ce
-      real(pReal) :: mu
+      real(pREAL) :: mu
     end function homogenization_mu_T
 
     module function homogenization_K_T(ce) result(K)
       integer, intent(in) :: ce
-      real(pReal), dimension(3,3) :: K
+      real(pREAL), dimension(3,3) :: K
     end function homogenization_K_T
 
     module function homogenization_f_T(ce) result(f)
       integer, intent(in) :: ce
-      real(pReal) :: f
+      real(pREAL) :: f
     end function homogenization_f_T
 
     module subroutine homogenization_thermal_setField(T,dot_T, ce)
       integer, intent(in) :: ce
-      real(pReal),   intent(in) :: T, dot_T
+      real(pREAL),   intent(in) :: T, dot_T
     end subroutine homogenization_thermal_setField
 
     module function homogenization_damage_active() result(active)
@@ -156,23 +156,23 @@ module homogenization
 
     module function homogenization_mu_phi(ce) result(mu)
       integer, intent(in) :: ce
-      real(pReal) :: mu
+      real(pREAL) :: mu
     end function homogenization_mu_phi
 
     module function homogenization_K_phi(ce) result(K)
       integer, intent(in) :: ce
-      real(pReal), dimension(3,3) :: K
+      real(pREAL), dimension(3,3) :: K
     end function homogenization_K_phi
 
     module function homogenization_f_phi(phi,ce) result(f)
       integer, intent(in) :: ce
-      real(pReal), intent(in) :: phi
-      real(pReal) :: f
+      real(pREAL), intent(in) :: phi
+      real(pREAL) :: f
     end function homogenization_f_phi
 
     module subroutine homogenization_set_phi(phi,ce)
       integer, intent(in) :: ce
-      real(pReal),   intent(in) :: &
+      real(pREAL),   intent(in) :: &
         phi
     end subroutine homogenization_set_phi
 
@@ -235,7 +235,7 @@ end subroutine homogenization_init
 !--------------------------------------------------------------------------------------------------
 subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
 
-  real(pReal), intent(in) :: Delta_t                                                                !< time increment
+  real(pREAL), intent(in) :: Delta_t                                                                !< time increment
   integer, intent(in) :: &
     cell_start, cell_end
   integer :: &
@@ -293,7 +293,7 @@ end subroutine homogenization_mechanical_response
 !--------------------------------------------------------------------------------------------------
 subroutine homogenization_thermal_response(Delta_t,cell_start,cell_end)
 
-  real(pReal), intent(in) :: Delta_t                                                                !< time increment
+  real(pREAL), intent(in) :: Delta_t                                                                !< time increment
   integer, intent(in) :: &
     cell_start, cell_end
   integer :: &
@@ -321,7 +321,7 @@ end subroutine homogenization_thermal_response
 !--------------------------------------------------------------------------------------------------
 subroutine homogenization_mechanical_response2(Delta_t,FEsolving_execIP,FEsolving_execElem)
 
-  real(pReal), intent(in) :: Delta_t                                                                !< time increment
+  real(pREAL), intent(in) :: Delta_t                                                                !< time increment
   integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP
   integer :: &
     ip, &                                                                                           !< integration point number

src/homogenization_damage.f90

@@ -11,7 +11,7 @@ submodule(homogenization) damage
   end interface
 
   type :: tDataContainer
-    real(pReal), dimension(:), allocatable :: phi
+    real(pREAL), dimension(:), allocatable :: phi
   end type tDataContainer
 
   type(tDataContainer), dimension(:), allocatable :: current
@@ -48,7 +48,7 @@ module subroutine damage_init()
 
   do ho = 1, configHomogenizations%length
     Nmembers = count(material_ID_homogenization == ho)
-    allocate(current(ho)%phi(Nmembers), source=1.0_pReal)
+    allocate(current(ho)%phi(Nmembers), source=1.0_pREAL)
     configHomogenization => configHomogenizations%get_dict(ho)
     associate(prm => param(ho))
       if (configHomogenization%contains('damage')) then
@@ -59,8 +59,8 @@ module subroutine damage_init()
         prm%output = configHomogenizationDamage%get_as1dStr('output',defaultVal=emptyStrArray)
 #endif
         damageState_h(ho)%sizeState = 1
-        allocate(damageState_h(ho)%state0(1,Nmembers), source=1.0_pReal)
-        allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pReal)
+        allocate(damageState_h(ho)%state0(1,Nmembers), source=1.0_pREAL)
+        allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pREAL)
       else
         prm%output = emptyStrArray
       end if
@@ -91,7 +91,7 @@ module subroutine damage_partition(ce)
 
   integer, intent(in) :: ce
 
-  real(pReal) :: phi
+  real(pREAL) :: phi
   integer :: co
 
 
@@ -111,7 +111,7 @@ end subroutine damage_partition
 module function homogenization_mu_phi(ce) result(mu)
 
   integer, intent(in) :: ce
-  real(pReal) :: mu
+  real(pREAL) :: mu
 
 
   mu = phase_mu_phi(1,ce)
@@ -125,7 +125,7 @@ end function homogenization_mu_phi
 module function homogenization_K_phi(ce) result(K)
 
   integer, intent(in) :: ce
-  real(pReal), dimension(3,3) :: K
+  real(pREAL), dimension(3,3) :: K
 
 
   K = phase_K_phi(1,ce)
@@ -139,8 +139,8 @@ end function homogenization_K_phi
 module function homogenization_f_phi(phi,ce) result(f)
 
   integer, intent(in) :: ce
-  real(pReal), intent(in) :: phi
-  real(pReal) :: f
+  real(pREAL), intent(in) :: phi
+  real(pREAL) :: f
 
 
   f = phase_f_phi(phi, 1, ce)
@@ -154,7 +154,7 @@ end function homogenization_f_phi
 module subroutine homogenization_set_phi(phi,ce)
 
   integer, intent(in) :: ce
-  real(pReal), intent(in) :: phi
+  real(pREAL), intent(in) :: phi
 
   integer :: &
     ho, &

src/homogenization_mechanical.f90

@@ -18,13 +18,13 @@ submodule(homogenization) mechanical
 
 
     module subroutine isostrain_partitionDeformation(F,avgF)
-      real(pReal),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
-      real(pReal),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
+      real(pREAL),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
+      real(pREAL),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
     end subroutine isostrain_partitionDeformation
 
     module subroutine RGC_partitionDeformation(F,avgF,ce)
-      real(pReal),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
-      real(pReal),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
+      real(pREAL),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
+      real(pREAL),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
       integer,                          intent(in)  :: &
         ce
     end subroutine RGC_partitionDeformation
@@ -32,12 +32,12 @@ submodule(homogenization) mechanical
 
     module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
       logical, dimension(2) :: doneAndHappy
-      real(pReal), dimension(:,:,:),     intent(in)    :: &
+      real(pREAL), dimension(:,:,:),     intent(in)    :: &
         P,&                                                                                         !< partitioned stresses
         F                                                                                           !< partitioned deformation gradients
-      real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF                                         !< partitioned stiffnesses
-      real(pReal), dimension(3,3),       intent(in) :: avgF                                         !< average F
-      real(pReal),                       intent(in) :: dt                                           !< time increment
+      real(pREAL), dimension(:,:,:,:,:), intent(in) :: dPdF                                         !< partitioned stiffnesses
+      real(pREAL), dimension(3,3),       intent(in) :: avgF                                         !< average F
+      real(pREAL),                       intent(in) :: dt                                           !< time increment
       integer,                           intent(in) :: &
         ce                                                                                          !< cell
     end function RGC_updateState
@@ -76,10 +76,10 @@ module subroutine mechanical_init()
 
   call parseMechanical()
 
-  allocate(homogenization_dPdF(3,3,3,3,discretization_Ncells), source=0.0_pReal)
+  allocate(homogenization_dPdF(3,3,3,3,discretization_Ncells), source=0.0_pREAL)
   homogenization_F0 = spread(math_I3,3,discretization_Ncells)
   homogenization_F = homogenization_F0
-  allocate(homogenization_P(3,3,discretization_Ncells),source=0.0_pReal)
+  allocate(homogenization_P(3,3,discretization_Ncells),source=0.0_pREAL)
 
   if (any(mechanical_type == MECHANICAL_PASS_ID))      call pass_init()
   if (any(mechanical_type == MECHANICAL_ISOSTRAIN_ID)) call isostrain_init()
@@ -93,13 +93,13 @@ end subroutine mechanical_init
 !--------------------------------------------------------------------------------------------------
 module subroutine mechanical_partition(subF,ce)
 
-  real(pReal), intent(in), dimension(3,3) :: &
+  real(pREAL), intent(in), dimension(3,3) :: &
     subF
   integer,     intent(in) :: &
     ce
 
   integer :: co
-  real(pReal), dimension (3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) :: Fs
+  real(pREAL), dimension (3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) :: Fs
 
 
   chosenHomogenization: select case(mechanical_type(material_ID_homogenization(ce)))
@@ -128,7 +128,7 @@ end subroutine mechanical_partition
 !--------------------------------------------------------------------------------------------------
 module subroutine mechanical_homogenize(Delta_t,ce)
 
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: ce
 
   integer :: co
@@ -152,18 +152,18 @@ end subroutine mechanical_homogenize
 !--------------------------------------------------------------------------------------------------
 module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy)
 
-  real(pReal), intent(in) :: &
+  real(pREAL), intent(in) :: &
     subdt                                                                                           !< current time step
-  real(pReal), intent(in), dimension(3,3) :: &
+  real(pREAL), intent(in), dimension(3,3) :: &
     subF
   integer,     intent(in) :: &
     ce
   logical, dimension(2) :: doneAndHappy
 
   integer :: co
-  real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
-  real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
-  real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
+  real(pREAL) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
+  real(pREAL) :: Fs(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
+  real(pREAL) :: Ps(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
 
 
   if (mechanical_type(material_ID_homogenization(ce)) == MECHANICAL_RGC_ID) then

src/homogenization_mechanical_RGC.f90

@@ -13,10 +13,10 @@ submodule(homogenization:mechanical) RGC
   type :: tParameters
     integer, dimension(:), allocatable :: &
       N_constituents
-    real(pReal) :: &
+    real(pREAL) :: &
       xi_alpha, &
       c_Alpha
-    real(pReal), dimension(:), allocatable :: &
+    real(pREAL), dimension(:), allocatable :: &
       D_alpha, &
       a_g
     character(len=pSTRLEN), allocatable, dimension(:) :: &
@@ -24,23 +24,23 @@ submodule(homogenization:mechanical) RGC
   end type tParameters
 
   type :: tRGCstate
-    real(pReal), pointer,     dimension(:,:) :: &
+    real(pREAL), pointer,     dimension(:,:) :: &
       relaxationVector
   end type tRGCstate
 
   type :: tRGCdependentState
-    real(pReal), allocatable,     dimension(:) :: &
+    real(pREAL), allocatable,     dimension(:) :: &
       volumeDiscrepancy, &
       relaxationRate_avg, &
       relaxationRate_max
-    real(pReal), allocatable,     dimension(:,:) :: &
+    real(pREAL), allocatable,     dimension(:,:) :: &
       mismatch
-    real(pReal), allocatable,     dimension(:,:,:) :: &
+    real(pREAL), allocatable,     dimension(:,:,:) :: &
       orientation
   end type tRGCdependentState
 
   type :: tNumerics_RGC
-    real(pReal) :: &
+    real(pREAL) :: &
       atol, &                                                                                       !< absolute tolerance of RGC residuum
       rtol, &                                                                                       !< relative tolerance of RGC residuum
       absMax, &                                                                                     !< absolute maximum of RGC residuum
@@ -108,33 +108,33 @@ module subroutine RGC_init()
   num_mechanical => num_homogenization%get_dict('mechanical',defaultVal=emptyDict)
   num_RGC => num_mechanical%get_dict('RGC',defaultVal=emptyDict)
 
-  num%atol         =  num_RGC%get_asReal('atol',              defaultVal=1.0e+4_pReal)
-  num%rtol         =  num_RGC%get_asReal('rtol',              defaultVal=1.0e-3_pReal)
-  num%absMax       =  num_RGC%get_asReal('amax',              defaultVal=1.0e+10_pReal)
-  num%relMax       =  num_RGC%get_asReal('rmax',              defaultVal=1.0e+2_pReal)
-  num%pPert        =  num_RGC%get_asReal('perturbpenalty',    defaultVal=1.0e-7_pReal)
-  num%xSmoo        =  num_RGC%get_asReal('relvantmismatch',   defaultVal=1.0e-5_pReal)
-  num%viscPower    =  num_RGC%get_asReal('viscositypower',    defaultVal=1.0e+0_pReal)
-  num%viscModus    =  num_RGC%get_asReal('viscositymodulus',  defaultVal=0.0e+0_pReal)
-  num%refRelaxRate =  num_RGC%get_asReal('refrelaxationrate', defaultVal=1.0e-3_pReal)
-  num%maxdRelax    =  num_RGC%get_asReal('maxrelaxationrate', defaultVal=1.0e+0_pReal)
-  num%maxVolDiscr  =  num_RGC%get_asReal('maxvoldiscrepancy', defaultVal=1.0e-5_pReal)
-  num%volDiscrMod  =  num_RGC%get_asReal('voldiscrepancymod', defaultVal=1.0e+12_pReal)
-  num%volDiscrPow  =  num_RGC%get_asReal('dicrepancypower',   defaultVal=5.0_pReal)
+  num%atol         =  num_RGC%get_asReal('atol',              defaultVal=1.0e+4_pREAL)
+  num%rtol         =  num_RGC%get_asReal('rtol',              defaultVal=1.0e-3_pREAL)
+  num%absMax       =  num_RGC%get_asReal('amax',              defaultVal=1.0e+10_pREAL)
+  num%relMax       =  num_RGC%get_asReal('rmax',              defaultVal=1.0e+2_pREAL)
+  num%pPert        =  num_RGC%get_asReal('perturbpenalty',    defaultVal=1.0e-7_pREAL)
+  num%xSmoo        =  num_RGC%get_asReal('relvantmismatch',   defaultVal=1.0e-5_pREAL)
+  num%viscPower    =  num_RGC%get_asReal('viscositypower',    defaultVal=1.0e+0_pREAL)
+  num%viscModus    =  num_RGC%get_asReal('viscositymodulus',  defaultVal=0.0e+0_pREAL)
+  num%refRelaxRate =  num_RGC%get_asReal('refrelaxationrate', defaultVal=1.0e-3_pREAL)
+  num%maxdRelax    =  num_RGC%get_asReal('maxrelaxationrate', defaultVal=1.0e+0_pREAL)
+  num%maxVolDiscr  =  num_RGC%get_asReal('maxvoldiscrepancy', defaultVal=1.0e-5_pREAL)
+  num%volDiscrMod  =  num_RGC%get_asReal('voldiscrepancymod', defaultVal=1.0e+12_pREAL)
+  num%volDiscrPow  =  num_RGC%get_asReal('dicrepancypower',   defaultVal=5.0_pREAL)
 
-  if (num%atol <= 0.0_pReal)         call IO_error(301,ext_msg='absTol_RGC')
-  if (num%rtol <= 0.0_pReal)         call IO_error(301,ext_msg='relTol_RGC')
-  if (num%absMax <= 0.0_pReal)       call IO_error(301,ext_msg='absMax_RGC')
-  if (num%relMax <= 0.0_pReal)       call IO_error(301,ext_msg='relMax_RGC')
-  if (num%pPert <= 0.0_pReal)        call IO_error(301,ext_msg='pPert_RGC')
-  if (num%xSmoo <= 0.0_pReal)        call IO_error(301,ext_msg='xSmoo_RGC')
-  if (num%viscPower < 0.0_pReal)     call IO_error(301,ext_msg='viscPower_RGC')
-  if (num%viscModus < 0.0_pReal)     call IO_error(301,ext_msg='viscModus_RGC')
-  if (num%refRelaxRate <= 0.0_pReal) call IO_error(301,ext_msg='refRelaxRate_RGC')
-  if (num%maxdRelax <= 0.0_pReal)    call IO_error(301,ext_msg='maxdRelax_RGC')
-  if (num%maxVolDiscr <= 0.0_pReal)  call IO_error(301,ext_msg='maxVolDiscr_RGC')
-  if (num%volDiscrMod < 0.0_pReal)   call IO_error(301,ext_msg='volDiscrMod_RGC')
-  if (num%volDiscrPow <= 0.0_pReal)  call IO_error(301,ext_msg='volDiscrPw_RGC')
+  if (num%atol <= 0.0_pREAL)         call IO_error(301,ext_msg='absTol_RGC')
+  if (num%rtol <= 0.0_pREAL)         call IO_error(301,ext_msg='relTol_RGC')
+  if (num%absMax <= 0.0_pREAL)       call IO_error(301,ext_msg='absMax_RGC')
+  if (num%relMax <= 0.0_pREAL)       call IO_error(301,ext_msg='relMax_RGC')
+  if (num%pPert <= 0.0_pREAL)        call IO_error(301,ext_msg='pPert_RGC')
+  if (num%xSmoo <= 0.0_pREAL)        call IO_error(301,ext_msg='xSmoo_RGC')
+  if (num%viscPower < 0.0_pREAL)     call IO_error(301,ext_msg='viscPower_RGC')
+  if (num%viscModus < 0.0_pREAL)     call IO_error(301,ext_msg='viscModus_RGC')
+  if (num%refRelaxRate <= 0.0_pREAL) call IO_error(301,ext_msg='refRelaxRate_RGC')
+  if (num%maxdRelax <= 0.0_pREAL)    call IO_error(301,ext_msg='maxdRelax_RGC')
+  if (num%maxVolDiscr <= 0.0_pREAL)  call IO_error(301,ext_msg='maxVolDiscr_RGC')
+  if (num%volDiscrMod < 0.0_pREAL)   call IO_error(301,ext_msg='volDiscrMod_RGC')
+  if (num%volDiscrPow <= 0.0_pREAL)  call IO_error(301,ext_msg='volDiscrPw_RGC')
 
 
   do ho = 1, size(mechanical_type)
@@ -169,16 +169,16 @@ module subroutine RGC_init()
     sizeState = nIntFaceTot
 
     homogState(ho)%sizeState = sizeState
-    allocate(homogState(ho)%state0   (sizeState,Nmembers), source=0.0_pReal)
-    allocate(homogState(ho)%state    (sizeState,Nmembers), source=0.0_pReal)
+    allocate(homogState(ho)%state0   (sizeState,Nmembers), source=0.0_pREAL)
+    allocate(homogState(ho)%state    (sizeState,Nmembers), source=0.0_pREAL)
 
     stt%relaxationVector => homogState(ho)%state(1:nIntFaceTot,:)
     st0%relaxationVector => homogState(ho)%state0(1:nIntFaceTot,:)
 
-    allocate(dst%volumeDiscrepancy(   Nmembers), source=0.0_pReal)
-    allocate(dst%relaxationRate_avg(  Nmembers), source=0.0_pReal)
-    allocate(dst%relaxationRate_max(  Nmembers), source=0.0_pReal)
-    allocate(dst%mismatch(          3,Nmembers), source=0.0_pReal)
+    allocate(dst%volumeDiscrepancy(   Nmembers), source=0.0_pREAL)
+    allocate(dst%relaxationRate_avg(  Nmembers), source=0.0_pREAL)
+    allocate(dst%relaxationRate_max(  Nmembers), source=0.0_pREAL)
+    allocate(dst%mismatch(          3,Nmembers), source=0.0_pREAL)
 
 !--------------------------------------------------------------------------------------------------
 ! assigning cluster orientations
@@ -197,13 +197,13 @@ end subroutine RGC_init
 !--------------------------------------------------------------------------------------------------
 module subroutine RGC_partitionDeformation(F,avgF,ce)
 
-  real(pReal),   dimension (:,:,:), intent(out) :: F                                                !< partitioned F  per grain
+  real(pREAL),   dimension (:,:,:), intent(out) :: F                                                !< partitioned F  per grain
 
-  real(pReal),   dimension (3,3),   intent(in)  :: avgF                                             !< averaged F
+  real(pREAL),   dimension (3,3),   intent(in)  :: avgF                                             !< averaged F
   integer,                          intent(in)  :: &
     ce
 
-  real(pReal), dimension(3) :: aVect,nVect
+  real(pREAL), dimension(3) :: aVect,nVect
   integer,     dimension(4) :: intFace
   integer,     dimension(3) :: iGrain3
   integer ::  iGrain,iFace,i,j,ho,en
@@ -214,7 +214,7 @@ module subroutine RGC_partitionDeformation(F,avgF,ce)
   en = material_entry_homogenization(ce)
 !--------------------------------------------------------------------------------------------------
 ! compute the deformation gradient of individual grains due to relaxations
-  F = 0.0_pReal
+  F = 0.0_pREAL
   do iGrain = 1,product(prm%N_constituents)
     iGrain3 = grain1to3(iGrain,prm%N_constituents)
     do iFace = 1,6
@@ -238,25 +238,25 @@ end subroutine RGC_partitionDeformation
 !--------------------------------------------------------------------------------------------------
 module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
       logical, dimension(2) :: doneAndHappy
-      real(pReal), dimension(:,:,:),     intent(in)    :: &
+      real(pREAL), dimension(:,:,:),     intent(in)    :: &
         P,&                                                                                         !< partitioned stresses
         F                                                                                           !< partitioned deformation gradients
-      real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF                                         !< partitioned stiffnesses
-      real(pReal), dimension(3,3),       intent(in) :: avgF                                         !< average F
-      real(pReal),                       intent(in) :: dt                                           !< time increment
+      real(pREAL), dimension(:,:,:,:,:), intent(in) :: dPdF                                         !< partitioned stiffnesses
+      real(pREAL), dimension(3,3),       intent(in) :: avgF                                         !< average F
+      real(pREAL),                       intent(in) :: dt                                           !< time increment
       integer,                           intent(in) :: &
         ce                                                                                          !< cell
 
   integer, dimension(4) :: intFaceN,intFaceP,faceID
   integer, dimension(3) :: nGDim,iGr3N,iGr3P
   integer :: ho,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,nGrain, en
-  real(pReal), dimension(3,3,size(P,3)) :: R,pF,pR,D,pD
-  real(pReal), dimension(3,size(P,3))   :: NN,devNull
-  real(pReal), dimension(3)             :: normP,normN,mornP,mornN
-  real(pReal) :: residMax,stresMax
+  real(pREAL), dimension(3,3,size(P,3)) :: R,pF,pR,D,pD
+  real(pREAL), dimension(3,size(P,3))   :: NN,devNull
+  real(pREAL), dimension(3)             :: normP,normN,mornP,mornN
+  real(pREAL) :: residMax,stresMax
   logical :: error
-  real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
-  real(pReal), dimension(:), allocatable   :: resid,relax,p_relax,p_resid,drelax
+  real(pREAL), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
+  real(pREAL), dimension(:), allocatable   :: resid,relax,p_relax,p_resid,drelax
 
   zeroTimeStep: if (dEq0(dt)) then
     doneAndHappy = .true.                                                                   ! pretend everything is fine and return
@@ -278,8 +278,8 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
 
 !--------------------------------------------------------------------------------------------------
 ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster
-  allocate(resid(3*nIntFaceTot), source=0.0_pReal)
-  allocate(tract(nIntFaceTot,3), source=0.0_pReal)
+  allocate(resid(3*nIntFaceTot), source=0.0_pREAL)
+  allocate(tract(nIntFaceTot,3), source=0.0_pREAL)
   relax  = stt%relaxationVector(:,en)
   drelax = stt%relaxationVector(:,en) - st0%relaxationVector(:,en)
 
@@ -337,8 +337,8 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
     doneAndHappy = .true.
 
-    dst%mismatch(1:3,en)       = sum(NN,2)/real(nGrain,pReal)
-    dst%relaxationRate_avg(en) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal)
+    dst%mismatch(1:3,en)       = sum(NN,2)/real(nGrain,pREAL)
+    dst%relaxationRate_avg(en) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pREAL)
     dst%relaxationRate_max(en) = maxval(abs(drelax))/dt
 
     return
@@ -356,7 +356,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
 
 !--------------------------------------------------------------------------------------------------
 ! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix"
-  allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal)
+  allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pREAL)
   do iNum = 1,nIntFaceTot
     faceID = interface1to4(iNum,param(ho)%N_constituents)                                           ! assembling of local dPdF into global Jacobian matrix
 
@@ -403,9 +403,9 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
 !--------------------------------------------------------------------------------------------------
 ! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical
 ! perturbation method) "pmatrix"
-  allocate(pmatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal)
-  allocate(p_relax(3*nIntFaceTot),               source=0.0_pReal)
-  allocate(p_resid(3*nIntFaceTot),               source=0.0_pReal)
+  allocate(pmatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pREAL)
+  allocate(p_relax(3*nIntFaceTot),               source=0.0_pREAL)
+  allocate(p_resid(3*nIntFaceTot),               source=0.0_pREAL)
 
   do ipert = 1,3*nIntFaceTot
     p_relax = relax
@@ -417,7 +417,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
 
 !--------------------------------------------------------------------------------------------------
 ! computing the global stress residual array from the perturbed state
-    p_resid = 0.0_pReal
+    p_resid = 0.0_pREAL
     do iNum = 1,nIntFaceTot
       faceID = interface1to4(iNum,param(ho)%N_constituents)                                         ! identifying the interface ID in local coordinate system (4-dimensional index)
 
@@ -452,10 +452,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
 
 !--------------------------------------------------------------------------------------------------
 ! ... of the numerical viscosity traction "rmatrix"
-  allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
+  allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pREAL)
   do i=1,3*nIntFaceTot
     rmatrix(i,i) = num%viscModus*num%viscPower/(num%refRelaxRate*dt)* &                             ! tangent due to numerical viscosity traction appears
-                   (abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pReal)              ! only in the main diagonal term
+                   (abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pREAL)              ! only in the main diagonal term
   end do
 
 
@@ -465,12 +465,12 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
 
 !--------------------------------------------------------------------------------------------------
 ! computing the update of the state variable (relaxation vectors) using the Jacobian matrix
-  allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
+  allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pREAL)
   call math_invert(jnverse,error,jmatrix)
 
 !--------------------------------------------------------------------------------------------------
 ! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration
-  drelax = 0.0_pReal
+  drelax = 0.0_pREAL
   do i = 1,3*nIntFaceTot;do j = 1,3*nIntFaceTot
     drelax(i) = drelax(i) - jnverse(i,j)*resid(j)                                                   ! Calculate the correction for the state variable
   end do; end do
@@ -492,26 +492,26 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   !------------------------------------------------------------------------------------------------
   subroutine stressPenalty(rPen,nMis,avgF,fDef,ho,en)
 
-    real(pReal),   dimension (:,:,:), intent(out) :: rPen                                           !< stress-like penalty
-    real(pReal),   dimension (:,:),   intent(out) :: nMis                                           !< total amount of mismatch
+    real(pREAL),   dimension (:,:,:), intent(out) :: rPen                                           !< stress-like penalty
+    real(pREAL),   dimension (:,:),   intent(out) :: nMis                                           !< total amount of mismatch
 
-    real(pReal),   dimension (:,:,:), intent(in)  :: fDef                                           !< deformation gradients
-    real(pReal),   dimension (3,3),   intent(in)  :: avgF                                           !< initial effective stretch tensor
+    real(pREAL),   dimension (:,:,:), intent(in)  :: fDef                                           !< deformation gradients
+    real(pREAL),   dimension (3,3),   intent(in)  :: avgF                                           !< initial effective stretch tensor
     integer,                          intent(in)  :: ho, en
 
     integer, dimension (4)   :: intFace
     integer, dimension (3)   :: iGrain3,iGNghb3,nGDim
-    real(pReal),   dimension (3,3) :: gDef,nDef
-    real(pReal),   dimension (3)   :: nVect,surfCorr
+    real(pREAL),   dimension (3,3) :: gDef,nDef
+    real(pREAL),   dimension (3)   :: nVect,surfCorr
     integer :: iGrain,iGNghb,iFace,i,j,k,l
-    real(pReal) :: muGrain,muGNghb,nDefNorm
-    real(pReal), parameter  :: &
-      nDefToler = 1.0e-10_pReal, &
-      b = 2.5e-10_pReal                                                                             ! Length of Burgers vector
+    real(pREAL) :: muGrain,muGNghb,nDefNorm
+    real(pREAL), parameter  :: &
+      nDefToler = 1.0e-10_pREAL, &
+      b = 2.5e-10_pREAL                                                                             ! Length of Burgers vector
 
     nGDim = param(ho)%N_constituents
-    rPen = 0.0_pReal
-    nMis = 0.0_pReal
+    rPen = 0.0_pREAL
+    nMis = 0.0_pREAL
 
     !----------------------------------------------------------------------------------------------
     ! get the correction factor the modulus of penalty stress representing the evolution of area of
@@ -532,17 +532,17 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
        nVect = interfaceNormal(intFace,ho,en)
        iGNghb3 = iGrain3                                                                            ! identify the neighboring grain across the interface
        iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) &
-                                + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal))
+                                + int(real(intFace(1),pREAL)/real(abs(intFace(1)),pREAL))
        where(iGNghb3 < 1)    iGNghb3 = nGDim
        where(iGNghb3 >nGDim) iGNghb3 = 1
        iGNghb  = grain3to1(iGNghb3,prm%N_constituents)                                              ! get the ID of the neighboring grain
        muGNghb = equivalentMu(iGNghb,ce)
-       gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain))                               ! difference/jump in deformation gradeint across the neighbor
+       gDef = 0.5_pREAL*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain))                               ! difference/jump in deformation gradeint across the neighbor
 
        !-------------------------------------------------------------------------------------------
        ! compute the mismatch tensor of all interfaces
-       nDefNorm = 0.0_pReal
-       nDef = 0.0_pReal
+       nDefNorm = 0.0_pREAL
+       nDef = 0.0_pREAL
        do i = 1,3; do j = 1,3
          do k = 1,3; do l = 1,3
            nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_LeviCivita(j,k,l)                        ! compute the interface mismatch tensor from the jump of deformation gradient
@@ -556,10 +556,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
        !-------------------------------------------------------------------------------------------
        ! compute the stress penalty of all interfaces
        do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3
-         rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*b + muGNghb*b)*prm%xi_alpha &
+         rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pREAL*(muGrain*b + muGNghb*b)*prm%xi_alpha &
                                                 *surfCorr(abs(intFace(1)))/prm%D_alpha(abs(intFace(1))) &
                                                 *cosh(prm%c_alpha*nDefNorm) &
-                                                *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) &
+                                                *0.5_pREAL*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) &
                                                 *tanh(nDefNorm/num%xSmoo)
        end do; end do;end do; end do
      end do interfaceLoop
@@ -577,15 +577,15 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   !------------------------------------------------------------------------------------------------
   subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain)
 
-    real(pReal), dimension (:,:,:), intent(out) :: vPen                                             ! stress-like penalty due to volume
-    real(pReal),                    intent(out) :: vDiscrep                                         ! total volume discrepancy
+    real(pREAL), dimension (:,:,:), intent(out) :: vPen                                             ! stress-like penalty due to volume
+    real(pREAL),                    intent(out) :: vDiscrep                                         ! total volume discrepancy
 
-    real(pReal), dimension (:,:,:), intent(in)  :: fDef                                             ! deformation gradients
-    real(pReal), dimension (3,3),   intent(in)  :: fAvg                                             ! overall deformation gradient
+    real(pREAL), dimension (:,:,:), intent(in)  :: fDef                                             ! deformation gradients
+    real(pREAL), dimension (3,3),   intent(in)  :: fAvg                                             ! overall deformation gradient
     integer,                        intent(in) :: &
       Ngrain
 
-    real(pReal), dimension(size(vPen,3)) :: gVol
+    real(pREAL), dimension(size(vPen,3)) :: gVol
     integer :: i
 
     !----------------------------------------------------------------------------------------------
@@ -593,16 +593,16 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
     vDiscrep = math_det33(fAvg)                                                                     ! compute the volume of the cluster
     do i = 1,nGrain
       gVol(i) = math_det33(fDef(1:3,1:3,i))                                                         ! compute the volume of individual grains
-      vDiscrep     = vDiscrep - gVol(i)/real(nGrain,pReal)                                          ! calculate the difference/dicrepancy between
+      vDiscrep     = vDiscrep - gVol(i)/real(nGrain,pREAL)                                          ! calculate the difference/dicrepancy between
                                                                                                     ! the volume of the cluster and the the total volume of grains
     end do
 
     !----------------------------------------------------------------------------------------------
     ! calculate the stress and penalty due to volume discrepancy
-    vPen      = 0.0_pReal
+    vPen      = 0.0_pREAL
     do i = 1,nGrain
-      vPen(:,:,i) = -real(nGrain,pReal)**(-1)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr &
-                  * sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0_pReal),vDiscrep) &
+      vPen(:,:,i) = -real(nGrain,pREAL)**(-1)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr &
+                  * sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0_pREAL),vDiscrep) &
                   * gVol(i)*transpose(math_inv33(fDef(:,:,i)))
     end do
 
@@ -615,21 +615,21 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   !--------------------------------------------------------------------------------------------------
   function surfaceCorrection(avgF,ho,en)
 
-    real(pReal), dimension(3)               :: surfaceCorrection
+    real(pREAL), dimension(3)               :: surfaceCorrection
 
-    real(pReal), dimension(3,3), intent(in) :: avgF                                                 !< average F
+    real(pREAL), dimension(3,3), intent(in) :: avgF                                                 !< average F
     integer,                     intent(in) :: &
       ho, &
       en
-    real(pReal), dimension(3,3)             :: invC
-    real(pReal), dimension(3)               :: nVect
-    real(pReal)  :: detF
+    real(pREAL), dimension(3,3)             :: invC
+    real(pREAL), dimension(3)               :: nVect
+    real(pREAL)  :: detF
     integer :: i,j,iBase
     logical     ::  error
 
     call math_invert33(invC,detF,error,matmul(transpose(avgF),avgF))
 
-    surfaceCorrection = 0.0_pReal
+    surfaceCorrection = 0.0_pREAL
     do iBase = 1,3
       nVect = interfaceNormal([iBase,1,1,1],ho,en)
       do i = 1,3; do j = 1,3
@@ -644,13 +644,13 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   !-------------------------------------------------------------------------------------------------
   !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor
   !-------------------------------------------------------------------------------------------------
-  real(pReal) function equivalentMu(co,ce)
+  real(pREAL) function equivalentMu(co,ce)
 
     integer, intent(in)    :: &
       co,&
       ce
 
-    real(pReal), dimension(6,6) :: C
+    real(pREAL), dimension(6,6) :: C
 
     C = phase_homogenizedC66(material_ID_phase(co,ce),material_entry_phase(co,ce))                  ! damage not included!
 
@@ -665,14 +665,14 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   !-------------------------------------------------------------------------------------------------
   subroutine grainDeformation(F, avgF, ho, en)
 
-    real(pReal),   dimension(:,:,:), intent(out) :: F                                               !< partitioned F  per grain
+    real(pREAL),   dimension(:,:,:), intent(out) :: F                                               !< partitioned F  per grain
 
-    real(pReal),   dimension(:,:),   intent(in)  :: avgF                                            !< averaged F
+    real(pREAL),   dimension(:,:),   intent(in)  :: avgF                                            !< averaged F
     integer,                         intent(in)  :: &
       ho, &
       en
 
-    real(pReal),   dimension(3) :: aVect,nVect
+    real(pREAL),   dimension(3) :: aVect,nVect
     integer,       dimension(4) :: intFace
     integer,       dimension(3) :: iGrain3
     integer :: iGrain,iFace,i,j
@@ -682,7 +682,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
 
     associate (prm => param(ho))
 
-    F = 0.0_pReal
+    F = 0.0_pREAL
     do iGrain = 1,product(prm%N_constituents)
       iGrain3 = grain1to3(iGrain,prm%N_constituents)
       do iFace = 1,6
@@ -739,7 +739,7 @@ end subroutine RGC_result
 !--------------------------------------------------------------------------------------------------
 pure function relaxationVector(intFace,ho,en)
 
-  real(pReal), dimension (3)            :: relaxationVector
+  real(pREAL), dimension (3)            :: relaxationVector
 
   integer,                   intent(in) :: ho,en
   integer,     dimension(4), intent(in) :: intFace                                                  !< set of interface ID in 4D array (normal and position)
@@ -756,7 +756,7 @@ pure function relaxationVector(intFace,ho,en)
   if (iNum > 0) then
     relaxationVector = stt%relaxationVector((3*iNum-2):(3*iNum),en)
   else
-    relaxationVector = 0.0_pReal
+    relaxationVector = 0.0_pREAL
   end if
 
   end associate
@@ -769,7 +769,7 @@ end function relaxationVector
 !--------------------------------------------------------------------------------------------------
 pure function interfaceNormal(intFace,ho,en) result(n)
 
-  real(pReal), dimension(3)             :: n
+  real(pREAL), dimension(3)             :: n
   integer,     dimension(4), intent(in) :: intFace                                                  !< interface ID in 4D array (normal and position)
   integer,                   intent(in) :: &
     ho, &
@@ -778,8 +778,8 @@ pure function interfaceNormal(intFace,ho,en) result(n)
 
   associate (dst => dependentState(ho))
 
-    n = 0.0_pReal
-    n(abs(intFace(1))) = real(intFace(1)/abs(intFace(1)),pReal)                                     ! get the normal vector w.r.t. cluster axis
+    n = 0.0_pREAL
+    n(abs(intFace(1))) = real(intFace(1)/abs(intFace(1)),pREAL)                                     ! get the normal vector w.r.t. cluster axis
 
     n = matmul(dst%orientation(1:3,1:3,en),n)                                                       ! map the normal vector into sample coordinate system (basis)
 
@@ -800,7 +800,7 @@ pure function getInterface(iFace,iGrain3) result(i)
   integer :: iDir                                                                                   !< direction of interface normal
 
 
-  iDir = (int(real(iFace-1,pReal)/2.0_pReal)+1)*(-1)**iFace
+  iDir = (int(real(iFace-1,pREAL)/2.0_pREAL)+1)*(-1)**iFace
   i = [iDir,iGrain3]
   if (iDir < 0) i(1-iDir) = i(1-iDir)-1                                       ! to have a correlation with coordinate/position in real space
 
@@ -907,18 +907,18 @@ pure function interface1to4(iFace1D, nGDim)
   if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then                                                ! interface with normal || e1
     interface1to4(1) = 1
     interface1to4(3) = mod((iFace1D-1),nGDim(2))+1
-    interface1to4(4) = mod(int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)),nGDim(3))+1
-    interface1to4(2) = int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)/real(nGDim(3),pReal))+1
+    interface1to4(4) = mod(int(real(iFace1D-1,pREAL)/real(nGDim(2),pREAL)),nGDim(3))+1
+    interface1to4(2) = int(real(iFace1D-1,pREAL)/real(nGDim(2),pREAL)/real(nGDim(3),pREAL))+1
   elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then                  ! interface with normal || e2
     interface1to4(1) = 2
     interface1to4(4) = mod((iFace1D-nIntFace(1)-1),nGDim(3))+1
-    interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)),nGDim(1))+1
-    interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)/real(nGDim(1),pReal))+1
+    interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pREAL)/real(nGDim(3),pREAL)),nGDim(1))+1
+    interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pREAL)/real(nGDim(3),pREAL)/real(nGDim(1),pREAL))+1
   elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal || e3
     interface1to4(1) = 3
     interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1),nGDim(1))+1
-    interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)),nGDim(2))+1
-    interface1to4(4) = int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)/real(nGDim(2),pReal))+1
+    interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pREAL)/real(nGDim(1),pREAL)),nGDim(2))+1
+    interface1to4(4) = int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pREAL)/real(nGDim(1),pREAL)/real(nGDim(2),pREAL))+1
   end if
 
 end function interface1to4

src/homogenization_mechanical_isostrain.f90

@@ -40,9 +40,9 @@ end subroutine isostrain_init
 !--------------------------------------------------------------------------------------------------
 module subroutine isostrain_partitionDeformation(F,avgF)
 
-  real(pReal),   dimension (:,:,:), intent(out) :: F                                                !< partitioned deformation gradient
+  real(pREAL),   dimension (:,:,:), intent(out) :: F                                                !< partitioned deformation gradient
 
-  real(pReal),   dimension (3,3),   intent(in)  :: avgF                                             !< average deformation gradient at material point
+  real(pREAL),   dimension (3,3),   intent(in)  :: avgF                                             !< average deformation gradient at material point
 
 
   F = spread(avgF,3,size(F,3))

src/homogenization_thermal.f90

@@ -14,7 +14,7 @@ submodule(homogenization) thermal
   end interface
 
   type :: tDataContainer
-    real(pReal), dimension(:), allocatable :: T, dot_T
+    real(pREAL), dimension(:), allocatable :: T, dot_T
   end type tDataContainer
 
   type(tDataContainer), dimension(:), allocatable :: current
@@ -51,7 +51,7 @@ module subroutine thermal_init()
 
   do ho = 1, configHomogenizations%length
     allocate(current(ho)%T(count(material_ID_homogenization==ho)), source=T_ROOM)
-    allocate(current(ho)%dot_T(count(material_ID_homogenization==ho)), source=0.0_pReal)
+    allocate(current(ho)%dot_T(count(material_ID_homogenization==ho)), source=0.0_pREAL)
     configHomogenization => configHomogenizations%get_dict(ho)
     associate(prm => param(ho))
 
@@ -100,7 +100,7 @@ module subroutine thermal_partition(ce)
 
   integer, intent(in) :: ce
 
-  real(pReal) :: T, dot_T
+  real(pREAL) :: T, dot_T
   integer :: co
 
 
@@ -119,7 +119,7 @@ end subroutine thermal_partition
 module function homogenization_mu_T(ce) result(mu)
 
   integer, intent(in) :: ce
-  real(pReal) :: mu
+  real(pREAL) :: mu
 
   integer :: co
 
@@ -138,7 +138,7 @@ end function homogenization_mu_T
 module function homogenization_K_T(ce) result(K)
 
   integer, intent(in) :: ce
-  real(pReal), dimension(3,3) :: K
+  real(pREAL), dimension(3,3) :: K
 
   integer :: co
 
@@ -157,7 +157,7 @@ end function homogenization_K_T
 module function homogenization_f_T(ce) result(f)
 
   integer, intent(in) :: ce
-  real(pReal) :: f
+  real(pREAL) :: f
 
   integer :: co
 
@@ -176,7 +176,7 @@ end function homogenization_f_T
 module subroutine homogenization_thermal_setField(T,dot_T, ce)
 
   integer, intent(in) :: ce
-  real(pReal), intent(in) :: T, dot_T
+  real(pREAL), intent(in) :: T, dot_T
 
 
   current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) = T

src/lattice.f90

@@ -38,7 +38,7 @@ module lattice
     CF_NTRANS    = sum(CF_NTRANSSYSTEM), &                                                          !< total # of transformation systems for cF
     CF_NCLEAVAGE = sum(CF_NCLEAVAGESYSTEM)                                                          !< total # of cleavage systems for cF
 
-  real(pReal), dimension(3+3,CF_NSLIP), parameter :: &
+  real(pREAL), dimension(3+3,CF_NSLIP), parameter :: &
     CF_SYSTEMSLIP = reshape(real([&
     ! <110>{111} systems
        0, 1,-1,     1, 1, 1, & ! B2
@@ -60,9 +60,9 @@ module lattice
        1, 0,-1,     1, 0, 1, &
        0, 1, 1,     0, 1,-1, &
        0, 1,-1,     0, 1, 1  &
-      ],pReal),shape(CF_SYSTEMSLIP))                                                                !< cF slip systems
+      ],pREAL),shape(CF_SYSTEMSLIP))                                                                !< cF slip systems
 
-  real(pReal), dimension(3+3,CF_NTWIN), parameter :: &
+  real(pREAL), dimension(3+3,CF_NTWIN), parameter :: &
     CF_SYSTEMTWIN = reshape(real( [&
     ! <112>{111} systems
       -2, 1, 1,     1, 1, 1, &
@@ -77,7 +77,7 @@ module lattice
        2, 1,-1,    -1, 1,-1, &
       -1,-2,-1,    -1, 1,-1, &
       -1, 1, 2,    -1, 1,-1  &
-      ],pReal),shape(CF_SYSTEMTWIN))                                                                !< cF twin systems
+      ],pREAL),shape(CF_SYSTEMTWIN))                                                                !< cF twin systems
 
   integer, dimension(2,CF_NTWIN), parameter, public :: &
     lattice_CF_TWINNUCLEATIONSLIPPAIR = reshape( [&
@@ -95,13 +95,13 @@ module lattice
       10,11 &
       ],shape(lattice_CF_TWINNUCLEATIONSLIPPAIR))
 
-  real(pReal), dimension(3+3,CF_NCLEAVAGE), parameter :: &
+  real(pREAL), dimension(3+3,CF_NCLEAVAGE), parameter :: &
     CF_SYSTEMCLEAVAGE = reshape(real([&
     ! <001>{001} systems
        0, 1, 0,     1, 0, 0, &
        0, 0, 1,     0, 1, 0, &
        1, 0, 0,     0, 0, 1  &
-      ],pReal),shape(CF_SYSTEMCLEAVAGE))                                                            !< cF cleavage systems
+      ],pREAL),shape(CF_SYSTEMCLEAVAGE))                                                            !< cF cleavage systems
 
 !--------------------------------------------------------------------------------------------------
 ! cI: body centered cubic (bcc)
@@ -120,7 +120,7 @@ module lattice
     CI_NTWIN     = sum(CI_NTWINSYSTEM), &                                                           !< total # of twin systems for cI
     CI_NCLEAVAGE = sum(CI_NCLEAVAGESYSTEM)                                                          !< total # of cleavage systems for cI
 
-  real(pReal), dimension(3+3,CI_NSLIP), parameter :: &
+  real(pREAL), dimension(3+3,CI_NSLIP), parameter :: &
     CI_SYSTEMSLIP = reshape(real([&
     ! <111>{110} systems
        1,-1, 1,     0, 1, 1, & ! D1
@@ -173,9 +173,9 @@ module lattice
        1, 1, 1,    -3, 2, 1, &
        1, 1,-1,     3,-2, 1, &
        1,-1, 1,     3, 2,-1  &
-      ],pReal),shape(CI_SYSTEMSLIP))                                                                !< cI slip systems
+      ],pREAL),shape(CI_SYSTEMSLIP))                                                                !< cI slip systems
 
-  real(pReal), dimension(3+3,CI_NTWIN), parameter :: &
+  real(pREAL), dimension(3+3,CI_NTWIN), parameter :: &
     CI_SYSTEMTWIN = reshape(real([&
     ! <111>{112} systems
       -1, 1, 1,     2, 1, 1, &
@@ -190,15 +190,15 @@ module lattice
        1,-1, 1,    -1, 1, 2, &
       -1, 1, 1,     1,-1, 2, &
        1, 1, 1,     1, 1,-2  &
-      ],pReal),shape(CI_SYSTEMTWIN))                                                                !< cI twin systems
+      ],pREAL),shape(CI_SYSTEMTWIN))                                                                !< cI twin systems
 
-  real(pReal), dimension(3+3,CI_NCLEAVAGE), parameter :: &
+  real(pREAL), dimension(3+3,CI_NCLEAVAGE), parameter :: &
     CI_SYSTEMCLEAVAGE = reshape(real([&
     ! <001>{001} systems
        0, 1, 0,     1, 0, 0, &
        0, 0, 1,     0, 1, 0, &
        1, 0, 0,     0, 0, 1  &
-      ],pReal),shape(CI_SYSTEMCLEAVAGE))                                                            !< cI cleavage systems
+      ],pREAL),shape(CI_SYSTEMCLEAVAGE))                                                            !< cI cleavage systems
 
 !--------------------------------------------------------------------------------------------------
 ! hP: hexagonal [close packed] (hex, hcp)
@@ -213,7 +213,7 @@ module lattice
     HP_NSLIP     = sum(HP_NSLIPSYSTEM), &                                                           !< total # of slip systems for hP
     HP_NTWIN     = sum(HP_NTWINSYSTEM)                                                              !< total # of twin systems for hP
 
-  real(pReal), dimension(4+4,HP_NSLIP), parameter :: &
+  real(pREAL), dimension(4+4,HP_NSLIP), parameter :: &
     HP_SYSTEMSLIP = reshape(real([&
     ! <-1-1.0>{00.1}/basal systems (independent of c/a-ratio)
        2, -1, -1,  0,     0,  0,  0,  1, &
@@ -250,9 +250,9 @@ module lattice
        1,  1, -2,  3,    -1, -1,  2,  2, &
       -1,  2, -1,  3,     1, -2,  1,  2, &
       -2,  1,  1,  3,     2, -1, -1,  2  &
-      ],pReal),shape(HP_SYSTEMSLIP))                                                                !< hP slip systems, sorted by P. Eisenlohr CCW around <c> starting next to a_1 axis
+      ],pREAL),shape(HP_SYSTEMSLIP))                                                                !< hP slip systems, sorted by P. Eisenlohr CCW around <c> starting next to a_1 axis
 
-  real(pReal), dimension(4+4,HP_NTWIN), parameter :: &
+  real(pREAL), dimension(4+4,HP_NTWIN), parameter :: &
     HP_SYSTEMTWIN =  reshape(real([&
     ! <-10.1>{10.2} systems, shear = (3-(c/a)^2)/(sqrt(3) c/a)
     ! tension in Co, Mg, Zr, Ti, and Be; compression in Cd and Zn
@@ -286,7 +286,7 @@ module lattice
       -1, -1,  2, -3,    -1, -1,  2,  2, &
        1, -2,  1, -3,     1, -2,  1,  2, &
        2, -1, -1, -3,     2, -1, -1,  2  &
-      ],pReal),shape(HP_SYSTEMTWIN))                                                                !< hP twin systems, sorted by P. Eisenlohr CCW around <c> starting next to a_1 axis
+      ],pREAL),shape(HP_SYSTEMTWIN))                                                                !< hP twin systems, sorted by P. Eisenlohr CCW around <c> starting next to a_1 axis
 
 !--------------------------------------------------------------------------------------------------
 ! tI: body centered tetragonal (bct)
@@ -297,7 +297,7 @@ module lattice
   integer, parameter :: &
     TI_NSLIP = sum(TI_NSLIPSYSTEM)                                                                 !< total # of slip systems for tI
 
-  real(pReal), dimension(3+3,TI_NSLIP), parameter :: &
+  real(pREAL), dimension(3+3,TI_NSLIP), parameter :: &
     TI_SYSTEMSLIP = reshape(real([&
     ! {100)<001] systems
        0, 0, 1,      1, 0, 0, &
@@ -364,7 +364,7 @@ module lattice
        1,-1, 1,     -2,-1, 1, &
       -1, 1, 1,     -1,-2, 1, &
        1, 1, 1,      1,-2, 1  &
-       ],pReal),shape(TI_SYSTEMSLIP))                                                               !< tI slip systems for c/a = 0.5456 (Sn), sorted by Bieler 2009 (https://doi.org/10.1007/s11664-009-0909-x)
+       ],pREAL),shape(TI_SYSTEMSLIP))                                                               !< tI slip systems for c/a = 0.5456 (Sn), sorted by Bieler 2009 (https://doi.org/10.1007/s11664-009-0909-x)
 
 
   interface lattice_forestProjection_edge
@@ -424,8 +424,8 @@ function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
 
   integer,     dimension(:),            intent(in) :: Ntwin                                         !< number of active twin systems per family
   character(len=*),                     intent(in) :: lattice                                       !< Bravais lattice (Pearson symbol)
-  real(pReal),                          intent(in) :: cOverA                                        !< c/a ratio
-  real(pReal), dimension(sum(Ntwin))               :: characteristicShear
+  real(pREAL),                          intent(in) :: cOverA                                        !< c/a ratio
+  real(pREAL), dimension(sum(Ntwin))               :: characteristicShear
 
   integer :: &
     a, &                                                                                            !< index of active system
@@ -467,20 +467,20 @@ function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
       a = a + 1
       select case(lattice)
         case('cF','cI')
-          characteristicShear(a) = 0.5_pReal*sqrt(2.0_pReal)
+          characteristicShear(a) = 0.5_pREAL*sqrt(2.0_pREAL)
         case('hP')
-          if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) &
+          if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) &
             call IO_error(131,ext_msg='lattice_characteristicShear_Twin')
           p = sum(HP_NTWINSYSTEM(1:f-1))+s
           select case(HP_SHEARTWIN(p))                                                              ! from Christian & Mahajan 1995 p.29
             case (1)                                                                                ! <-10.1>{10.2}
-              characteristicShear(a) = (3.0_pReal-cOverA**2)/sqrt(3.0_pReal)/CoverA
+              characteristicShear(a) = (3.0_pREAL-cOverA**2)/sqrt(3.0_pREAL)/CoverA
             case (2)                                                                                ! <11.6>{-1-1.1}
-              characteristicShear(a) = 1.0_pReal/cOverA
+              characteristicShear(a) = 1.0_pREAL/cOverA
             case (3)                                                                                ! <10.-2>{10.1}
-              characteristicShear(a) = (4.0_pReal*cOverA**2-9.0_pReal)/sqrt(48.0_pReal)/cOverA
+              characteristicShear(a) = (4.0_pREAL*cOverA**2-9.0_pREAL)/sqrt(48.0_pREAL)/cOverA
             case (4)                                                                                ! <11.-3>{11.2}
-              characteristicShear(a) = 2.0_pReal*(cOverA**2-2.0_pReal)/3.0_pReal/cOverA
+              characteristicShear(a) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA
           end select
         case default
           call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(lattice))
@@ -498,11 +498,11 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
 
   integer,     dimension(:),            intent(in) :: Ntwin                                         !< number of active twin systems per family
   character(len=*),                     intent(in) :: lattice                                       !< Bravais lattice (Pearson symbol)
-  real(pReal), dimension(6,6),          intent(in) :: C66                                           !< unrotated parent stiffness matrix
-  real(pReal),                          intent(in) :: cOverA                                        !< c/a ratio
-  real(pReal), dimension(6,6,sum(Ntwin))           :: lattice_C66_twin
+  real(pREAL), dimension(6,6),          intent(in) :: C66                                           !< unrotated parent stiffness matrix
+  real(pREAL),                          intent(in) :: cOverA                                        !< c/a ratio
+  real(pREAL), dimension(6,6,sum(Ntwin))           :: lattice_C66_twin
 
-  real(pReal), dimension(3,3,sum(Ntwin)):: coordinateSystem
+  real(pREAL), dimension(3,3,sum(Ntwin)):: coordinateSystem
   type(tRotation)                       :: R
   integer                               :: i
 
@@ -510,10 +510,10 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
   select case(lattice)
     case('cF')
       coordinateSystem = buildCoordinateSystem(Ntwin,CF_NSLIPSYSTEM,CF_SYSTEMTWIN,&
-                                               lattice,0.0_pReal)
+                                               lattice,0.0_pREAL)
     case('cI')
       coordinateSystem = buildCoordinateSystem(Ntwin,CI_NSLIPSYSTEM,CI_SYSTEMTWIN,&
-                                               lattice,0.0_pReal)
+                                               lattice,0.0_pREAL)
     case('hP')
       coordinateSystem = buildCoordinateSystem(Ntwin,HP_NSLIPSYSTEM,HP_SYSTEMTWIN,&
                                                lattice,cOverA)
@@ -537,12 +537,12 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
 
   integer,     dimension(:),             intent(in) :: Ntrans                                       !< number of active twin systems per family
   character(len=*),                      intent(in) :: lattice_target                               !< Bravais lattice (Pearson symbol)
-  real(pReal), dimension(6,6),           intent(in) :: C_parent66
-  real(pReal),                 optional, intent(in) :: cOverA_trans, a_cF, a_cI
-  real(pReal), dimension(6,6,sum(Ntrans))           :: lattice_C66_trans
+  real(pREAL), dimension(6,6),           intent(in) :: C_parent66
+  real(pREAL),                 optional, intent(in) :: cOverA_trans, a_cF, a_cI
+  real(pREAL), dimension(6,6,sum(Ntrans))           :: lattice_C66_trans
 
-  real(pReal), dimension(6,6)             :: C_bar66, C_target_unrotated66
-  real(pReal), dimension(3,3,sum(Ntrans)) :: Q,S
+  real(pREAL), dimension(6,6)             :: C_bar66, C_target_unrotated66
+  real(pREAL), dimension(3,3,sum(Ntrans)) :: Q,S
   type(tRotation)                         :: R
   integer                                 :: i
 
@@ -551,24 +551,24 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
   if (lattice_target == 'hP' .and. present(cOverA_trans)) then
     ! https://doi.org/10.1063/1.1663858 eq. (16), eq. (18), eq. (19)
     ! https://doi.org/10.1016/j.actamat.2016.07.032 eq. (47), eq. (48)
-    if (cOverA_trans < 1.0_pReal .or. cOverA_trans > 2.0_pReal) &
+    if (cOverA_trans < 1.0_pREAL .or. cOverA_trans > 2.0_pREAL) &
       call IO_error(131,ext_msg='lattice_C66_trans: '//trim(lattice_target))
-    C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pReal*C_parent66(4,4))/2.0_pReal
-    C_bar66(1,2) = (C_parent66(1,1) + 5.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/6.0_pReal
-    C_bar66(3,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) + 4.0_pReal*C_parent66(4,4))/3.0_pReal
-    C_bar66(1,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/3.0_pReal
-    C_bar66(4,4) = (C_parent66(1,1) - C_parent66(1,2) + C_parent66(4,4))/3.0_pReal
-    C_bar66(1,4) = (C_parent66(1,1) - C_parent66(1,2) - 2.0_pReal*C_parent66(4,4)) /(3.0_pReal*sqrt(2.0_pReal))
+    C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pREAL*C_parent66(4,4))/2.0_pREAL
+    C_bar66(1,2) = (C_parent66(1,1) + 5.0_pREAL*C_parent66(1,2) - 2.0_pREAL*C_parent66(4,4))/6.0_pREAL
+    C_bar66(3,3) = (C_parent66(1,1) + 2.0_pREAL*C_parent66(1,2) + 4.0_pREAL*C_parent66(4,4))/3.0_pREAL
+    C_bar66(1,3) = (C_parent66(1,1) + 2.0_pREAL*C_parent66(1,2) - 2.0_pREAL*C_parent66(4,4))/3.0_pREAL
+    C_bar66(4,4) = (C_parent66(1,1) - C_parent66(1,2) + C_parent66(4,4))/3.0_pREAL
+    C_bar66(1,4) = (C_parent66(1,1) - C_parent66(1,2) - 2.0_pREAL*C_parent66(4,4)) /(3.0_pREAL*sqrt(2.0_pREAL))
 
-    C_target_unrotated66 = 0.0_pReal
+    C_target_unrotated66 = 0.0_pREAL
     C_target_unrotated66(1,1) = C_bar66(1,1) - C_bar66(1,4)**2/C_bar66(4,4)
     C_target_unrotated66(1,2) = C_bar66(1,2) + C_bar66(1,4)**2/C_bar66(4,4)
     C_target_unrotated66(1,3) = C_bar66(1,3)
     C_target_unrotated66(3,3) = C_bar66(3,3)
-    C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2/(0.5_pReal*(C_bar66(1,1) - C_bar66(1,2)))
+    C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2/(0.5_pREAL*(C_bar66(1,1) - C_bar66(1,2)))
     C_target_unrotated66 = lattice_symmetrize_C66(C_target_unrotated66,'hP')
   elseif (lattice_target  == 'cI' .and. present(a_cF) .and. present(a_cI)) then
-    if (a_cI <= 0.0_pReal .or. a_cF <= 0.0_pReal) &
+    if (a_cI <= 0.0_pREAL .or. a_cF <= 0.0_pREAL) &
       call IO_error(134,ext_msg='lattice_C66_trans: '//trim(lattice_target))
     C_target_unrotated66 = C_parent66
   else
@@ -598,26 +598,26 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
 function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix)
 
   integer,     dimension(:),                intent(in) :: Nslip                                     !< number of active slip systems per family
-  real(pReal), dimension(:),                intent(in) :: nonSchmidCoefficients                     !< non-Schmid coefficients for projections
+  real(pREAL), dimension(:),                intent(in) :: nonSchmidCoefficients                     !< non-Schmid coefficients for projections
   integer,                                  intent(in) :: sense                                     !< sense (-1,+1)
-  real(pReal), dimension(1:3,1:3,sum(Nslip))           :: nonSchmidMatrix
+  real(pREAL), dimension(1:3,1:3,sum(Nslip))           :: nonSchmidMatrix
 
-  real(pReal), dimension(1:3,1:3,sum(Nslip))           :: coordinateSystem                          !< coordinate system of slip system
-  real(pReal), dimension(3)                            :: direction, normal, np
+  real(pREAL), dimension(1:3,1:3,sum(Nslip))           :: coordinateSystem                          !< coordinate system of slip system
+  real(pREAL), dimension(3)                            :: direction, normal, np
   type(tRotation)                                      :: R
   integer                                              :: i
 
 
   if (abs(sense) /= 1) error stop 'Sense in lattice_nonSchmidMatrix'
 
-  coordinateSystem  = buildCoordinateSystem(Nslip,CI_NSLIPSYSTEM,CI_SYSTEMSLIP,'cI',0.0_pReal)
-  coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip))*real(sense,pReal)     ! convert unidirectional coordinate system
-  nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'cI',0.0_pReal)                                 ! Schmid contribution
+  coordinateSystem  = buildCoordinateSystem(Nslip,CI_NSLIPSYSTEM,CI_SYSTEMSLIP,'cI',0.0_pREAL)
+  coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip))*real(sense,pREAL)     ! convert unidirectional coordinate system
+  nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'cI',0.0_pREAL)                                 ! Schmid contribution
 
   do i = 1,sum(Nslip)
     direction = coordinateSystem(1:3,1,i)
     normal    = coordinateSystem(1:3,2,i)
-    call R%fromAxisAngle([direction,60.0_pReal],degrees=.true.,P=1)
+    call R%fromAxisAngle([direction,60.0_pREAL],degrees=.true.,P=1)
     np = R%rotate(normal)
 
     if (size(nonSchmidCoefficients)>0) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
@@ -647,9 +647,9 @@ end function lattice_nonSchmidMatrix
 function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(interactionMatrix)
 
   integer,         dimension(:),                   intent(in) :: Nslip                              !< number of active slip systems per family
-  real(pReal),     dimension(:),                   intent(in) :: interactionValues                  !< values for slip-slip interaction
+  real(pREAL),     dimension(:),                   intent(in) :: interactionValues                  !< values for slip-slip interaction
   character(len=*),                                intent(in) :: lattice                            !< Bravais lattice (Pearson symbol)
-  real(pReal),     dimension(sum(Nslip),sum(Nslip))           :: interactionMatrix
+  real(pREAL),     dimension(sum(Nslip),sum(Nslip))           :: interactionMatrix
 
   integer, dimension(:),   allocatable :: NslipMax
   integer, dimension(:,:), allocatable :: interactionTypes
@@ -965,9 +965,9 @@ end function lattice_interaction_SlipBySlip
 function lattice_interaction_TwinByTwin(Ntwin,interactionValues,lattice) result(interactionMatrix)
 
   integer,         dimension(:),                   intent(in) :: Ntwin                              !< number of active twin systems per family
-  real(pReal),     dimension(:),                   intent(in) :: interactionValues                  !< values for twin-twin interaction
+  real(pREAL),     dimension(:),                   intent(in) :: interactionValues                  !< values for twin-twin interaction
   character(len=*),                                intent(in) :: lattice                            !< Bravais lattice (Pearson symbol)
-  real(pReal),     dimension(sum(Ntwin),sum(Ntwin))           :: interactionMatrix
+  real(pREAL),     dimension(sum(Ntwin),sum(Ntwin))           :: interactionMatrix
 
   integer, dimension(:),   allocatable :: NtwinMax
   integer, dimension(:,:), allocatable :: interactionTypes
@@ -1064,9 +1064,9 @@ end function lattice_interaction_TwinByTwin
 function lattice_interaction_TransByTrans(Ntrans,interactionValues,lattice) result(interactionMatrix)
 
   integer,         dimension(:),                     intent(in) :: Ntrans                           !< number of active trans systems per family
-  real(pReal),     dimension(:),                     intent(in) :: interactionValues                !< values for trans-trans interaction
+  real(pREAL),     dimension(:),                     intent(in) :: interactionValues                !< values for trans-trans interaction
   character(len=*),                                  intent(in) :: lattice                          !<Bravais lattice (Pearson symbol) (parent crystal)
-  real(pReal),     dimension(sum(Ntrans),sum(Ntrans))           :: interactionMatrix
+  real(pREAL),     dimension(sum(Ntrans),sum(Ntrans))           :: interactionMatrix
 
   integer, dimension(:),   allocatable :: NtransMax
   integer, dimension(:,:), allocatable :: interactionTypes
@@ -1107,9 +1107,9 @@ function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) r
 
   integer,         dimension(:),                   intent(in) :: Nslip, &                           !< number of active slip systems per family
                                                                  Ntwin                              !< number of active twin systems per family
-  real(pReal),     dimension(:),                   intent(in) :: interactionValues                  !< values for slip-twin interaction
+  real(pREAL),     dimension(:),                   intent(in) :: interactionValues                  !< values for slip-twin interaction
   character(len=*),                                intent(in) :: lattice                            !< Bravais lattice (Pearson symbol)
-  real(pReal),     dimension(sum(Nslip),sum(Ntwin))           :: interactionMatrix
+  real(pREAL),     dimension(sum(Nslip),sum(Ntwin))           :: interactionMatrix
 
   integer, dimension(:),   allocatable :: NslipMax, &
                                           NtwinMax
@@ -1267,9 +1267,9 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,lattice)
 
   integer,         dimension(:),                    intent(in) :: Nslip, &                          !< number of active slip systems per family
                                                                   Ntrans                            !< number of active trans systems per family
-  real(pReal),     dimension(:),                    intent(in) :: interactionValues                 !< values for slip-trans interaction
+  real(pREAL),     dimension(:),                    intent(in) :: interactionValues                 !< values for slip-trans interaction
   character(len=*),                                 intent(in) :: lattice                           !< Bravais lattice (Pearson symbol) (parent crystal)
-  real(pReal),     dimension(sum(Nslip),sum(Ntrans))           :: interactionMatrix
+  real(pREAL),     dimension(sum(Nslip),sum(Ntrans))           :: interactionMatrix
 
   integer, dimension(:),   allocatable :: NslipMax, &
                                           NtransMax
@@ -1320,9 +1320,9 @@ function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,lattice) r
 
   integer,         dimension(:),                   intent(in) :: Ntwin, &                           !< number of active twin systems per family
                                                                  Nslip                              !< number of active slip systems per family
-  real(pReal),     dimension(:),                   intent(in) :: interactionValues                  !< values for twin-twin interaction
+  real(pREAL),     dimension(:),                   intent(in) :: interactionValues                  !< values for twin-twin interaction
   character(len=*),                                intent(in) :: lattice                            !< Bravais lattice (Pearson symbol)
-  real(pReal),     dimension(sum(Ntwin),sum(Nslip))           :: interactionMatrix
+  real(pREAL),     dimension(sum(Ntwin),sum(Nslip))           :: interactionMatrix
 
   integer, dimension(:),   allocatable :: NtwinMax, &
                                           NslipMax
@@ -1396,11 +1396,11 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix)
 
   integer,         dimension(:),            intent(in) :: Nslip                                     !< number of active slip systems per family
   character(len=*),                         intent(in) :: lattice                                   !< Bravais lattice (Pearson symbol)
-  real(pReal),                              intent(in) :: cOverA
-  real(pReal),     dimension(3,3,sum(Nslip))           :: SchmidMatrix
+  real(pREAL),                              intent(in) :: cOverA
+  real(pREAL),     dimension(3,3,sum(Nslip))           :: SchmidMatrix
 
-  real(pReal), dimension(3,3,sum(Nslip))             :: coordinateSystem
-  real(pReal), dimension(:,:),           allocatable :: slipSystems
+  real(pREAL), dimension(3,3,sum(Nslip))             :: coordinateSystem
+  real(pREAL), dimension(:,:),           allocatable :: slipSystems
   integer,     dimension(:),             allocatable :: NslipMax
   integer                                            :: i
 
@@ -1446,11 +1446,11 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
 
   integer,         dimension(:),            intent(in) :: Ntwin                                     !< number of active twin systems per family
   character(len=*),                         intent(in) :: lattice                                   !< Bravais lattice (Pearson symbol)
-  real(pReal),                              intent(in) :: cOverA                                    !< c/a ratio
-  real(pReal),     dimension(3,3,sum(Ntwin))           :: SchmidMatrix
+  real(pREAL),                              intent(in) :: cOverA                                    !< c/a ratio
+  real(pREAL),     dimension(3,3,sum(Ntwin))           :: SchmidMatrix
 
-  real(pReal), dimension(3,3,sum(Ntwin))             :: coordinateSystem
-  real(pReal), dimension(:,:),           allocatable :: twinSystems
+  real(pREAL), dimension(3,3,sum(Ntwin))             :: coordinateSystem
+  real(pREAL), dimension(:,:),           allocatable :: twinSystems
   integer,     dimension(:),             allocatable :: NtwinMax
   integer                                            :: i
 
@@ -1493,18 +1493,18 @@ function lattice_SchmidMatrix_trans(Ntrans,lattice_target,cOverA,a_cF,a_cI) resu
 
   integer,         dimension(:),             intent(in) :: Ntrans                                   !< number of active twin systems per family
   character(len=*),                          intent(in) :: lattice_target                           !< Bravais lattice (Pearson symbol)
-  real(pReal),                     optional, intent(in) :: cOverA, a_cI, a_cF
-  real(pReal),     dimension(3,3,sum(Ntrans))           :: SchmidMatrix
+  real(pREAL),                     optional, intent(in) :: cOverA, a_cI, a_cF
+  real(pREAL),     dimension(3,3,sum(Ntrans))           :: SchmidMatrix
 
-  real(pReal), dimension(3,3,sum(Ntrans)) :: devNull
+  real(pREAL), dimension(3,3,sum(Ntrans)) :: devNull
 
 
   if (lattice_target == 'hP' .and. present(cOverA)) then
-    if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) &
+    if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) &
     call IO_error(131,ext_msg='lattice_SchmidMatrix_trans: '//trim(lattice_target))
     call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA=cOverA)
   else if (lattice_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then
-    if (a_cI <= 0.0_pReal .or. a_cF <= 0.0_pReal) &
+    if (a_cI <= 0.0_pREAL .or. a_cF <= 0.0_pREAL) &
     call IO_error(134,ext_msg='lattice_SchmidMatrix_trans: '//trim(lattice_target))
     call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,a_cF=a_cF,a_cI=a_cI)
   else
@@ -1522,11 +1522,11 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMa
 
   integer,         dimension(:),                  intent(in) :: Ncleavage                           !< number of active cleavage systems per family
   character(len=*),                               intent(in) :: lattice                             !< Bravais lattice (Pearson symbol)
-  real(pReal),                                    intent(in) :: cOverA                              !< c/a ratio
-  real(pReal),     dimension(3,3,3,sum(Ncleavage))           :: SchmidMatrix
+  real(pREAL),                                    intent(in) :: cOverA                              !< c/a ratio
+  real(pREAL),     dimension(3,3,3,sum(Ncleavage))           :: SchmidMatrix
 
-  real(pReal), dimension(3,3,sum(Ncleavage))             :: coordinateSystem
-  real(pReal), dimension(:,:),               allocatable :: cleavageSystems
+  real(pREAL), dimension(3,3,sum(Ncleavage))             :: coordinateSystem
+  real(pREAL), dimension(:,:),               allocatable :: cleavageSystems
   integer,     dimension(:),                 allocatable :: NcleavageMax
   integer                                                :: i
 
@@ -1565,10 +1565,10 @@ function lattice_slip_direction(Nslip,lattice,cOverA) result(d)
 
   integer,         dimension(:),           intent(in) :: Nslip                                      !< number of active slip systems per family
   character(len=*),                        intent(in) :: lattice                                    !< Bravais lattice (Pearson symbol)
-  real(pReal),                             intent(in) :: cOverA                                     !< c/a ratio
-  real(pReal),     dimension(3,sum(Nslip))            :: d
+  real(pREAL),                             intent(in) :: cOverA                                     !< c/a ratio
+  real(pREAL),     dimension(3,sum(Nslip))            :: d
 
-  real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
+  real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
 
   coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
   d = coordinateSystem(1:3,1,1:sum(Nslip))
@@ -1583,10 +1583,10 @@ function lattice_slip_normal(Nslip,lattice,cOverA) result(n)
 
   integer,         dimension(:),           intent(in) :: Nslip                                      !< number of active slip systems per family
   character(len=*),                        intent(in) :: lattice                                    !< Bravais lattice (Pearson symbol)
-  real(pReal),                             intent(in) :: cOverA                                     !< c/a ratio
-  real(pReal),     dimension(3,sum(Nslip))            :: n
+  real(pREAL),                             intent(in) :: cOverA                                     !< c/a ratio
+  real(pREAL),     dimension(3,sum(Nslip))            :: n
 
-  real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
+  real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
 
   coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
   n = coordinateSystem(1:3,2,1:sum(Nslip))
@@ -1601,10 +1601,10 @@ function lattice_slip_transverse(Nslip,lattice,cOverA) result(t)
 
   integer,         dimension(:),           intent(in) :: Nslip                                      !< number of active slip systems per family
   character(len=*),                        intent(in) :: lattice                                    !< Bravais lattice (Pearson symbol)
-  real(pReal),                             intent(in) :: cOverA                                     !< c/a ratio
-  real(pReal),     dimension(3,sum(Nslip))            :: t
+  real(pREAL),                             intent(in) :: cOverA                                     !< c/a ratio
+  real(pREAL),     dimension(3,sum(Nslip))            :: t
 
-  real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
+  real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
 
   coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
   t = coordinateSystem(1:3,3,1:sum(Nslip))
@@ -1623,7 +1623,7 @@ function lattice_labels_slip(Nslip,lattice) result(labels)
 
   character(len=:), dimension(:),   allocatable :: labels
 
-  real(pReal),      dimension(:,:), allocatable :: slipSystems
+  real(pREAL),      dimension(:,:), allocatable :: slipSystems
   integer,          dimension(:),   allocatable :: NslipMax
 
   select case(lattice)
@@ -1658,13 +1658,13 @@ end function lattice_labels_slip
 !--------------------------------------------------------------------------------------------------
 pure function lattice_symmetrize_33(T,lattice) result(T_sym)
 
-  real(pReal), dimension(3,3) :: T_sym
+  real(pREAL), dimension(3,3) :: T_sym
 
-  real(pReal), dimension(3,3), intent(in) :: T
+  real(pREAL), dimension(3,3), intent(in) :: T
   character(len=*),            intent(in) :: lattice                                                !< Bravais lattice (Pearson symbol)
 
 
-  T_sym = 0.0_pReal
+  T_sym = 0.0_pREAL
 
   select case(lattice)
     case('cF','cI')
@@ -1686,15 +1686,15 @@ end function lattice_symmetrize_33
 !--------------------------------------------------------------------------------------------------
 pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym)
 
-  real(pReal), dimension(6,6) :: C66_sym
+  real(pREAL), dimension(6,6) :: C66_sym
 
-  real(pReal), dimension(6,6), intent(in) :: C66
+  real(pREAL), dimension(6,6), intent(in) :: C66
   character(len=*),            intent(in) :: lattice                                                !< Bravais lattice (Pearson symbol)
 
   integer :: i,j
 
 
-  C66_sym = 0.0_pReal
+  C66_sym = 0.0_pREAL
 
   select case(lattice)
     case ('cF','cI')
@@ -1707,7 +1707,7 @@ pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym)
       C66_sym(1,2) = C66(1,2)
       C66_sym(1,3) = C66(1,3); C66_sym(2,3) = C66(1,3)
       C66_sym(4,4) = C66(4,4); C66_sym(5,5) = C66(4,4)
-      C66_sym(6,6) = 0.5_pReal*(C66(1,1)-C66(1,2))
+      C66_sym(6,6) = 0.5_pREAL*(C66(1,1)-C66(1,2))
     case ('tI')
       C66_sym(1,1) = C66(1,1); C66_sym(2,2) = C66(1,1)
       C66_sym(3,3) = C66(3,3)
@@ -1737,7 +1737,7 @@ function lattice_labels_twin(Ntwin,lattice) result(labels)
 
   character(len=:), dimension(:),   allocatable :: labels
 
-  real(pReal),      dimension(:,:), allocatable :: twinSystems
+  real(pREAL),      dimension(:,:), allocatable :: twinSystems
   integer,          dimension(:),   allocatable :: NtwinMax
 
   select case(lattice)
@@ -1772,10 +1772,10 @@ function slipProjection_transverse(Nslip,lattice,cOverA) result(projection)
 
   integer,         dimension(:),                   intent(in) :: Nslip                              !< number of active slip systems per family
   character(len=*),                                intent(in) :: lattice                            !< Bravais lattice (Pearson symbol)
-  real(pReal),                                     intent(in) :: cOverA                             !< c/a ratio
-  real(pReal),     dimension(sum(Nslip),sum(Nslip))           :: projection
+  real(pREAL),                                     intent(in) :: cOverA                             !< c/a ratio
+  real(pREAL),     dimension(sum(Nslip),sum(Nslip))           :: projection
 
-  real(pReal), dimension(3,sum(Nslip)) :: n, t
+  real(pREAL), dimension(3,sum(Nslip)) :: n, t
   integer                              :: i, j
 
   n = lattice_slip_normal    (Nslip,lattice,cOverA)
@@ -1796,10 +1796,10 @@ function slipProjection_direction(Nslip,lattice,cOverA) result(projection)
 
   integer,         dimension(:),                   intent(in) :: Nslip                              !< number of active slip systems per family
   character(len=*),                                intent(in) :: lattice                            !< Bravais lattice (Pearson symbol)
-  real(pReal),                                     intent(in) :: cOverA                             !< c/a ratio
-  real(pReal),     dimension(sum(Nslip),sum(Nslip))           :: projection
+  real(pREAL),                                     intent(in) :: cOverA                             !< c/a ratio
+  real(pREAL),     dimension(sum(Nslip),sum(Nslip))           :: projection
 
-  real(pReal), dimension(3,sum(Nslip)) :: n, d
+  real(pREAL), dimension(3,sum(Nslip)) :: n, d
   integer                              :: i, j
 
   n = lattice_slip_normal   (Nslip,lattice,cOverA)
@@ -1820,10 +1820,10 @@ function coordinateSystem_slip(Nslip,lattice,cOverA) result(coordinateSystem)
 
   integer,          dimension(:),            intent(in) :: Nslip                                    !< number of active slip systems per family
   character(len=*),                          intent(in) :: lattice                                  !< Bravais lattice (Pearson symbol)
-  real(pReal),                               intent(in) :: cOverA                                   !< c/a ratio
-  real(pReal),     dimension(3,3,sum(Nslip))            :: coordinateSystem
+  real(pREAL),                               intent(in) :: cOverA                                   !< c/a ratio
+  real(pREAL),     dimension(3,3,sum(Nslip))            :: coordinateSystem
 
-  real(pReal), dimension(:,:), allocatable :: slipSystems
+  real(pREAL), dimension(:,:), allocatable :: slipSystems
   integer,     dimension(:),   allocatable :: NslipMax
 
   select case(lattice)
@@ -1864,9 +1864,9 @@ function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,valu
     acting_used, &                                                                                  !< # of   acting systems per family as specified in material.config
     reacting_max, &                                                                                 !< max # of reacting systems per family for given lattice
     acting_max                                                                                      !< max # of   acting systems per family for given lattice
-  real(pReal), dimension(:),                                 intent(in) :: values                   !< interaction values
+  real(pREAL), dimension(:),                                 intent(in) :: values                   !< interaction values
   integer,     dimension(:,:),                               intent(in) :: matrix                   !< interaction types
-  real(pReal), dimension(sum(reacting_used),sum(acting_used))           :: buildInteraction
+  real(pREAL), dimension(sum(reacting_used),sum(acting_used))           :: buildInteraction
 
   integer :: &
     acting_family_index,     acting_family,   acting_system, &
@@ -1906,16 +1906,16 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
   integer, dimension(:), intent(in) :: &
     active, &                                                                                       !< # of active systems per family
     potential                                                                                       !< # of potential systems per family
-  real(pReal), dimension(:,:), intent(in) :: &
+  real(pREAL), dimension(:,:), intent(in) :: &
     system
   character(len=*),            intent(in) :: &
     lattice                                                                                         !< Bravais lattice (Pearson symbol)
-  real(pReal),                 intent(in) :: &
+  real(pREAL),                 intent(in) :: &
     cOverA
-  real(pReal), dimension(3,3,sum(active)) :: &
+  real(pREAL), dimension(3,3,sum(active)) :: &
     buildCoordinateSystem
 
-  real(pReal), dimension(3) :: &
+  real(pREAL), dimension(3) :: &
     direction, normal
   integer :: &
     a, &                                                                                            !< index of active system
@@ -1923,9 +1923,9 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
     f, &                                                                                            !< index of my family
     s                                                                                               !< index of my system in current family
 
-  if (lattice == 'tI' .and. cOverA > 2.0_pReal) &
+  if (lattice == 'tI' .and. cOverA > 2.0_pREAL) &
     call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(lattice))
-  if (lattice == 'hP' .and. (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal)) &
+  if (lattice == 'hP' .and. (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL)) &
     call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(lattice))
 
   a = 0
@@ -1941,11 +1941,11 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
           normal    = system(4:6,p)
 
         case ('hP')
-          direction = [ system(1,p)*1.5_pReal, &
-                       (system(1,p)+2.0_pReal*system(2,p))*sqrt(0.75_pReal), &
+          direction = [ system(1,p)*1.5_pREAL, &
+                       (system(1,p)+2.0_pREAL*system(2,p))*sqrt(0.75_pREAL), &
                         system(4,p)*cOverA ]                                                        ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(p/a)])
           normal    = [ system(5,p), &
-                       (system(5,p)+2.0_pReal*system(6,p))/sqrt(3.0_pReal), &
+                       (system(5,p)+2.0_pREAL*system(6,p))/sqrt(3.0_pREAL), &
                         system(8,p)/cOverA ]                                                        ! plane (hkil)->(h (h+2k)/sqrt(3) l/(p/a))
 
         case default
@@ -1974,10 +1974,10 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
 
   integer,      dimension(:),               intent(in) :: &
     Ntrans
-  real(pReal),  dimension(3,3,sum(Ntrans)), intent(out) :: &
+  real(pREAL),  dimension(3,3,sum(Ntrans)), intent(out) :: &
     Q, &                                                                                            !< Total rotation: Q = R*B
     S                                                                                               !< Eigendeformation tensor for phase transformation
-  real(pReal),  optional,                   intent(in) :: &
+  real(pREAL),  optional,                   intent(in) :: &
     cOverA, &                                                                                       !< c/a for target hP lattice
     a_cF, &                                                                                         !< lattice parameter a for cF target lattice
     a_cI                                                                                            !< lattice parameter a for cI parent lattice
@@ -1985,14 +1985,14 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
   type(tRotation) :: &
     R, &                                                                                            !< Pitsch rotation
     B                                                                                               !< Rotation of cF to Bain coordinate system
-  real(pReal), dimension(3,3) :: &
+  real(pREAL), dimension(3,3) :: &
     U, &                                                                                            !< Bain deformation
     ss, sd
-  real(pReal), dimension(3) :: &
+  real(pREAL), dimension(3) :: &
     x, y, z
   integer :: &
     i
-  real(pReal), dimension(3+3,CF_NTRANS), parameter :: &
+  real(pREAL), dimension(3+3,CF_NTRANS), parameter :: &
     CFTOHP_SYSTEMTRANS = reshape(real( [&
       -2, 1, 1,     1, 1, 1, &
        1,-2, 1,     1, 1, 1, &
@@ -2006,9 +2006,9 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
        2, 1,-1,    -1, 1,-1, &
       -1,-2,-1,    -1, 1,-1, &
       -1, 1, 2,    -1, 1,-1  &
-      ],pReal),shape(CFTOHP_SYSTEMTRANS))
+      ],pREAL),shape(CFTOHP_SYSTEMTRANS))
 
-  real(pReal), dimension(4,cF_Ntrans), parameter :: &
+  real(pREAL), dimension(4,cF_Ntrans), parameter :: &
     CFTOCI_SYSTEMTRANS = real(reshape([&
       0.0, 1.0, 0.0,     10.26, &                                                                   ! Pitsch OR (Ma & Hartmaier 2014, Table 3)
       0.0,-1.0, 0.0,     10.26, &
@@ -2022,7 +2022,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
      -1.0, 0.0, 0.0,     10.26, &
       0.0, 1.0, 0.0,     10.26, &
       0.0,-1.0, 0.0,     10.26  &
-      ],shape(CFTOCI_SYSTEMTRANS)),pReal)
+      ],shape(CFTOCI_SYSTEMTRANS)),pREAL)
 
   integer, dimension(9,cF_Ntrans), parameter :: &
     CFTOCI_BAINVARIANT = reshape( [&
@@ -2040,7 +2040,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
       0, 0, 1, 1, 0, 0, 0, 1, 0  &
       ],shape(CFTOCI_BAINVARIANT))
 
-  real(pReal), dimension(4,cF_Ntrans), parameter :: &
+  real(pREAL), dimension(4,cF_Ntrans), parameter :: &
     CFTOCI_BAINROT = real(reshape([&
       1.0, 0.0, 0.0,     45.0, &                                                                    ! Rotate cF austensite to bain variant
       1.0, 0.0, 0.0,     45.0, &
@@ -2054,25 +2054,25 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
       0.0, 0.0, 1.0,     45.0, &
       0.0, 0.0, 1.0,     45.0, &
       0.0, 0.0, 1.0,     45.0  &
-      ],shape(CFTOCI_BAINROT)),pReal)
+      ],shape(CFTOCI_BAINROT)),pREAL)
 
   if (present(a_cI) .and. present(a_cF)) then
     do i = 1,sum(Ntrans)
       call R%fromAxisAngle(CFTOCI_SYSTEMTRANS(:,i),degrees=.true.,P=1)
       call B%fromAxisAngle(CFTOCI_BAINROT(:,i),    degrees=.true.,P=1)
-      x = real(CFTOCI_BAINVARIANT(1:3,i),pReal)
-      y = real(CFTOCI_BAINVARIANT(4:6,i),pReal)
-      z = real(CFTOCI_BAINVARIANT(7:9,i),pReal)
+      x = real(CFTOCI_BAINVARIANT(1:3,i),pREAL)
+      y = real(CFTOCI_BAINVARIANT(4:6,i),pREAL)
+      z = real(CFTOCI_BAINVARIANT(7:9,i),pREAL)
 
-      U = (a_cI/a_cF) * (math_outer(x,x) + (math_outer(y,y)+math_outer(z,z)) * sqrt(2.0_pReal))
+      U = (a_cI/a_cF) * (math_outer(x,x) + (math_outer(y,y)+math_outer(z,z)) * sqrt(2.0_pREAL))
       Q(1:3,1:3,i) = matmul(R%asMatrix(),B%asMatrix())
       S(1:3,1:3,i) = matmul(R%asMatrix(),U) - MATH_I3
     end do
   else if (present(cOverA)) then
     ss      = MATH_I3
     sd      = MATH_I3
-    ss(1,3) = sqrt(2.0_pReal)/4.0_pReal
-    sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal)
+    ss(1,3) = sqrt(2.0_pREAL)/4.0_pREAL
+    sd(3,3) = cOverA/sqrt(8.0_pREAL/3.0_pREAL)
 
     do i = 1,sum(Ntrans)
       x = CFTOHP_SYSTEMTRANS(1:3,i)/norm2(CFTOHP_SYSTEMTRANS(1:3,i))
@@ -2098,7 +2098,7 @@ function getlabels(active,potential,system) result(labels)
   integer,          dimension(:),   intent(in) :: &
     active, &                                                                                       !< # of active systems per family
     potential                                                                                       !< # of potential systems per family
-  real(pReal),      dimension(:,:), intent(in) :: &
+  real(pREAL),      dimension(:,:), intent(in) :: &
     system
 
   character(len=:), dimension(:), allocatable :: labels
@@ -2152,28 +2152,28 @@ end function getlabels
 !--------------------------------------------------------------------------------------------------
 pure function lattice_isotropic_nu(C,assumption,lattice) result(nu)
 
-  real(pReal), dimension(6,6), intent(in) :: C                                                      !< Stiffness tensor (Voigt notation)
+  real(pREAL), dimension(6,6), intent(in) :: C                                                      !< Stiffness tensor (Voigt notation)
   character(len=*),            intent(in) :: assumption                                             !< Assumption (isostrain = 'Voigt', isostress = 'Reuss')
   character(len=*), optional,  intent(in) :: lattice
-  real(pReal) :: nu
+  real(pREAL) :: nu
 
-  real(pReal) :: K, mu
+  real(pREAL) :: K, mu
   logical                       :: error
-  real(pReal), dimension(6,6)   :: S
+  real(pREAL), dimension(6,6)   :: S
 
 
   if     (IO_lc(assumption) == 'isostrain') then
-    K = sum(C(1:3,1:3)) / 9.0_pReal
+    K = sum(C(1:3,1:3)) / 9.0_pREAL
   elseif (IO_lc(assumption) == 'isostress') then
     call math_invert(S,error,C)
     if (error) error stop 'matrix inversion failed'
-    K = 1.0_pReal / sum(S(1:3,1:3))
+    K = 1.0_pREAL / sum(S(1:3,1:3))
   else
     error stop 'invalid assumption'
   end if
 
   mu = lattice_isotropic_mu(C,assumption,lattice)
-  nu = (1.5_pReal*K-mu)/(3.0_pReal*K+mu)
+  nu = (1.5_pREAL*K-mu)/(3.0_pREAL*K+mu)
 
 end function lattice_isotropic_nu
 
@@ -2185,36 +2185,36 @@ end function lattice_isotropic_nu
 !--------------------------------------------------------------------------------------------------
 pure function lattice_isotropic_mu(C,assumption,lattice) result(mu)
 
-  real(pReal), dimension(6,6), intent(in) :: C                                                      !< Stiffness tensor (Voigt notation)
+  real(pREAL), dimension(6,6), intent(in) :: C                                                      !< Stiffness tensor (Voigt notation)
   character(len=*),            intent(in) :: assumption                                             !< Assumption (isostrain = 'Voigt', isostress = 'Reuss')
   character(len=*), optional,  intent(in) :: lattice
-  real(pReal) :: mu
+  real(pREAL) :: mu
 
   logical                       :: error
-  real(pReal), dimension(6,6)   :: S
+  real(pREAL), dimension(6,6)   :: S
 
 
   if     (IO_lc(assumption) == 'isostrain') then
       select case(misc_optional(lattice,''))
         case('cF','cI')
-          mu = ( C(1,1) - C(1,2) + C(4,4)*3.0_pReal) / 5.0_pReal
+          mu = ( C(1,1) - C(1,2) + C(4,4)*3.0_pREAL) / 5.0_pREAL
         case default
           mu = (  C(1,1)+C(2,2)+C(3,3) &
                 - C(1,2)-C(2,3)-C(1,3) &
-                +(C(4,4)+C(5,5)+C(6,6)) * 3.0_pReal &
-               ) / 15.0_pReal
+                +(C(4,4)+C(5,5)+C(6,6)) * 3.0_pREAL &
+               ) / 15.0_pREAL
       end select
 
   elseif (IO_lc(assumption) == 'isostress') then
       select case(misc_optional(lattice,''))
         case('cF','cI')
-          mu = 5.0_pReal &
-               / (4.0_pReal/(C(1,1)-C(1,2)) + 3.0_pReal/C(4,4))
+          mu = 5.0_pREAL &
+               / (4.0_pREAL/(C(1,1)-C(1,2)) + 3.0_pREAL/C(4,4))
         case default
           call math_invert(S,error,C)
           if (error) error stop 'matrix inversion failed'
-          mu = 15.0_pReal &
-              / (4.0_pReal*(S(1,1)+S(2,2)+S(3,3)-S(1,2)-S(2,3)-S(1,3)) + 3.0_pReal*(S(4,4)+S(5,5)+S(6,6)))
+          mu = 15.0_pREAL &
+              / (4.0_pREAL*(S(1,1)+S(2,2)+S(3,3)-S(1,2)-S(2,3)-S(1,3)) + 3.0_pREAL*(S(4,4)+S(5,5)+S(6,6)))
       end select
   else
     error stop 'invalid assumption'
@@ -2228,20 +2228,20 @@ end function lattice_isotropic_mu
 !--------------------------------------------------------------------------------------------------
 subroutine selfTest
 
-  real(pReal), dimension(:,:,:), allocatable :: CoSy
-  real(pReal), dimension(:,:),   allocatable :: system
+  real(pREAL), dimension(:,:,:), allocatable :: CoSy
+  real(pREAL), dimension(:,:),   allocatable :: system
 
-  real(pReal), dimension(6,6) :: C, C_cF, C_cI, C_hP, C_tI
-  real(pReal), dimension(3,3) :: T, T_cF, T_cI, T_hP, T_tI
-  real(pReal), dimension(2)   :: r
-  real(pReal) :: lambda
+  real(pREAL), dimension(6,6) :: C, C_cF, C_cI, C_hP, C_tI
+  real(pREAL), dimension(3,3) :: T, T_cF, T_cI, T_hP, T_tI
+  real(pREAL), dimension(2)   :: r
+  real(pREAL) :: lambda
   integer     :: i
 
 
   call random_number(r)
 
-  system = reshape([1.0_pReal+r(1),0.0_pReal,0.0_pReal, 0.0_pReal,1.0_pReal+r(2),0.0_pReal],[6,1])
-  CoSy   = buildCoordinateSystem([1],[1],system,'cF',0.0_pReal)
+  system = reshape([1.0_pREAL+r(1),0.0_pREAL,0.0_pREAL, 0.0_pREAL,1.0_pREAL+r(2),0.0_pREAL],[6,1])
+  CoSy   = buildCoordinateSystem([1],[1],system,'cF',0.0_pREAL)
   if (any(dNeq(CoSy(1:3,1:3,1),math_I3))) error stop 'buildCoordinateSystem'
 
   do i = 1, 10
@@ -2274,9 +2274,9 @@ subroutine selfTest
     T_hP = lattice_symmetrize_33(T,'hP')
     T_tI = lattice_symmetrize_33(T,'tI')
 
-    if (any(dNeq0(T_cF) .and. math_I3<1.0_pReal))          error stop 'Symmetry33/c'
-    if (any(dNeq0(T_hP) .and. math_I3<1.0_pReal))          error stop 'Symmetry33/hP'
-    if (any(dNeq0(T_tI) .and. math_I3<1.0_pReal))          error stop 'Symmetry33/tI'
+    if (any(dNeq0(T_cF) .and. math_I3<1.0_pREAL))          error stop 'Symmetry33/c'
+    if (any(dNeq0(T_hP) .and. math_I3<1.0_pREAL))          error stop 'Symmetry33/hP'
+    if (any(dNeq0(T_tI) .and. math_I3<1.0_pREAL))          error stop 'Symmetry33/tI'
 
     if (any(dNeq(T(1,1),[T_cI(1,1),T_cI(2,2),T_cI(3,3)]))) error stop 'Symmetry33_11-22-33/c'
     if (any(dNeq(T(1,1),[T_hP(1,1),T_hP(2,2)])))           error stop 'Symmetry33_11-22/hP'
@@ -2285,52 +2285,52 @@ subroutine selfTest
   end do
 
   call random_number(C)
-  C(1,1) = C(1,1) + C(1,2) + 0.1_pReal
+  C(1,1) = C(1,1) + C(1,2) + 0.1_pREAL
   C(1,3) = C(1,2)
   C(3,3) = C(1,1)
-  C(4,4) = 0.5_pReal * (C(1,1) - C(1,2))
+  C(4,4) = 0.5_pREAL * (C(1,1) - C(1,2))
   C(6,6) = C(4,4)
 
   C_cI = lattice_symmetrize_C66(C,'cI')
-  if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostrain','cI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostrain/cI'
-  if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostress','cI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostress/cI'
+  if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/cI'
+  if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/cI'
 
   lambda = C_cI(1,2)
-  if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_cI,'isostrain','cI')), &
-          lattice_isotropic_nu(C_cI,'isostrain','cI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostrain/cI'
-  if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_cI,'isostress','cI')), &
-          lattice_isotropic_nu(C_cI,'isostress','cI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostress/cI'
+  if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_cI,'isostrain','cI')), &
+          lattice_isotropic_nu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/cI'
+  if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_cI,'isostress','cI')), &
+          lattice_isotropic_nu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/cI'
 
 
   C_hP = lattice_symmetrize_C66(C,'hP')
-  if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostrain','hP'),1.0e-12_pReal)) error stop 'isotropic_mu/isostrain/hP'
-  if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostress','hP'),1.0e-12_pReal)) error stop 'isotropic_mu/isostress/hP'
+  if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/hP'
+  if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/hP'
 
   lambda = C_hP(1,2)
-  if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_hP,'isostrain','hP')), &
-          lattice_isotropic_nu(C_hP,'isostrain','hP'),1.0e-12_pReal)) error stop 'isotropic_nu/isostrain/hP'
-  if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_hP,'isostress','hP')), &
-          lattice_isotropic_nu(C_hP,'isostress','hP'),1.0e-12_pReal)) error stop 'isotropic_nu/isostress/hP'
+  if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_hP,'isostrain','hP')), &
+          lattice_isotropic_nu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/hP'
+  if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_hP,'isostress','hP')), &
+          lattice_isotropic_nu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/hP'
 
   C_tI = lattice_symmetrize_C66(C,'tI')
-  if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostrain','tI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostrain/tI'
-  if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostress','tI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostress/tI'
+  if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/tI'
+  if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/tI'
 
   lambda = C_tI(1,2)
-  if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_tI,'isostrain','tI')), &
-          lattice_isotropic_nu(C_tI,'isostrain','tI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostrain/tI'
-  if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_tI,'isostress','tI')), &
-          lattice_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostress/tI'
+  if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_tI,'isostrain','tI')), &
+          lattice_isotropic_nu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/tI'
+  if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_tI,'isostress','tI')), &
+          lattice_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/tI'
 
   call random_number(C)
   C = lattice_symmetrize_C66(C+math_eye(6),'cI')
-  if (dNeq(lattice_isotropic_mu(C,'isostrain','cI'), lattice_isotropic_mu(C,'isostrain','hP'), 1.0e-12_pReal)) &
+  if (dNeq(lattice_isotropic_mu(C,'isostrain','cI'), lattice_isotropic_mu(C,'isostrain','hP'), 1.0e-12_pREAL)) &
     error stop 'isotropic_mu/isostrain/cI-hP'
-  if (dNeq(lattice_isotropic_nu(C,'isostrain','cF'), lattice_isotropic_nu(C,'isostrain','cI'), 1.0e-12_pReal)) &
+  if (dNeq(lattice_isotropic_nu(C,'isostrain','cF'), lattice_isotropic_nu(C,'isostrain','cI'), 1.0e-12_pREAL)) &
     error stop 'isotropic_nu/isostrain/cF-tI'
-  if (dNeq(lattice_isotropic_mu(C,'isostress','cI'), lattice_isotropic_mu(C,'isostress'), 1.0e-12_pReal)) &
+  if (dNeq(lattice_isotropic_mu(C,'isostress','cI'), lattice_isotropic_mu(C,'isostress'), 1.0e-12_pREAL)) &
     error stop 'isotropic_mu/isostress/cI-hP'
-  if (dNeq(lattice_isotropic_nu(C,'isostress','cF'), lattice_isotropic_nu(C,'isostress'), 1.0e-12_pReal)) &
+  if (dNeq(lattice_isotropic_nu(C,'isostress','cF'), lattice_isotropic_nu(C,'isostress'), 1.0e-12_pREAL)) &
     error stop 'isotropic_nu/isostress/cF-tI'
 
 end subroutine selfTest

src/material.f90

@@ -22,7 +22,7 @@ module material
   end type tRotationContainer
 
   type, public :: tTensorContainer
-    real(pReal), dimension(:,:,:), allocatable :: data
+    real(pREAL), dimension(:,:,:), allocatable :: data
   end type tTensorContainer
 
 
@@ -45,7 +45,7 @@ module material
     material_ID_phase, &                                                                            !< Number of the phase
     material_entry_phase                                                                            !< Position in array of used phase
 
-  real(pReal), dimension(:,:), allocatable, public, protected :: &
+  real(pREAL), dimension(:,:), allocatable, public, protected :: &
     material_v                                                                                      ! fraction
 
   public :: &
@@ -97,9 +97,9 @@ subroutine parse()
     counterHomogenization, &
     ho_of
   integer, dimension(:,:), allocatable :: ph_of
-  real(pReal), dimension(:,:), allocatable :: v_of
+  real(pREAL), dimension(:,:), allocatable :: v_of
 
-  real(pReal) :: v
+  real(pREAL) :: v
   integer :: &
     el, ip, &
     ho, ph, &
@@ -125,14 +125,14 @@ subroutine parse()
   end do
   homogenization_maxNconstituents = maxval(homogenization_Nconstituents)
 
-  allocate(material_v(homogenization_maxNconstituents,discretization_Ncells),source=0.0_pReal)
+  allocate(material_v(homogenization_maxNconstituents,discretization_Ncells),source=0.0_pREAL)
 
   allocate(material_O_0(materials%length))
   allocate(material_V_e_0(materials%length))
 
   allocate(ho_of(materials%length))
   allocate(ph_of(materials%length,homogenization_maxNconstituents),source=-1)
-  allocate( v_of(materials%length,homogenization_maxNconstituents),source=0.0_pReal)
+  allocate( v_of(materials%length,homogenization_maxNconstituents),source=0.0_pREAL)
 
   ! Parse YAML structure. Manual loop over linked list to have O(n) instead of O(n^2) complexity
   item => materials%first
@@ -158,7 +158,7 @@ subroutine parse()
         call IO_error(147)
 
     end do
-    if (dNeq(sum(v_of(ma,:)),1.0_pReal,1.e-9_pReal)) call IO_error(153,ext_msg='constituent')
+    if (dNeq(sum(v_of(ma,:)),1.0_pREAL,1.e-9_pREAL)) call IO_error(153,ext_msg='constituent')
 
     item => item%next
   end do

src/materialpoint.f90

@@ -141,7 +141,7 @@ end subroutine materialpoint_forward
 subroutine materialpoint_result(inc,time)
 
   integer,     intent(in) :: inc
-  real(pReal), intent(in) :: time
+  real(pREAL), intent(in) :: time
 
   call result_openJobFile()
   call result_addIncrement(inc,time)

src/math.f90

@@ -31,24 +31,24 @@ module math
     config
 #endif
 
-  real(pReal), parameter :: &
-    PI = acos(-1.0_pReal), &                                                                        !< ratio of a circle's circumference to its diameter
-    TAU = 2.0_pReal*PI, &                                                                           !< ratio of a circle's circumference to its radius
-    INDEG = 360.0_pReal/TAU, &                                                                      !< conversion from radian to degree
-    INRAD = TAU/360.0_pReal                                                                         !< conversion from degree to radian
+  real(pREAL), parameter :: &
+    PI = acos(-1.0_pREAL), &                                                                        !< ratio of a circle's circumference to its diameter
+    TAU = 2.0_pREAL*PI, &                                                                           !< ratio of a circle's circumference to its radius
+    INDEG = 360.0_pREAL/TAU, &                                                                      !< conversion from radian to degree
+    INRAD = TAU/360.0_pREAL                                                                         !< conversion from degree to radian
 
-  real(pReal), dimension(3,3), parameter :: &
+  real(pREAL), dimension(3,3), parameter :: &
     math_I3 = reshape([&
-      1.0_pReal,0.0_pReal,0.0_pReal, &
-      0.0_pReal,1.0_pReal,0.0_pReal, &
-      0.0_pReal,0.0_pReal,1.0_pReal  &
+      1.0_pREAL,0.0_pREAL,0.0_pREAL, &
+      0.0_pREAL,1.0_pREAL,0.0_pREAL, &
+      0.0_pREAL,0.0_pREAL,1.0_pREAL  &
       ],shape(math_I3))                                                                             !< 3x3 Identity
 
-  real(pReal), dimension(*), parameter, private :: &
-    NRMMANDEL = [1.0_pReal, 1.0_pReal,1.0_pReal, sqrt(2.0_pReal), sqrt(2.0_pReal), sqrt(2.0_pReal)] !< forward weighting for Mandel notation
+  real(pREAL), dimension(*), parameter, private :: &
+    NRMMANDEL = [1.0_pREAL, 1.0_pREAL,1.0_pREAL, sqrt(2.0_pREAL), sqrt(2.0_pREAL), sqrt(2.0_pREAL)] !< forward weighting for Mandel notation
 
-  real(pReal), dimension(*), parameter, private :: &
-    INVNRMMANDEL = 1.0_pReal/NRMMANDEL                                                              !< backward weighting for Mandel notation
+  real(pREAL), dimension(*), parameter, private :: &
+    INVNRMMANDEL = 1.0_pREAL/NRMMANDEL                                                              !< backward weighting for Mandel notation
 
   integer, dimension (2,6), parameter, private :: &
     MAPNYE = reshape([&
@@ -94,7 +94,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine math_init()
 
-  real(pReal), dimension(4) :: randTest
+  real(pREAL), dimension(4) :: randTest
   integer :: randSize
   integer, dimension(:), allocatable :: seed
   type(tDict), pointer :: &
@@ -201,9 +201,9 @@ end subroutine math_sort
 !--------------------------------------------------------------------------------------------------
 pure function math_expand(what,how)
 
-  real(pReal),   dimension(:), intent(in) :: what
+  real(pREAL),   dimension(:), intent(in) :: what
   integer,       dimension(:), intent(in) :: how
-  real(pReal), dimension(sum(how)) ::  math_expand
+  real(pREAL), dimension(sum(how)) ::  math_expand
 
   integer :: i
 
@@ -239,14 +239,14 @@ end function math_range
 pure function math_eye(d)
 
   integer, intent(in) :: d                                                                          !< tensor dimension
-  real(pReal), dimension(d,d) :: math_eye
+  real(pREAL), dimension(d,d) :: math_eye
 
   integer :: i
 
 
-  math_eye = 0.0_pReal
+  math_eye = 0.0_pREAL
   do i=1,d
-    math_eye(i,i) = 1.0_pReal
+    math_eye(i,i) = 1.0_pREAL
   end do
 
 end function math_eye
@@ -258,18 +258,18 @@ end function math_eye
 !--------------------------------------------------------------------------------------------------
 pure function math_identity4th()
 
-  real(pReal), dimension(3,3,3,3) :: math_identity4th
+  real(pREAL), dimension(3,3,3,3) :: math_identity4th
 
   integer :: i,j,k,l
 
 
 #ifndef __INTEL_COMPILER
   do concurrent(i=1:3, j=1:3, k=1:3, l=1:3)
-    math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
+    math_identity4th(i,j,k,l) = 0.5_pREAL*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
   end do
 #else
   forall(i=1:3, j=1:3, k=1:3, l=1:3) &
-    math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
+    math_identity4th(i,j,k,l) = 0.5_pREAL*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
 #endif
 
 end function math_identity4th
@@ -281,7 +281,7 @@ end function math_identity4th
 ! e_ijk = -1 if odd permutation of ijk
 ! e_ijk =  0 otherwise
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_LeviCivita(i,j,k)
+real(pREAL) pure function math_LeviCivita(i,j,k)
 
   integer, intent(in) :: i,j,k
 
@@ -289,11 +289,11 @@ real(pReal) pure function math_LeviCivita(i,j,k)
 
 
   if     (any([(all(cshift([i,j,k],o) == [1,2,3]),o=0,2)])) then
-    math_LeviCivita = +1.0_pReal
+    math_LeviCivita = +1.0_pREAL
   elseif (any([(all(cshift([i,j,k],o) == [3,2,1]),o=0,2)])) then
-    math_LeviCivita = -1.0_pReal
+    math_LeviCivita = -1.0_pREAL
   else
-    math_LeviCivita =  0.0_pReal
+    math_LeviCivita =  0.0_pREAL
   end if
 
 end function math_LeviCivita
@@ -304,12 +304,12 @@ end function math_LeviCivita
 ! d_ij = 1 if i = j
 ! d_ij = 0 otherwise
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_delta(i,j)
+real(pREAL) pure function math_delta(i,j)
 
   integer, intent (in) :: i,j
 
 
-  math_delta = merge(0.0_pReal, 1.0_pReal, i /= j)
+  math_delta = merge(0.0_pREAL, 1.0_pREAL, i /= j)
 
 end function math_delta
 
@@ -319,8 +319,8 @@ end function math_delta
 !--------------------------------------------------------------------------------------------------
 pure function math_cross(A,B)
 
-  real(pReal), dimension(3), intent(in) ::  A,B
-  real(pReal), dimension(3) :: math_cross
+  real(pREAL), dimension(3), intent(in) ::  A,B
+  real(pREAL), dimension(3) :: math_cross
 
 
   math_cross = [ A(2)*B(3) -A(3)*B(2), &
@@ -335,8 +335,8 @@ end function math_cross
 !--------------------------------------------------------------------------------------------------
 pure function math_outer(A,B)
 
-  real(pReal), dimension(:), intent(in) ::  A,B
-  real(pReal), dimension(size(A,1),size(B,1)) ::  math_outer
+  real(pREAL), dimension(:), intent(in) ::  A,B
+  real(pREAL), dimension(size(A,1),size(B,1)) ::  math_outer
 
   integer :: i,j
 
@@ -355,10 +355,10 @@ end function math_outer
 !--------------------------------------------------------------------------------------------------
 !> @brief inner product of arbitrary sized vectors (A · B / i,i)
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_inner(A,B)
+real(pREAL) pure function math_inner(A,B)
 
-  real(pReal), dimension(:),         intent(in) :: A
-  real(pReal), dimension(size(A,1)), intent(in) :: B
+  real(pREAL), dimension(:),         intent(in) :: A
+  real(pREAL), dimension(size(A,1)), intent(in) :: B
 
 
   math_inner = sum(A*B)
@@ -369,9 +369,9 @@ end function math_inner
 !--------------------------------------------------------------------------------------------------
 !> @brief double contraction of 3x3 matrices (A : B / ij,ij)
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_tensordot(A,B)
+real(pREAL) pure function math_tensordot(A,B)
 
-  real(pReal), dimension(3,3), intent(in) :: A,B
+  real(pREAL), dimension(3,3), intent(in) :: A,B
 
 
   math_tensordot = sum(A*B)
@@ -384,9 +384,9 @@ end function math_tensordot
 !--------------------------------------------------------------------------------------------------
 pure function math_mul3333xx33(A,B)
 
-  real(pReal), dimension(3,3,3,3), intent(in) :: A
-  real(pReal), dimension(3,3),     intent(in) :: B
-  real(pReal), dimension(3,3) :: math_mul3333xx33
+  real(pREAL), dimension(3,3,3,3), intent(in) :: A
+  real(pREAL), dimension(3,3),     intent(in) :: B
+  real(pREAL), dimension(3,3) :: math_mul3333xx33
 
   integer :: i,j
 
@@ -407,9 +407,9 @@ end function math_mul3333xx33
 !--------------------------------------------------------------------------------------------------
 pure function math_mul3333xx3333(A,B)
 
-  real(pReal), dimension(3,3,3,3), intent(in) :: A
-  real(pReal), dimension(3,3,3,3), intent(in) :: B
-  real(pReal), dimension(3,3,3,3) :: math_mul3333xx3333
+  real(pREAL), dimension(3,3,3,3), intent(in) :: A
+  real(pREAL), dimension(3,3,3,3), intent(in) :: B
+  real(pREAL), dimension(3,3,3,3) :: math_mul3333xx3333
 
   integer :: i,j,k,l
 
@@ -430,20 +430,20 @@ end function math_mul3333xx3333
 !--------------------------------------------------------------------------------------------------
 pure function math_exp33(A,n)
 
-  real(pReal), dimension(3,3), intent(in) :: A
+  real(pREAL), dimension(3,3), intent(in) :: A
   integer,                     intent(in), optional :: n
-  real(pReal), dimension(3,3) :: B, math_exp33
+  real(pREAL), dimension(3,3) :: B, math_exp33
 
-  real(pReal) :: invFac
+  real(pREAL) :: invFac
   integer     :: i
 
 
-  invFac     = 1.0_pReal                                                                            ! 0!
+  invFac     = 1.0_pREAL                                                                            ! 0!
   B          = math_I3
   math_exp33 = math_I3                                                                              ! A^0 = I
 
   do i = 1, misc_optional(n,5)
-    invFac = invFac/real(i,pReal)                                                                   ! invfac = 1/(i!)
+    invFac = invFac/real(i,pREAL)                                                                   ! invfac = 1/(i!)
     B = matmul(B,A)
     math_exp33 = math_exp33 + invFac*B                                                              ! exp = SUM (A^i)/(i!)
   end do
@@ -458,15 +458,15 @@ end function math_exp33
 !--------------------------------------------------------------------------------------------------
 pure function math_inv33(A)
 
-  real(pReal), dimension(3,3), intent(in) :: A
-  real(pReal), dimension(3,3) :: math_inv33
+  real(pREAL), dimension(3,3), intent(in) :: A
+  real(pREAL), dimension(3,3) :: math_inv33
 
-  real(pReal) :: DetA
+  real(pREAL) :: DetA
   logical     :: error
 
 
   call math_invert33(math_inv33,DetA,error,A)
-  if (error) math_inv33 = 0.0_pReal
+  if (error) math_inv33 = 0.0_pREAL
 
 end function math_inv33
 
@@ -478,12 +478,12 @@ end function math_inv33
 !--------------------------------------------------------------------------------------------------
 pure subroutine math_invert33(InvA,DetA,error, A)
 
-  real(pReal), dimension(3,3), intent(out) :: InvA
-  real(pReal),                 intent(out), optional :: DetA
+  real(pREAL), dimension(3,3), intent(out) :: InvA
+  real(pREAL),                 intent(out), optional :: DetA
   logical,                     intent(out) :: error
-  real(pReal), dimension(3,3), intent(in)  :: A
+  real(pREAL), dimension(3,3), intent(in)  :: A
 
-  real(pReal) :: Det
+  real(pREAL) :: Det
 
 
   InvA(1,1) =  A(2,2) * A(3,3) - A(2,3) * A(3,2)
@@ -493,8 +493,8 @@ pure subroutine math_invert33(InvA,DetA,error, A)
   Det = A(1,1) * InvA(1,1) + A(1,2) * InvA(2,1) + A(1,3) * InvA(3,1)
 
   if (dEq0(Det)) then
-    InvA = 0.0_pReal
-    if (present(DetA)) DetA = 0.0_pReal
+    InvA = 0.0_pREAL
+    if (present(DetA)) DetA = 0.0_pREAL
     error = .true.
   else
     InvA(1,2) = -A(1,2) * A(3,3) + A(1,3) * A(3,2)
@@ -518,13 +518,13 @@ end subroutine math_invert33
 !--------------------------------------------------------------------------------------------------
 pure function math_invSym3333(A)
 
-  real(pReal),dimension(3,3,3,3) :: math_invSym3333
+  real(pREAL),dimension(3,3,3,3) :: math_invSym3333
 
-  real(pReal),dimension(3,3,3,3),intent(in) :: A
+  real(pREAL),dimension(3,3,3,3),intent(in) :: A
 
   integer,     dimension(6)   :: ipiv6
-  real(pReal), dimension(6,6) :: temp66
-  real(pReal), dimension(6*6) :: work
+  real(pREAL), dimension(6,6) :: temp66
+  real(pREAL), dimension(6*6) :: work
   integer                     :: ierr_i, ierr_f
 
 
@@ -545,12 +545,12 @@ end function math_invSym3333
 !--------------------------------------------------------------------------------------------------
 pure subroutine math_invert(InvA, error, A)
 
-  real(pReal), dimension(:,:),                 intent(in)  :: A
-  real(pReal), dimension(size(A,1),size(A,1)), intent(out) :: invA
+  real(pREAL), dimension(:,:),                 intent(in)  :: A
+  real(pREAL), dimension(size(A,1),size(A,1)), intent(out) :: invA
   logical,                                     intent(out) :: error
 
   integer,     dimension(size(A,1))    :: ipiv
-  real(pReal), dimension(size(A,1)**2) :: work
+  real(pREAL), dimension(size(A,1)**2) :: work
   integer                              :: ierr
 
 
@@ -568,11 +568,11 @@ end subroutine math_invert
 !--------------------------------------------------------------------------------------------------
 pure function math_symmetric33(m)
 
-  real(pReal), dimension(3,3) :: math_symmetric33
-  real(pReal), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3,3) :: math_symmetric33
+  real(pREAL), dimension(3,3), intent(in) :: m
 
 
-  math_symmetric33 = 0.5_pReal * (m + transpose(m))
+  math_symmetric33 = 0.5_pREAL * (m + transpose(m))
 
 end function math_symmetric33
 
@@ -582,8 +582,8 @@ end function math_symmetric33
 !--------------------------------------------------------------------------------------------------
 pure function math_skew33(m)
 
-  real(pReal), dimension(3,3) :: math_skew33
-  real(pReal), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3,3) :: math_skew33
+  real(pREAL), dimension(3,3), intent(in) :: m
 
 
   math_skew33 = m - math_symmetric33(m)
@@ -596,11 +596,11 @@ end function math_skew33
 !--------------------------------------------------------------------------------------------------
 pure function math_spherical33(m)
 
-  real(pReal), dimension(3,3) :: math_spherical33
-  real(pReal), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3,3) :: math_spherical33
+  real(pREAL), dimension(3,3), intent(in) :: m
 
 
-  math_spherical33 = math_I3 * math_trace33(m)/3.0_pReal
+  math_spherical33 = math_I3 * math_trace33(m)/3.0_pREAL
 
 end function math_spherical33
 
@@ -610,8 +610,8 @@ end function math_spherical33
 !--------------------------------------------------------------------------------------------------
 pure function math_deviatoric33(m)
 
-  real(pReal), dimension(3,3) :: math_deviatoric33
-  real(pReal), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3,3) :: math_deviatoric33
+  real(pREAL), dimension(3,3), intent(in) :: m
 
 
   math_deviatoric33 = m - math_spherical33(m)
@@ -622,9 +622,9 @@ end function math_deviatoric33
 !--------------------------------------------------------------------------------------------------
 !> @brief Calculate trace of a 3x3 matrix.
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_trace33(m)
+real(pREAL) pure function math_trace33(m)
 
-  real(pReal), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3,3), intent(in) :: m
 
 
   math_trace33 = m(1,1) + m(2,2) + m(3,3)
@@ -635,9 +635,9 @@ end function math_trace33
 !--------------------------------------------------------------------------------------------------
 !> @brief Calculate determinant of a 3x3 matrix.
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_det33(m)
+real(pREAL) pure function math_det33(m)
 
-  real(pReal), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3,3), intent(in) :: m
 
 
   math_det33 = m(1,1)* (m(2,2)*m(3,3)-m(2,3)*m(3,2)) &
@@ -650,13 +650,13 @@ end function math_det33
 !--------------------------------------------------------------------------------------------------
 !> @brief Calculate determinant of a symmetric 3x3 matrix.
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_detSym33(m)
+real(pREAL) pure function math_detSym33(m)
 
-  real(pReal), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3,3), intent(in) :: m
 
 
   math_detSym33 = -(m(1,1)*m(2,3)**2 + m(2,2)*m(1,3)**2 + m(3,3)*m(1,2)**2) &
-                  + m(1,1)*m(2,2)*m(3,3) + 2.0_pReal * m(1,2)*m(1,3)*m(2,3)
+                  + m(1,1)*m(2,2)*m(3,3) + 2.0_pREAL * m(1,2)*m(1,3)*m(2,3)
 
 end function  math_detSym33
 
@@ -666,8 +666,8 @@ end function  math_detSym33
 !--------------------------------------------------------------------------------------------------
 pure function math_33to9(m33)
 
-  real(pReal), dimension(9)               :: math_33to9
-  real(pReal), dimension(3,3), intent(in) :: m33
+  real(pREAL), dimension(9)               :: math_33to9
+  real(pREAL), dimension(3,3), intent(in) :: m33
 
   integer :: i
 
@@ -682,8 +682,8 @@ end function math_33to9
 !--------------------------------------------------------------------------------------------------
 pure function math_9to33(v9)
 
-  real(pReal), dimension(3,3)           :: math_9to33
-  real(pReal), dimension(9), intent(in) :: v9
+  real(pREAL), dimension(3,3)           :: math_9to33
+  real(pREAL), dimension(9), intent(in) :: v9
 
   integer :: i
 
@@ -703,14 +703,14 @@ end function math_9to33
 !--------------------------------------------------------------------------------------------------
 pure function math_sym33to6(m33,weighted)
 
-  real(pReal), dimension(6)               :: math_sym33to6
-  real(pReal), dimension(3,3), intent(in) :: m33                                                    !< symmetric 3x3 matrix (no internal check)
+  real(pREAL), dimension(6)               :: math_sym33to6
+  real(pREAL), dimension(3,3), intent(in) :: m33                                                    !< symmetric 3x3 matrix (no internal check)
   logical,     optional,       intent(in) :: weighted                                               !< weight according to Mandel (.true. by default)
 
-  real(pReal), dimension(6) :: w
+  real(pREAL), dimension(6) :: w
   integer :: i
 
-  w = merge(NRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+  w = merge(NRMMANDEL,1.0_pREAL,misc_optional(weighted,.true.))
 
   math_sym33to6 = [(w(i)*m33(MAPNYE(1,i),MAPNYE(2,i)),i=1,6)]
 
@@ -725,15 +725,15 @@ end function math_sym33to6
 !--------------------------------------------------------------------------------------------------
 pure function math_6toSym33(v6,weighted)
 
-  real(pReal), dimension(3,3)           :: math_6toSym33
-  real(pReal), dimension(6), intent(in) :: v6                                                       !< 6 vector
+  real(pREAL), dimension(3,3)           :: math_6toSym33
+  real(pREAL), dimension(6), intent(in) :: v6                                                       !< 6 vector
   logical,     optional,     intent(in) :: weighted                                                 !< weight according to Mandel (.true. by default)
 
-  real(pReal), dimension(6) :: w
+  real(pREAL), dimension(6) :: w
   integer :: i
 
 
-  w = merge(INVNRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+  w = merge(INVNRMMANDEL,1.0_pREAL,misc_optional(weighted,.true.))
 
   do i=1,6
     math_6toSym33(MAPNYE(1,i),MAPNYE(2,i)) = w(i)*v6(i)
@@ -748,8 +748,8 @@ end function math_6toSym33
 !--------------------------------------------------------------------------------------------------
 pure function math_3333to99(m3333)
 
-  real(pReal), dimension(9,9)                 :: math_3333to99
-  real(pReal), dimension(3,3,3,3), intent(in) :: m3333
+  real(pREAL), dimension(9,9)                 :: math_3333to99
+  real(pREAL), dimension(3,3,3,3), intent(in) :: m3333
 
   integer :: i,j
 
@@ -770,8 +770,8 @@ end function math_3333to99
 !--------------------------------------------------------------------------------------------------
 pure function math_99to3333(m99)
 
-  real(pReal), dimension(3,3,3,3)         :: math_99to3333
-  real(pReal), dimension(9,9), intent(in) :: m99
+  real(pREAL), dimension(3,3,3,3)         :: math_99to3333
+  real(pREAL), dimension(9,9), intent(in) :: m99
 
   integer :: i,j
 
@@ -795,15 +795,15 @@ end function math_99to3333
 !--------------------------------------------------------------------------------------------------
 pure function math_sym3333to66(m3333,weighted)
 
-  real(pReal), dimension(6,6)                 :: math_sym3333to66
-  real(pReal), dimension(3,3,3,3), intent(in) :: m3333                                              !< symmetric 3x3x3x3 matrix (no internal check)
+  real(pREAL), dimension(6,6)                 :: math_sym3333to66
+  real(pREAL), dimension(3,3,3,3), intent(in) :: m3333                                              !< symmetric 3x3x3x3 matrix (no internal check)
   logical,     optional,           intent(in) :: weighted                                           !< weight according to Mandel (.true. by default)
 
-  real(pReal), dimension(6) :: w
+  real(pREAL), dimension(6) :: w
   integer :: i,j
 
 
-  w = merge(NRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+  w = merge(NRMMANDEL,1.0_pREAL,misc_optional(weighted,.true.))
 
 #ifndef __INTEL_COMPILER
   do concurrent(i=1:6, j=1:6)
@@ -824,15 +824,15 @@ end function math_sym3333to66
 !--------------------------------------------------------------------------------------------------
 pure function math_66toSym3333(m66,weighted)
 
-  real(pReal), dimension(3,3,3,3)            :: math_66toSym3333
-  real(pReal), dimension(6,6),    intent(in) :: m66                                                 !< 6x6 matrix
+  real(pREAL), dimension(3,3,3,3)            :: math_66toSym3333
+  real(pREAL), dimension(6,6),    intent(in) :: m66                                                 !< 6x6 matrix
   logical,     optional,          intent(in) :: weighted                                            !< weight according to Mandel (.true. by default)
 
-  real(pReal), dimension(6) :: w
+  real(pREAL), dimension(6) :: w
   integer :: i,j
 
 
-  w = merge(INVNRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+  w = merge(INVNRMMANDEL,1.0_pREAL,misc_optional(weighted,.true.))
 
   do i=1,6; do j=1,6
     math_66toSym3333(MAPNYE(1,i),MAPNYE(2,i),MAPNYE(1,j),MAPNYE(2,j)) = w(i)*w(j)*m66(i,j)
@@ -849,8 +849,8 @@ end function math_66toSym3333
 !--------------------------------------------------------------------------------------------------
 pure function math_Voigt6to33_stress(sigma_tilde) result(sigma)
 
-  real(pReal), dimension(3,3) :: sigma
-  real(pReal), dimension(6), intent(in) :: sigma_tilde
+  real(pREAL), dimension(3,3) :: sigma
+  real(pREAL), dimension(6), intent(in) :: sigma_tilde
 
 
   sigma = reshape([sigma_tilde(1), sigma_tilde(6), sigma_tilde(5), &
@@ -865,13 +865,13 @@ end function math_Voigt6to33_stress
 !--------------------------------------------------------------------------------------------------
 pure function math_Voigt6to33_strain(epsilon_tilde) result(epsilon)
 
-  real(pReal), dimension(3,3) :: epsilon
-  real(pReal), dimension(6), intent(in) :: epsilon_tilde
+  real(pREAL), dimension(3,3) :: epsilon
+  real(pREAL), dimension(6), intent(in) :: epsilon_tilde
 
 
-  epsilon = reshape([          epsilon_tilde(1), 0.5_pReal*epsilon_tilde(6), 0.5_pReal*epsilon_tilde(5), &
-                     0.5_pReal*epsilon_tilde(6),           epsilon_tilde(2), 0.5_pReal*epsilon_tilde(4), &
-                     0.5_pReal*epsilon_tilde(5), 0.5_pReal*epsilon_tilde(4),           epsilon_tilde(3)],[3,3])
+  epsilon = reshape([          epsilon_tilde(1), 0.5_pREAL*epsilon_tilde(6), 0.5_pREAL*epsilon_tilde(5), &
+                     0.5_pREAL*epsilon_tilde(6),           epsilon_tilde(2), 0.5_pREAL*epsilon_tilde(4), &
+                     0.5_pREAL*epsilon_tilde(5), 0.5_pREAL*epsilon_tilde(4),           epsilon_tilde(3)],[3,3])
 
 end function math_Voigt6to33_strain
 
@@ -881,8 +881,8 @@ end function math_Voigt6to33_strain
 !--------------------------------------------------------------------------------------------------
 pure function math_33toVoigt6_stress(sigma) result(sigma_tilde)
 
-  real(pReal), dimension(6) :: sigma_tilde
-  real(pReal), dimension(3,3), intent(in) :: sigma
+  real(pREAL), dimension(6) :: sigma_tilde
+  real(pREAL), dimension(3,3), intent(in) :: sigma
 
 
   sigma_tilde = [sigma(1,1), sigma(2,2), sigma(3,3), &
@@ -896,12 +896,12 @@ end function math_33toVoigt6_stress
 !--------------------------------------------------------------------------------------------------
 pure function math_33toVoigt6_strain(epsilon) result(epsilon_tilde)
 
-  real(pReal), dimension(6) :: epsilon_tilde
-  real(pReal), dimension(3,3), intent(in) :: epsilon
+  real(pREAL), dimension(6) :: epsilon_tilde
+  real(pREAL), dimension(3,3), intent(in) :: epsilon
 
 
   epsilon_tilde = [          epsilon(1,1),           epsilon(2,2),           epsilon(3,3), &
-                   2.0_pReal*epsilon(3,2), 2.0_pReal*epsilon(3,1), 2.0_pReal*epsilon(1,2)]
+                   2.0_pREAL*epsilon(3,2), 2.0_pREAL*epsilon(3,1), 2.0_pREAL*epsilon(1,2)]
 
 end function math_33toVoigt6_strain
 
@@ -912,8 +912,8 @@ end function math_33toVoigt6_strain
 !--------------------------------------------------------------------------------------------------
 pure function math_Voigt66to3333_stiffness(C_tilde) result(C)
 
-  real(pReal), dimension(3,3,3,3) :: C
-  real(pReal), dimension(6,6), intent(in) :: C_tilde
+  real(pREAL), dimension(3,3,3,3) :: C
+  real(pREAL), dimension(6,6), intent(in) :: C_tilde
 
   integer :: i,j
 
@@ -933,8 +933,8 @@ end function math_Voigt66to3333_stiffness
 !--------------------------------------------------------------------------------------------------
 pure function math_3333toVoigt66_stiffness(C) result(C_tilde)
 
-  real(pReal), dimension(6,6) :: C_tilde
-  real(pReal), dimension(3,3,3,3), intent(in) :: C
+  real(pREAL), dimension(6,6) :: C_tilde
+  real(pREAL), dimension(3,3,3,3), intent(in) :: C
 
   integer :: i,j
 
@@ -957,15 +957,15 @@ end function math_3333toVoigt66_stiffness
 !--------------------------------------------------------------------------------------------------
 impure elemental subroutine math_normal(x,mu,sigma)
 
-  real(pReal), intent(out) :: x
-  real(pReal), intent(in), optional :: mu, sigma
+  real(pREAL), intent(out) :: x
+  real(pREAL), intent(in), optional :: mu, sigma
 
-  real(pReal), dimension(2) :: rnd
+  real(pREAL), dimension(2) :: rnd
 
 
   call random_number(rnd)
-  x = misc_optional(mu,0.0_pReal) &
-    + misc_optional(sigma,1.0_pReal) * sqrt(-2.0_pReal*log(1.0_pReal-rnd(1)))*cos(TAU*(1.0_pReal - rnd(2)))
+  x = misc_optional(mu,0.0_pREAL) &
+    + misc_optional(sigma,1.0_pREAL) * sqrt(-2.0_pREAL*log(1.0_pREAL-rnd(1)))*cos(TAU*(1.0_pREAL - rnd(2)))
 
 end subroutine math_normal
 
@@ -975,13 +975,13 @@ end subroutine math_normal
 !--------------------------------------------------------------------------------------------------
 pure subroutine math_eigh(w,v,error,m)
 
-  real(pReal), dimension(:,:),                  intent(in)  :: m                                    !< quadratic matrix to compute eigenvectors and values of
-  real(pReal), dimension(size(m,1)),            intent(out) :: w                                    !< eigenvalues
-  real(pReal), dimension(size(m,1),size(m,1)),  intent(out) :: v                                    !< eigenvectors
+  real(pREAL), dimension(:,:),                  intent(in)  :: m                                    !< quadratic matrix to compute eigenvectors and values of
+  real(pREAL), dimension(size(m,1)),            intent(out) :: w                                    !< eigenvalues
+  real(pREAL), dimension(size(m,1),size(m,1)),  intent(out) :: v                                    !< eigenvectors
   logical,                                      intent(out) :: error
 
   integer :: ierr
-  real(pReal), dimension(size(m,1)**2) :: work
+  real(pREAL), dimension(size(m,1)**2) :: work
 
 
   v = m                                                                                             ! copy matrix to input (doubles as output) array
@@ -1000,11 +1000,11 @@ end subroutine math_eigh
 !--------------------------------------------------------------------------------------------------
 pure subroutine math_eigh33(w,v,m)
 
-  real(pReal), dimension(3,3),intent(in)  :: m                                                      !< 3x3 matrix to compute eigenvectors and values of
-  real(pReal), dimension(3),  intent(out) :: w                                                      !< eigenvalues
-  real(pReal), dimension(3,3),intent(out) :: v                                                      !< eigenvectors
+  real(pREAL), dimension(3,3),intent(in)  :: m                                                      !< 3x3 matrix to compute eigenvectors and values of
+  real(pREAL), dimension(3),  intent(out) :: w                                                      !< eigenvalues
+  real(pREAL), dimension(3,3),intent(out) :: v                                                      !< eigenvectors
 
-  real(pReal) :: T, U, norm, threshold
+  real(pREAL) :: T, U, norm, threshold
   logical :: error
 
 
@@ -1016,7 +1016,7 @@ pure subroutine math_eigh33(w,v,m)
 
   T = maxval(abs(w))
   U = max(T, T**2)
-  threshold = sqrt(5.68e-14_pReal * U**2)
+  threshold = sqrt(5.68e-14_pREAL * U**2)
 
 #ifndef __INTEL_LLVM_COMPILER
   v(1:3,1) = [m(1,3)*w(1) + v(1,2), &
@@ -1059,32 +1059,32 @@ end subroutine math_eigh33
 !--------------------------------------------------------------------------------------------------
 pure function math_rotationalPart(F) result(R)
 
-  real(pReal), dimension(3,3), intent(in) :: &
+  real(pREAL), dimension(3,3), intent(in) :: &
     F                                                                                               ! deformation gradient
-  real(pReal), dimension(3,3) :: &
+  real(pREAL), dimension(3,3) :: &
     C, &                                                                                            ! right Cauchy-Green tensor
     R                                                                                               ! rotational part
-  real(pReal), dimension(3) :: &
+  real(pREAL), dimension(3) :: &
     lambda, &                                                                                       ! principal stretches
     I_C, &                                                                                          ! invariants of C
     I_U                                                                                             ! invariants of U
-  real(pReal), dimension(2) :: &
+  real(pREAL), dimension(2) :: &
     I_F                                                                                             ! first two invariants of F
-  real(pReal) :: x,Phi
+  real(pREAL) :: x,Phi
 
 
   C = matmul(transpose(F),F)
   I_C = math_invariantsSym33(C)
-  I_F = [math_trace33(F), 0.5_pReal*(math_trace33(F)**2 - math_trace33(matmul(F,F)))]
+  I_F = [math_trace33(F), 0.5_pREAL*(math_trace33(F)**2 - math_trace33(matmul(F,F)))]
 
-  x = math_clip(I_C(1)**2 -3.0_pReal*I_C(2),0.0_pReal)**(3.0_pReal/2.0_pReal)
+  x = math_clip(I_C(1)**2 -3.0_pREAL*I_C(2),0.0_pREAL)**(3.0_pREAL/2.0_pREAL)
   if (dNeq0(x)) then
-    Phi = acos(math_clip((I_C(1)**3 -4.5_pReal*I_C(1)*I_C(2) +13.5_pReal*I_C(3))/x,-1.0_pReal,1.0_pReal))
-    lambda = I_C(1) +(2.0_pReal * sqrt(math_clip(I_C(1)**2-3.0_pReal*I_C(2),0.0_pReal))) &
-                    *cos((Phi-TAU*[1.0_pReal,2.0_pReal,3.0_pReal])/3.0_pReal)
-    lambda = sqrt(math_clip(lambda,0.0_pReal)/3.0_pReal)
+    Phi = acos(math_clip((I_C(1)**3 -4.5_pREAL*I_C(1)*I_C(2) +13.5_pREAL*I_C(3))/x,-1.0_pREAL,1.0_pREAL))
+    lambda = I_C(1) +(2.0_pREAL * sqrt(math_clip(I_C(1)**2-3.0_pREAL*I_C(2),0.0_pREAL))) &
+                    *cos((Phi-TAU*[1.0_pREAL,2.0_pREAL,3.0_pREAL])/3.0_pREAL)
+    lambda = sqrt(math_clip(lambda,0.0_pREAL)/3.0_pREAL)
   else
-    lambda = sqrt(I_C(1)/3.0_pReal)
+    lambda = sqrt(I_C(1)/3.0_pREAL)
   end if
 
   I_U = [sum(lambda), lambda(1)*lambda(2)+lambda(2)*lambda(3)+lambda(3)*lambda(1), product(lambda)]
@@ -1094,7 +1094,7 @@ pure function math_rotationalPart(F) result(R)
     - I_U(1)*I_F(1) * transpose(F) &
     + I_U(1) * transpose(matmul(F,F)) &
     - matmul(F,C)
-  R = R*math_det33(R)**(-1.0_pReal/3.0_pReal)
+  R = R*math_det33(R)**(-1.0_pREAL/3.0_pREAL)
 
 end function math_rotationalPart
 
@@ -1105,17 +1105,17 @@ end function math_rotationalPart
 !--------------------------------------------------------------------------------------------------
 pure function math_eigvalsh(m)
 
-  real(pReal), dimension(:,:),                  intent(in)  :: m                                    !< symmetric matrix to compute eigenvalues of
-  real(pReal), dimension(size(m,1))                         :: math_eigvalsh
+  real(pREAL), dimension(:,:),                  intent(in)  :: m                                    !< symmetric matrix to compute eigenvalues of
+  real(pREAL), dimension(size(m,1))                         :: math_eigvalsh
 
-  real(pReal), dimension(size(m,1),size(m,1))               :: m_
+  real(pREAL), dimension(size(m,1),size(m,1))               :: m_
   integer :: ierr
-  real(pReal), dimension(size(m,1)**2) :: work
+  real(pREAL), dimension(size(m,1)**2) :: work
 
 
   m_ = m                                                                                            ! m_ will be destroyed
   call dsyev('N','U',size(m,1),m_,size(m,1),math_eigvalsh,work,size(work),ierr)
-  if (ierr /= 0) math_eigvalsh = IEEE_value(1.0_pReal,IEEE_quiet_NaN)
+  if (ierr /= 0) math_eigvalsh = IEEE_value(1.0_pREAL,IEEE_quiet_NaN)
 
 end function math_eigvalsh
 
@@ -1129,30 +1129,30 @@ end function math_eigvalsh
 !--------------------------------------------------------------------------------------------------
 pure function math_eigvalsh33(m)
 
-  real(pReal), intent(in), dimension(3,3) :: m                                                      !< 3x3 symmetric matrix to compute eigenvalues of
-  real(pReal), dimension(3) :: math_eigvalsh33,I
-  real(pReal) :: P, Q, rho, phi
-  real(pReal), parameter :: TOL=1.e-14_pReal
+  real(pREAL), intent(in), dimension(3,3) :: m                                                      !< 3x3 symmetric matrix to compute eigenvalues of
+  real(pREAL), dimension(3) :: math_eigvalsh33,I
+  real(pREAL) :: P, Q, rho, phi
+  real(pREAL), parameter :: TOL=1.e-14_pREAL
 
 
   I = math_invariantsSym33(m)                                                                       ! invariants are coefficients in characteristic polynomial apart for the sign of c0 and c2 in http://arxiv.org/abs/physics/0610206
 
-  P = I(2)-I(1)**2/3.0_pReal                                                                        ! different from http://arxiv.org/abs/physics/0610206 (this formulation was in DAMASK)
-  Q = product(I(1:2))/3.0_pReal &
-    - 2.0_pReal/27.0_pReal*I(1)**3 &
+  P = I(2)-I(1)**2/3.0_pREAL                                                                        ! different from http://arxiv.org/abs/physics/0610206 (this formulation was in DAMASK)
+  Q = product(I(1:2))/3.0_pREAL &
+    - 2.0_pREAL/27.0_pREAL*I(1)**3 &
     - I(3)                                                                                          ! different from http://arxiv.org/abs/physics/0610206 (this formulation was in DAMASK)
 
   if (all(abs([P,Q]) < TOL)) then
     math_eigvalsh33 = math_eigvalsh(m)
   else
-    rho=sqrt(-3.0_pReal*P**3)/9.0_pReal
-    phi=acos(math_clip(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal))
-    math_eigvalsh33 = 2.0_pReal*rho**(1.0_pReal/3.0_pReal)* &
-                                                            [cos( phi              /3.0_pReal), &
-                                                             cos((phi+TAU)/3.0_pReal), &
-                                                             cos((phi+2.0_pReal*TAU)/3.0_pReal) &
+    rho=sqrt(-3.0_pREAL*P**3)/9.0_pREAL
+    phi=acos(math_clip(-Q/rho*0.5_pREAL,-1.0_pREAL,1.0_pREAL))
+    math_eigvalsh33 = 2.0_pREAL*rho**(1.0_pREAL/3.0_pREAL)* &
+                                                            [cos( phi              /3.0_pREAL), &
+                                                             cos((phi+TAU)/3.0_pREAL), &
+                                                             cos((phi+2.0_pREAL*TAU)/3.0_pREAL) &
                                                             ] &
-                    + I(1)/3.0_pReal
+                    + I(1)/3.0_pREAL
   end if
 
 end function math_eigvalsh33
@@ -1163,8 +1163,8 @@ end function math_eigvalsh33
 !--------------------------------------------------------------------------------------------------
 pure function math_invariantsSym33(m)
 
-  real(pReal), dimension(3,3), intent(in) :: m
-  real(pReal), dimension(3) :: math_invariantsSym33
+  real(pREAL), dimension(3,3), intent(in) :: m
+  real(pREAL), dimension(3) :: math_invariantsSym33
 
 
   math_invariantsSym33(1) = math_trace33(m)
@@ -1225,17 +1225,17 @@ end function math_multinomial
 !--------------------------------------------------------------------------------------------------
 !> @brief volume of tetrahedron given by four vertices
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_volTetrahedron(v1,v2,v3,v4)
+real(pREAL) pure function math_volTetrahedron(v1,v2,v3,v4)
 
-  real(pReal), dimension (3), intent(in) :: v1,v2,v3,v4
-  real(pReal), dimension (3,3) :: m
+  real(pREAL), dimension (3), intent(in) :: v1,v2,v3,v4
+  real(pREAL), dimension (3,3) :: m
 
 
   m(1:3,1) = v1-v2
   m(1:3,2) = v1-v3
   m(1:3,3) = v1-v4
 
-  math_volTetrahedron = abs(math_det33(m))/6.0_pReal
+  math_volTetrahedron = abs(math_det33(m))/6.0_pREAL
 
 end function math_volTetrahedron
 
@@ -1243,12 +1243,12 @@ end function math_volTetrahedron
 !--------------------------------------------------------------------------------------------------
 !> @brief area of triangle given by three vertices
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_areaTriangle(v1,v2,v3)
+real(pREAL) pure function math_areaTriangle(v1,v2,v3)
 
-  real(pReal), dimension (3), intent(in) :: v1,v2,v3
+  real(pREAL), dimension (3), intent(in) :: v1,v2,v3
 
 
-  math_areaTriangle = 0.5_pReal * norm2(math_cross(v1-v2,v1-v3))
+  math_areaTriangle = 0.5_pREAL * norm2(math_cross(v1-v2,v1-v3))
 
 end function math_areaTriangle
 
@@ -1256,10 +1256,10 @@ end function math_areaTriangle
 !--------------------------------------------------------------------------------------------------
 !> @brief Limit a scalar value to a certain range (either one or two sided).
 !--------------------------------------------------------------------------------------------------
-real(pReal) pure elemental function math_clip(a, left, right)
+real(pREAL) pure elemental function math_clip(a, left, right)
 
-  real(pReal), intent(in) :: a
-  real(pReal), intent(in), optional :: left, right
+  real(pREAL), intent(in) :: a
+  real(pREAL), intent(in), optional :: left, right
 
 
   math_clip = a
@@ -1285,30 +1285,30 @@ subroutine selfTest()
   integer,     dimension(5) :: range_out_ = [1,2,3,4,5]
   integer,     dimension(3) :: ijk
 
-  real(pReal)                 :: det
-  real(pReal), dimension(3)   :: v3_1,v3_2,v3_3,v3_4
-  real(pReal), dimension(6)   :: v6
-  real(pReal), dimension(9)   :: v9
-  real(pReal), dimension(3,3) :: t33,t33_2
-  real(pReal), dimension(6,6) :: t66
-  real(pReal), dimension(9,9) :: t99,t99_2
-  real(pReal), dimension(:,:), &
+  real(pREAL)                 :: det
+  real(pREAL), dimension(3)   :: v3_1,v3_2,v3_3,v3_4
+  real(pREAL), dimension(6)   :: v6
+  real(pREAL), dimension(9)   :: v9
+  real(pREAL), dimension(3,3) :: t33,t33_2
+  real(pREAL), dimension(6,6) :: t66
+  real(pREAL), dimension(9,9) :: t99,t99_2
+  real(pREAL), dimension(:,:), &
                allocatable    :: txx,txx_2
-  real(pReal)                 :: r
+  real(pREAL)                 :: r
   integer                     :: d
   logical                     :: e
 
 
-  if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,3.0_pReal,3.0_pReal,3.0_pReal] - &
-              math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2,3,0])) > tol_math_check)) &
+  if (any(abs([1.0_pREAL,2.0_pREAL,2.0_pREAL,3.0_pREAL,3.0_pREAL,3.0_pREAL] - &
+              math_expand([1.0_pREAL,2.0_pREAL,3.0_pREAL],[1,2,3,0])) > tol_math_check)) &
     error stop 'math_expand [1,2,3] by [1,2,3,0] => [1,2,2,3,3,3]'
 
-  if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal] - &
-              math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2])) > tol_math_check)) &
+  if (any(abs([1.0_pREAL,2.0_pREAL,2.0_pREAL] - &
+              math_expand([1.0_pREAL,2.0_pREAL,3.0_pREAL],[1,2])) > tol_math_check)) &
     error stop 'math_expand [1,2,3] by [1,2] => [1,2,2]'
 
-  if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,1.0_pReal,1.0_pReal,1.0_pReal] - &
-              math_expand([1.0_pReal,2.0_pReal],[1,2,3])) > tol_math_check)) &
+  if (any(abs([1.0_pREAL,2.0_pREAL,2.0_pREAL,1.0_pREAL,1.0_pREAL,1.0_pREAL] - &
+              math_expand([1.0_pREAL,2.0_pREAL],[1,2,3])) > tol_math_check)) &
     error stop 'math_expand [1,2] by [1,2,3] => [1,2,2,1,1,1]'
 
   call math_sort(sort_in_,1,3,2)
@@ -1320,7 +1320,7 @@ subroutine selfTest()
 
   if (any(dNeq(math_exp33(math_I3,0),math_I3))) &
     error stop 'math_exp33(math_I3,1)'
-  if (any(dNeq(math_exp33(math_I3,128),exp(1.0_pReal)*math_I3))) &
+  if (any(dNeq(math_exp33(math_I3,128),exp(1.0_pREAL)*math_I3))) &
     error stop 'math_exp33(math_I3,128)'
 
   call random_number(v9)
@@ -1336,10 +1336,10 @@ subroutine selfTest()
     error stop 'math_sym33to6/math_6toSym33'
 
   call random_number(t66)
-  if (any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66,1.0e-15_pReal))) &
+  if (any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66,1.0e-15_pREAL))) &
     error stop 'math_sym3333to66/math_66toSym3333'
 
-  if (any(dNeq(math_3333toVoigt66_stiffness(math_Voigt66to3333_stiffness(t66)),t66,1.0e-15_pReal))) &
+  if (any(dNeq(math_3333toVoigt66_stiffness(math_Voigt66to3333_stiffness(t66)),t66,1.0e-15_pREAL))) &
     error stop 'math_3333toVoigt66/math_Voigt66to3333'
 
   call random_number(v6)
@@ -1351,12 +1351,12 @@ subroutine selfTest()
   call random_number(v3_3)
   call random_number(v3_4)
 
-  if (dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0_pReal, &
-          math_volTetrahedron(v3_1,v3_2,v3_3,v3_4),tol=1.0e-12_pReal)) &
+  if (dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0_pREAL, &
+          math_volTetrahedron(v3_1,v3_2,v3_3,v3_4),tol=1.0e-12_pREAL)) &
     error stop 'math_volTetrahedron'
 
   call random_number(t33)
-  if (dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pReal)) &
+  if (dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pREAL)) &
     error stop 'math_det33/math_detSym33'
 
   if (any(dNeq(t33+transpose(t33),math_mul3333xx33(math_identity4th(),t33+transpose(t33))))) &
@@ -1365,34 +1365,34 @@ subroutine selfTest()
   if (any(dNeq0(math_eye(3),math_inv33(math_I3)))) &
     error stop 'math_inv33(math_I3)'
 
-  do while(abs(math_det33(t33))<1.0e-9_pReal)
+  do while(abs(math_det33(t33))<1.0e-9_pREAL)
     call random_number(t33)
   end do
-  if (any(dNeq0(matmul(t33,math_inv33(t33)) - math_eye(3),tol=1.0e-8_pReal))) &
+  if (any(dNeq0(matmul(t33,math_inv33(t33)) - math_eye(3),tol=1.0e-8_pREAL))) &
     error stop 'math_inv33'
 
   call math_invert33(t33_2,det,e,t33)
-  if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
+  if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pREAL)) .or. e) &
     error stop 'math_invert33: T:T^-1 != I'
-  if (dNeq(det,math_det33(t33),tol=1.0e-12_pReal)) &
+  if (dNeq(det,math_det33(t33),tol=1.0e-12_pREAL)) &
     error stop 'math_invert33 (determinant)'
 
   call math_invert(t33_2,e,t33)
-  if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
+  if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pREAL)) .or. e) &
     error stop 'math_invert t33'
 
-  do while(math_det33(t33)<1.0e-2_pReal)                                                            ! O(det(F)) = 1
+  do while(math_det33(t33)<1.0e-2_pREAL)                                                            ! O(det(F)) = 1
     call random_number(t33)
   end do
   t33_2 = math_rotationalPart(transpose(t33))
   t33   = math_rotationalPart(t33)
-  if (any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pReal))) &
+  if (any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pREAL))) &
     error stop 'math_rotationalPart (forward-backward)'
-  if (dNeq(1.0_pReal,math_det33(math_rotationalPart(t33)),tol=1.0e-10_pReal)) &
+  if (dNeq(1.0_pREAL,math_det33(math_rotationalPart(t33)),tol=1.0e-10_pREAL)) &
     error stop 'math_rotationalPart (determinant)'
 
   call random_number(r)
-  d = int(r*5.0_pReal) + 1
+  d = int(r*5.0_pREAL) + 1
   txx = math_eye(d)
   allocate(txx_2(d,d))
   call math_invert(txx_2,e,txx)
@@ -1400,10 +1400,10 @@ subroutine selfTest()
     error stop 'math_invert(txx)/math_eye'
 
   call math_invert(t99_2,e,t99) ! not sure how likely it is that we get a singular matrix
-  if (any(dNeq0(matmul(t99_2,t99)-math_eye(9),tol=1.0e-9_pReal)) .or. e) &
+  if (any(dNeq0(matmul(t99_2,t99)-math_eye(9),tol=1.0e-9_pREAL)) .or. e) &
     error stop 'math_invert(t99)'
 
-  if (any(dNeq(math_clip([4.0_pReal,9.0_pReal],5.0_pReal,6.5_pReal),[5.0_pReal,6.5_pReal]))) &
+  if (any(dNeq(math_clip([4.0_pREAL,9.0_pREAL],5.0_pREAL,6.5_pREAL),[5.0_pREAL,6.5_pREAL]))) &
     error stop 'math_clip'
 
   if (math_factorial(10) /= 3628800) &
@@ -1415,35 +1415,35 @@ subroutine selfTest()
   if (math_multinomial([1,2,3,4]) /= 12600) &
     error stop 'math_multinomial'
 
-  ijk = cshift([1,2,3],int(r*1.0e2_pReal))
-  if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),+1.0_pReal)) &
+  ijk = cshift([1,2,3],int(r*1.0e2_pREAL))
+  if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),+1.0_pREAL)) &
     error stop 'math_LeviCivita(even)'
-  ijk = cshift([3,2,1],int(r*2.0e2_pReal))
-  if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),-1.0_pReal)) &
+  ijk = cshift([3,2,1],int(r*2.0e2_pREAL))
+  if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),-1.0_pREAL)) &
     error stop 'math_LeviCivita(odd)'
-  ijk = cshift([2,2,1],int(r*2.0e2_pReal))
+  ijk = cshift([2,2,1],int(r*2.0e2_pREAL))
   if (dNeq0(math_LeviCivita(ijk(1),ijk(2),ijk(3)))) &
     error stop 'math_LeviCivita'
 
   normal_distribution: block
     integer, parameter :: N = 1000000
-    real(pReal), dimension(:), allocatable :: r
-    real(pReal) :: mu, sigma
+    real(pREAL), dimension(:), allocatable :: r
+    real(pREAL) :: mu, sigma
 
     allocate(r(N))
     call random_number(mu)
     call random_number(sigma)
 
-    sigma = 1.0_pReal + sigma*5.0_pReal
-    mu = (mu-0.5_pReal)*10_pReal
+    sigma = 1.0_pREAL + sigma*5.0_pREAL
+    mu = (mu-0.5_pREAL)*10_pREAL
 
     call math_normal(r,mu,sigma)
 
-    if (abs(mu -sum(r)/real(N,pReal))>5.0e-2_pReal) &
+    if (abs(mu -sum(r)/real(N,pREAL))>5.0e-2_pREAL) &
       error stop 'math_normal(mu)'
 
-    mu = sum(r)/real(N,pReal)
-    if (abs(sigma**2 -1.0_pReal/real(N-1,pReal) * sum((r-mu)**2))/sigma > 5.0e-2_pReal) &
+    mu = sum(r)/real(N,pREAL)
+    if (abs(sigma**2 -1.0_pREAL/real(N-1,pREAL) * sum((r-mu)**2))/sigma > 5.0e-2_pREAL) &
       error stop 'math_normal(sigma)'
   end block normal_distribution
 

src/mesh/DAMASK_mesh.f90

@@ -23,7 +23,7 @@ program DAMASK_mesh
   implicit none(type,external)
 
   type :: tLoadCase
-    real(pReal)  :: time                   = 0.0_pReal                                              !< length of increment
+    real(pREAL)  :: time                   = 0.0_pREAL                                              !< length of increment
     integer      :: incs                   = 0, &                                                   !< number of increments
                     outputfrequency        = 1                                                      !< frequency of result writes
     logical      :: followFormerTrajectory = .true.                                                 !< follow trajectory of former loadcase
@@ -43,12 +43,12 @@ program DAMASK_mesh
 ! loop variables, convergence etc.
   integer, parameter :: &
     subStepFactor = 2                                                                               !< for each substep, divide the last time increment by 2.0
-  real(pReal) :: &
-    time = 0.0_pReal, &                                                                             !< elapsed time
-    time0 = 0.0_pReal, &                                                                            !< begin of interval
-    timeinc = 0.0_pReal, &                                                                          !< current time interval
-    timeIncOld = 0.0_pReal, &                                                                       !< previous time interval
-    remainingLoadCaseTime = 0.0_pReal                                                               !< remaining time of current load case
+  real(pREAL) :: &
+    time = 0.0_pREAL, &                                                                             !< elapsed time
+    time0 = 0.0_pREAL, &                                                                            !< begin of interval
+    timeinc = 0.0_pREAL, &                                                                          !< current time interval
+    timeIncOld = 0.0_pREAL, &                                                                       !< previous time interval
+    remainingLoadCaseTime = 0.0_pREAL                                                               !< remaining time of current load case
   logical :: &
     guess, &                                                                                        !< guess along former trajectory
     stagIterate
@@ -140,7 +140,7 @@ program DAMASK_mesh
       end select
     end do
     do component = 1, loadCases(i)%fieldBC(1)%nComponents
-      allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
+      allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pREAL)
       allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
     end do
   end do
@@ -240,7 +240,7 @@ program DAMASK_mesh
 
   print'(/,1x,a)', '... writing initial configuration to file .................................'
   flush(IO_STDOUT)
-  call materialpoint_result(0,0.0_pReal)
+  call materialpoint_result(0,0.0_pREAL)
 
   loadCaseLooping: do currentLoadCase = 1, size(loadCases)
     time0 = time                                                                                    ! load case start time
@@ -252,8 +252,8 @@ program DAMASK_mesh
 !--------------------------------------------------------------------------------------------------
 ! forwarding time
       timeIncOld = timeinc                                                                          ! last timeinc that brought former inc to an end
-      timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
-      timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal)                      ! depending on cut back level, decrease time step
+      timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pREAL)
+      timeinc = timeinc * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL)                      ! depending on cut back level, decrease time step
       stepFraction = 0                                                                              ! fraction scaled by stepFactor**cutLevel
 
       subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
@@ -298,7 +298,7 @@ program DAMASK_mesh
             stepFraction = (stepFraction - 1) * subStepFactor                                       ! adjust to new denominator
             cutBackLevel = cutBackLevel + 1
             time    = time - timeinc                                                                ! rewind time
-            timeinc = timeinc/2.0_pReal
+            timeinc = timeinc/2.0_pREAL
             print'(/,1x,a)', 'cutting back'
           else                                                                                      ! default behavior, exit if spectral solver does not converge
             if (worldrank == 0) close(statUnit)

src/mesh/FEM_quadrature.f90

@@ -10,18 +10,18 @@ module FEM_quadrature
 
   integer, parameter :: &
     maxOrder = 5                                                                                    !< maximum integration order
-  real(pReal),   dimension(2,3),       parameter :: &
-    triangle    = reshape([-1.0_pReal, -1.0_pReal, &
-                            1.0_pReal, -1.0_pReal, &
-                           -1.0_pReal,  1.0_pReal], shape=[2,3])
-  real(pReal),   dimension(3,4),       parameter :: &
-    tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, &
-                            1.0_pReal, -1.0_pReal, -1.0_pReal, &
-                           -1.0_pReal,  1.0_pReal, -1.0_pReal, &
-                           -1.0_pReal, -1.0_pReal,  1.0_pReal], shape=[3,4])
+  real(pREAL),   dimension(2,3),       parameter :: &
+    triangle    = reshape([-1.0_pREAL, -1.0_pREAL, &
+                            1.0_pREAL, -1.0_pREAL, &
+                           -1.0_pREAL,  1.0_pREAL], shape=[2,3])
+  real(pREAL),   dimension(3,4),       parameter :: &
+    tetrahedron = reshape([-1.0_pREAL, -1.0_pREAL, -1.0_pREAL, &
+                            1.0_pREAL, -1.0_pREAL, -1.0_pREAL, &
+                           -1.0_pREAL,  1.0_pREAL, -1.0_pREAL, &
+                           -1.0_pREAL, -1.0_pREAL,  1.0_pREAL], shape=[3,4])
 
   type :: group_real                                                                               !< variable length datatype
-    real(pReal), dimension(:), allocatable :: p
+    real(pREAL), dimension(:), allocatable :: p
   end type group_real
 
   integer,             dimension(2:3,maxOrder), public, protected :: &
@@ -51,132 +51,132 @@ subroutine FEM_quadrature_init()
   FEM_nQuadrature(2,1) = 1
 
   allocate(FEM_quadrature_weights(2,1)%p(FEM_nQuadrature(2,1)))
-  FEM_quadrature_weights(2,1)%p(1) = 1._pReal
+  FEM_quadrature_weights(2,1)%p(1) = 1._pREAL
 
-  FEM_quadrature_points (2,1)%p = permutationStar3([1._pReal/3._pReal])
+  FEM_quadrature_points (2,1)%p = permutationStar3([1._pREAL/3._pREAL])
 
 !--------------------------------------------------------------------------------------------------
 ! 2D quadratic
   FEM_nQuadrature(2,2) = 3
 
   allocate(FEM_quadrature_weights(2,2)%p(FEM_nQuadrature(2,2)))
-  FEM_quadrature_weights(2,2)%p(1:3) = 1._pReal/3._pReal
+  FEM_quadrature_weights(2,2)%p(1:3) = 1._pREAL/3._pREAL
 
-  FEM_quadrature_points (2,2)%p = permutationStar21([1._pReal/6._pReal])
+  FEM_quadrature_points (2,2)%p = permutationStar21([1._pREAL/6._pREAL])
 
 !--------------------------------------------------------------------------------------------------
 ! 2D cubic
   FEM_nQuadrature(2,3) = 6
 
   allocate(FEM_quadrature_weights(2,3)%p(FEM_nQuadrature(2,3)))
-  FEM_quadrature_weights(2,3)%p(1:3) = 2.2338158967801147e-1_pReal
-  FEM_quadrature_weights(2,3)%p(4:6) = 1.0995174365532187e-1_pReal
+  FEM_quadrature_weights(2,3)%p(1:3) = 2.2338158967801147e-1_pREAL
+  FEM_quadrature_weights(2,3)%p(4:6) = 1.0995174365532187e-1_pREAL
 
   FEM_quadrature_points (2,3)%p = [ &
-    permutationStar21([4.4594849091596489e-1_pReal]), &
-    permutationStar21([9.157621350977074e-2_pReal]) ]
+    permutationStar21([4.4594849091596489e-1_pREAL]), &
+    permutationStar21([9.157621350977074e-2_pREAL]) ]
 
 !--------------------------------------------------------------------------------------------------
 ! 2D quartic
   FEM_nQuadrature(2,4) = 12
 
   allocate(FEM_quadrature_weights(2,4)%p(FEM_nQuadrature(2,4)))
-  FEM_quadrature_weights(2,4)%p(1:3)  = 1.1678627572637937e-1_pReal
-  FEM_quadrature_weights(2,4)%p(4:6)  = 5.0844906370206817e-2_pReal
-  FEM_quadrature_weights(2,4)%p(7:12) = 8.285107561837358e-2_pReal
+  FEM_quadrature_weights(2,4)%p(1:3)  = 1.1678627572637937e-1_pREAL
+  FEM_quadrature_weights(2,4)%p(4:6)  = 5.0844906370206817e-2_pREAL
+  FEM_quadrature_weights(2,4)%p(7:12) = 8.285107561837358e-2_pREAL
 
   FEM_quadrature_points (2,4)%p = [ &
-    permutationStar21([2.4928674517091042e-1_pReal]), &
-    permutationStar21([6.308901449150223e-2_pReal]), &
-    permutationStar111([3.1035245103378440e-1_pReal, 5.3145049844816947e-2_pReal]) ]
+    permutationStar21([2.4928674517091042e-1_pREAL]), &
+    permutationStar21([6.308901449150223e-2_pREAL]), &
+    permutationStar111([3.1035245103378440e-1_pREAL, 5.3145049844816947e-2_pREAL]) ]
 
 !--------------------------------------------------------------------------------------------------
 ! 2D quintic
   FEM_nQuadrature(2,5) = 16
 
   allocate(FEM_quadrature_weights(2,5)%p(FEM_nQuadrature(2,5)))
-  FEM_quadrature_weights(2,5)%p(1:1)   = 1.4431560767778717e-1_pReal
-  FEM_quadrature_weights(2,5)%p(2:4)   = 9.509163426728463e-2_pReal
-  FEM_quadrature_weights(2,5)%p(5:7)   = 1.0321737053471825e-1_pReal
-  FEM_quadrature_weights(2,5)%p(8:10)  = 3.2458497623198080e-2_pReal
-  FEM_quadrature_weights(2,5)%p(11:16) = 2.7230314174434994e-2_pReal
+  FEM_quadrature_weights(2,5)%p(1:1)   = 1.4431560767778717e-1_pREAL
+  FEM_quadrature_weights(2,5)%p(2:4)   = 9.509163426728463e-2_pREAL
+  FEM_quadrature_weights(2,5)%p(5:7)   = 1.0321737053471825e-1_pREAL
+  FEM_quadrature_weights(2,5)%p(8:10)  = 3.2458497623198080e-2_pREAL
+  FEM_quadrature_weights(2,5)%p(11:16) = 2.7230314174434994e-2_pREAL
 
   FEM_quadrature_points (2,5)%p = [ &
-    permutationStar3([1._pReal/3._pReal]), &
-    permutationStar21([4.5929258829272316e-1_pReal]), &
-    permutationStar21([1.705693077517602e-1_pReal]), &
-    permutationStar21([5.0547228317030975e-2_pReal]), &
-    permutationStar111([2.631128296346381e-1_pReal, 8.3947774099576053e-2_pReal]) ]
+    permutationStar3([1._pREAL/3._pREAL]), &
+    permutationStar21([4.5929258829272316e-1_pREAL]), &
+    permutationStar21([1.705693077517602e-1_pREAL]), &
+    permutationStar21([5.0547228317030975e-2_pREAL]), &
+    permutationStar111([2.631128296346381e-1_pREAL, 8.3947774099576053e-2_pREAL]) ]
 
 !--------------------------------------------------------------------------------------------------
 ! 3D linear
   FEM_nQuadrature(3,1) = 1
 
   allocate(FEM_quadrature_weights(3,1)%p(FEM_nQuadrature(3,1)))
-  FEM_quadrature_weights(3,1)%p(1) = 1.0_pReal
+  FEM_quadrature_weights(3,1)%p(1) = 1.0_pREAL
 
-  FEM_quadrature_points (3,1)%p = permutationStar4([0.25_pReal])
+  FEM_quadrature_points (3,1)%p = permutationStar4([0.25_pREAL])
 
 !--------------------------------------------------------------------------------------------------
 ! 3D quadratic
   FEM_nQuadrature(3,2) = 4
 
   allocate(FEM_quadrature_weights(3,2)%p(FEM_nQuadrature(3,2)))
-  FEM_quadrature_weights(3,2)%p(1:4) = 0.25_pReal
+  FEM_quadrature_weights(3,2)%p(1:4) = 0.25_pREAL
 
-  FEM_quadrature_points (3,2)%p = permutationStar31([1.3819660112501052e-1_pReal])
+  FEM_quadrature_points (3,2)%p = permutationStar31([1.3819660112501052e-1_pREAL])
 
 !--------------------------------------------------------------------------------------------------
 ! 3D cubic
   FEM_nQuadrature(3,3) = 14
 
   allocate(FEM_quadrature_weights(3,3)%p(FEM_nQuadrature(3,3)))
-  FEM_quadrature_weights(3,3)%p(1:4)  = 7.3493043116361949e-2_pReal
-  FEM_quadrature_weights(3,3)%p(5:8)  = 1.1268792571801585e-1_pReal
-  FEM_quadrature_weights(3,3)%p(9:14) = 4.2546020777081467e-2_pReal
+  FEM_quadrature_weights(3,3)%p(1:4)  = 7.3493043116361949e-2_pREAL
+  FEM_quadrature_weights(3,3)%p(5:8)  = 1.1268792571801585e-1_pREAL
+  FEM_quadrature_weights(3,3)%p(9:14) = 4.2546020777081467e-2_pREAL
 
   FEM_quadrature_points (3,3)%p = [ &
-    permutationStar31([9.273525031089123e-2_pReal]), &
-    permutationStar31([3.108859192633006e-1_pReal]), &
-    permutationStar22([4.5503704125649649e-2_pReal]) ]
+    permutationStar31([9.273525031089123e-2_pREAL]), &
+    permutationStar31([3.108859192633006e-1_pREAL]), &
+    permutationStar22([4.5503704125649649e-2_pREAL]) ]
 
 !--------------------------------------------------------------------------------------------------
 ! 3D quartic (lower precision/unknown source)
   FEM_nQuadrature(3,4) = 35
 
   allocate(FEM_quadrature_weights(3,4)%p(FEM_nQuadrature(3,4)))
-  FEM_quadrature_weights(3,4)%p(1:4)   = 0.0021900463965388_pReal
-  FEM_quadrature_weights(3,4)%p(5:16)  = 0.0143395670177665_pReal
-  FEM_quadrature_weights(3,4)%p(17:22) = 0.0250305395686746_pReal
-  FEM_quadrature_weights(3,4)%p(23:34) = 0.0479839333057554_pReal
-  FEM_quadrature_weights(3,4)%p(35)    = 0.0931745731195340_pReal
+  FEM_quadrature_weights(3,4)%p(1:4)   = 0.0021900463965388_pREAL
+  FEM_quadrature_weights(3,4)%p(5:16)  = 0.0143395670177665_pREAL
+  FEM_quadrature_weights(3,4)%p(17:22) = 0.0250305395686746_pREAL
+  FEM_quadrature_weights(3,4)%p(23:34) = 0.0479839333057554_pREAL
+  FEM_quadrature_weights(3,4)%p(35)    = 0.0931745731195340_pREAL
 
   FEM_quadrature_points (3,4)%p = [ &
-    permutationStar31([0.0267367755543735_pReal]), &
-    permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal]), &
-    permutationStar22([0.4547545999844830_pReal]), &
-    permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal]), &
-    permutationStar4([0.25_pReal]) ]
+    permutationStar31([0.0267367755543735_pREAL]), &
+    permutationStar211([0.0391022406356488_pREAL, 0.7477598884818090_pREAL]), &
+    permutationStar22([0.4547545999844830_pREAL]), &
+    permutationStar211([0.2232010379623150_pREAL, 0.0504792790607720_pREAL]), &
+    permutationStar4([0.25_pREAL]) ]
 
 !--------------------------------------------------------------------------------------------------
 ! 3D quintic (lower precision/unknown source)
   FEM_nQuadrature(3,5) = 56
 
   allocate(FEM_quadrature_weights(3,5)%p(FEM_nQuadrature(3,5)))
-  FEM_quadrature_weights(3,5)%p(1:4)   = 0.0010373112336140_pReal
-  FEM_quadrature_weights(3,5)%p(5:16)  = 0.0096016645399480_pReal
-  FEM_quadrature_weights(3,5)%p(17:28) = 0.0164493976798232_pReal
-  FEM_quadrature_weights(3,5)%p(29:40) = 0.0153747766513310_pReal
-  FEM_quadrature_weights(3,5)%p(41:52) = 0.0293520118375230_pReal
-  FEM_quadrature_weights(3,5)%p(53:56) = 0.0366291366405108_pReal
+  FEM_quadrature_weights(3,5)%p(1:4)   = 0.0010373112336140_pREAL
+  FEM_quadrature_weights(3,5)%p(5:16)  = 0.0096016645399480_pREAL
+  FEM_quadrature_weights(3,5)%p(17:28) = 0.0164493976798232_pREAL
+  FEM_quadrature_weights(3,5)%p(29:40) = 0.0153747766513310_pREAL
+  FEM_quadrature_weights(3,5)%p(41:52) = 0.0293520118375230_pREAL
+  FEM_quadrature_weights(3,5)%p(53:56) = 0.0366291366405108_pREAL
 
   FEM_quadrature_points (3,5)%p = [ &
-    permutationStar31([0.0149520651530592_pReal]), &
-    permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal]), &
-    permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal]), &
-    permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal]), &
-    permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal]), &
-    permutationStar31([0.1344783347929940_pReal]) ]
+    permutationStar31([0.0149520651530592_pREAL]), &
+    permutationStar211([0.0340960211962615_pREAL, 0.1518319491659370_pREAL]), &
+    permutationStar211([0.0462051504150017_pREAL, 0.3549340560639790_pREAL]), &
+    permutationStar211([0.2281904610687610_pREAL, 0.0055147549744775_pREAL]), &
+    permutationStar211([0.3523052600879940_pREAL, 0.0992057202494530_pREAL]), &
+    permutationStar31([0.1344783347929940_pREAL]) ]
 
   call selfTest()
 
@@ -188,8 +188,8 @@ end subroutine FEM_quadrature_init
 !--------------------------------------------------------------------------------------------------
 pure function permutationStar3(point) result(qPt)
 
-  real(pReal), dimension(2)             :: qPt
-  real(pReal), dimension(1), intent(in) :: point
+  real(pREAL), dimension(2)             :: qPt
+  real(pREAL), dimension(1), intent(in) :: point
 
 
   qPt = pack(matmul(triangle,reshape([ &
@@ -203,14 +203,14 @@ end function permutationStar3
 !--------------------------------------------------------------------------------------------------
 pure function permutationStar21(point) result(qPt)
 
-  real(pReal), dimension(6)             :: qPt
-  real(pReal), dimension(1), intent(in) :: point
+  real(pREAL), dimension(6)             :: qPt
+  real(pREAL), dimension(1), intent(in) :: point
 
 
   qPt = pack(matmul(triangle,reshape([ &
-    point(1), point(1), 1.0_pReal - 2.0_pReal*point(1), &
-    point(1), 1.0_pReal - 2.0_pReal*point(1), point(1), &
-    1.0_pReal - 2.0_pReal*point(1), point(1), point(1)],[3,3])),.true.)
+    point(1), point(1), 1.0_pREAL - 2.0_pREAL*point(1), &
+    point(1), 1.0_pREAL - 2.0_pREAL*point(1), point(1), &
+    1.0_pREAL - 2.0_pREAL*point(1), point(1), point(1)],[3,3])),.true.)
 
 end function permutationStar21
 
@@ -220,17 +220,17 @@ end function permutationStar21
 !--------------------------------------------------------------------------------------------------
 pure function permutationStar111(point) result(qPt)
 
-  real(pReal), dimension(12)            :: qPt
-  real(pReal), dimension(2), intent(in) :: point
+  real(pREAL), dimension(12)            :: qPt
+  real(pREAL), dimension(2), intent(in) :: point
 
 
   qPt = pack(matmul(triangle,reshape([ &
-    point(1), point(2), 1.0_pReal - point(1) - point(2), &
-    point(1), 1.0_pReal - point(1) - point(2), point(2), &
-    point(2), point(1), 1.0_pReal - point(1) - point(2), &
-    point(2), 1.0_pReal - point(1) - point(2), point(1), &
-    1.0_pReal - point(1) - point(2), point(2), point(1), &
-    1.0_pReal - point(1) - point(2), point(1), point(2)],[3,6])),.true.)
+    point(1), point(2), 1.0_pREAL - point(1) - point(2), &
+    point(1), 1.0_pREAL - point(1) - point(2), point(2), &
+    point(2), point(1), 1.0_pREAL - point(1) - point(2), &
+    point(2), 1.0_pREAL - point(1) - point(2), point(1), &
+    1.0_pREAL - point(1) - point(2), point(2), point(1), &
+    1.0_pREAL - point(1) - point(2), point(1), point(2)],[3,6])),.true.)
 
 end function permutationStar111
 
@@ -240,8 +240,8 @@ end function permutationStar111
 !--------------------------------------------------------------------------------------------------
 pure function permutationStar4(point) result(qPt)
 
-  real(pReal), dimension(3)             :: qPt
-  real(pReal), dimension(1), intent(in) :: point
+  real(pREAL), dimension(3)             :: qPt
+  real(pREAL), dimension(1), intent(in) :: point
 
 
   qPt = pack(matmul(tetrahedron,reshape([ &
@@ -255,15 +255,15 @@ end function permutationStar4
 !--------------------------------------------------------------------------------------------------
 pure function permutationStar31(point) result(qPt)
 
-  real(pReal), dimension(12)            :: qPt
-  real(pReal), dimension(1), intent(in) :: point
+  real(pREAL), dimension(12)            :: qPt
+  real(pREAL), dimension(1), intent(in) :: point
 
 
   qPt = pack(matmul(tetrahedron,reshape([ &
-    point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), &
-    point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), &
-    point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1), &
-    1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)],[4,4])),.true.)
+    point(1), point(1), point(1), 1.0_pREAL - 3.0_pREAL*point(1), &
+    point(1), point(1), 1.0_pREAL - 3.0_pREAL*point(1), point(1), &
+    point(1), 1.0_pREAL - 3.0_pREAL*point(1), point(1), point(1), &
+    1.0_pREAL - 3.0_pREAL*point(1), point(1), point(1), point(1)],[4,4])),.true.)
 
 end function permutationStar31
 
@@ -273,17 +273,17 @@ end function permutationStar31
 !--------------------------------------------------------------------------------------------------
 function permutationStar22(point) result(qPt)
 
-  real(pReal), dimension(18)            :: qPt
-  real(pReal), dimension(1), intent(in) :: point
+  real(pREAL), dimension(18)            :: qPt
+  real(pREAL), dimension(1), intent(in) :: point
 
 
   qPt = pack(matmul(tetrahedron,reshape([ &
-    point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), &
-    point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1), &
-    0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1), &
-    0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1), &
-    0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1), &
-    point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)],[4,6])),.true.)
+    point(1), point(1), 0.5_pREAL - point(1), 0.5_pREAL - point(1), &
+    point(1), 0.5_pREAL - point(1), point(1), 0.5_pREAL - point(1), &
+    0.5_pREAL - point(1), point(1), point(1), 0.5_pREAL - point(1), &
+    0.5_pREAL - point(1), point(1), 0.5_pREAL - point(1), point(1), &
+    0.5_pREAL - point(1), 0.5_pREAL - point(1), point(1), point(1), &
+    point(1), 0.5_pREAL - point(1), 0.5_pREAL - point(1), point(1)],[4,6])),.true.)
 
 end function permutationStar22
 
@@ -293,23 +293,23 @@ end function permutationStar22
 !--------------------------------------------------------------------------------------------------
 pure function permutationStar211(point) result(qPt)
 
-  real(pReal), dimension(36)            :: qPt
-  real(pReal), dimension(2), intent(in) :: point
+  real(pREAL), dimension(36)            :: qPt
+  real(pREAL), dimension(2), intent(in) :: point
 
 
   qPt = pack(matmul(tetrahedron,reshape([ &
-    point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
-    point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), &
-    point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
-    point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), &
-    point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), &
-    point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), &
-    point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
-    point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), &
-    point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), &
-    1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2), &
-    1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1), &
-    1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)],[4,12])),.true.)
+    point(1), point(1), point(2), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), &
+    point(1), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(2), &
+    point(1), point(2), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), &
+    point(1), point(2), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), &
+    point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(2), &
+    point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(2), point(1), &
+    point(2), point(1), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), &
+    point(2), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), &
+    point(2), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(1), &
+    1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(1), point(2), &
+    1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(2), point(1), &
+    1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(2), point(1), point(1)],[4,12])),.true.)
 
 end function permutationStar211
 
@@ -319,35 +319,35 @@ end function permutationStar211
 !--------------------------------------------------------------------------------------------------
 pure function permutationStar1111(point) result(qPt)
 
-  real(pReal), dimension(72)            :: qPt
-  real(pReal), dimension(3), intent(in) :: point
+  real(pREAL), dimension(72)            :: qPt
+  real(pREAL), dimension(3), intent(in) :: point
 
 
   qPt = pack(matmul(tetrahedron,reshape([ &
-    point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), &
-    point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), &
-    point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), &
-    point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), &
-    point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), &
-    point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), &
-    point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), &
-    point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), &
-    point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), &
-    point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), &
-    point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), &
-    point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), &
-    point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), &
-    point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), &
-    point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), &
-    point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), &
-    point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), &
-    point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), &
-    1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3), &
-    1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2), &
-    1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3), &
-    1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1), &
-    1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2), &
-    1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)],[4,24])),.true.)
+    point(1), point(2), point(3), 1.0_pREAL - point(1) - point(2)- point(3), &
+    point(1), point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(3), &
+    point(1), point(3), point(2), 1.0_pREAL - point(1) - point(2)- point(3), &
+    point(1), point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(2), &
+    point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(2), point(3), &
+    point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(3), point(2), &
+    point(2), point(1), point(3), 1.0_pREAL - point(1) - point(2)- point(3), &
+    point(2), point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(3), &
+    point(2), point(3), point(1), 1.0_pREAL - point(1) - point(2)- point(3), &
+    point(2), point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(1), &
+    point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(1), point(3), &
+    point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(3), point(1), &
+    point(3), point(1), point(2), 1.0_pREAL - point(1) - point(2)- point(3), &
+    point(3), point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(2), &
+    point(3), point(2), point(1), 1.0_pREAL - point(1) - point(2)- point(3), &
+    point(3), point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(1), &
+    point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(1), point(2), &
+    point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(2), point(1), &
+    1.0_pREAL - point(1) - point(2)- point(3), point(1), point(2), point(3), &
+    1.0_pREAL - point(1) - point(2)- point(3), point(1), point(3), point(2), &
+    1.0_pREAL - point(1) - point(2)- point(3), point(2), point(1), point(3), &
+    1.0_pREAL - point(1) - point(2)- point(3), point(2), point(3), point(1), &
+    1.0_pREAL - point(1) - point(2)- point(3), point(3), point(1), point(2), &
+    1.0_pREAL - point(1) - point(2)- point(3), point(3), point(2), point(1)],[4,24])),.true.)
 
 end function permutationStar1111
 
@@ -358,12 +358,12 @@ end function permutationStar1111
 subroutine selfTest
 
   integer :: o, d, n
-  real(pReal), dimension(2:3), parameter :: w = [3.0_pReal,2.0_pReal]
+  real(pREAL), dimension(2:3), parameter :: w = [3.0_pREAL,2.0_pREAL]
 
 
   do d = lbound(FEM_quadrature_weights,1), ubound(FEM_quadrature_weights,1)
     do o = lbound(FEM_quadrature_weights(d,:),1), ubound(FEM_quadrature_weights(d,:),1)
-      if (dNeq(sum(FEM_quadrature_weights(d,o)%p),1.0_pReal,5e-15_pReal)) &
+      if (dNeq(sum(FEM_quadrature_weights(d,o)%p),1.0_pREAL,5e-15_pREAL)) &
         error stop 'quadrature weights'
     end do
   end do
@@ -371,7 +371,7 @@ subroutine selfTest
   do d = lbound(FEM_quadrature_points,1), ubound(FEM_quadrature_points,1)
     do o = lbound(FEM_quadrature_points(d,:),1), ubound(FEM_quadrature_points(d,:),1)
       n = size(FEM_quadrature_points(d,o)%p,1)/d
-      if (any(dNeq(sum(reshape(FEM_quadrature_points(d,o)%p,[d,n]),2),-real(n,pReal)/w(d),1.e-14_pReal))) &
+      if (any(dNeq(sum(reshape(FEM_quadrature_points(d,o)%p,[d,n]),2),-real(n,pREAL)/w(d),1.e-14_pREAL))) &
         error stop 'quadrature points'
     end do
   end do

src/mesh/FEM_utilities.f90

@@ -29,7 +29,7 @@ module FEM_utilities
   private
 
   logical,     public             :: cutBack = .false.                                              !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
-  real(pReal), public, protected  :: wgt                                                            !< weighting factor 1/Nelems
+  real(pREAL), public, protected  :: wgt                                                            !< weighting factor 1/Nelems
 
 
 !--------------------------------------------------------------------------------------------------
@@ -59,7 +59,7 @@ module FEM_utilities
 
   type, public :: tComponentBC
     integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
-    real(pReal), allocatable, dimension(:) :: Value
+    real(pREAL), allocatable, dimension(:) :: Value
     logical,     allocatable, dimension(:) :: Mask
   end type tComponentBC
 
@@ -128,7 +128,7 @@ subroutine FEM_utilities_init
   call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsOrder),err_PETSc)
   CHKERRQ(err_PETSc)
 
-  wgt = real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)**(-1)
+  wgt = real(mesh_maxNips*mesh_NcpElemsGlobal,pREAL)**(-1)
 
 
 end subroutine FEM_utilities_init
@@ -139,9 +139,9 @@ end subroutine FEM_utilities_init
 !--------------------------------------------------------------------------------------------------
 subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
 
-  real(pReal), intent(in)                 :: timeinc                                                !< loading time
+  real(pREAL), intent(in)                 :: timeinc                                                !< loading time
   logical,     intent(in)                 :: forwardData                                            !< age results
-  real(pReal),intent(out), dimension(3,3) :: P_av                                                   !< average PK stress
+  real(pREAL),intent(out), dimension(3,3) :: P_av                                                   !< average PK stress
 
   integer(MPI_INTEGER_KIND) :: err_MPI
 
@@ -170,8 +170,8 @@ subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCVa
   PetscSection         :: section
   IS                   :: bcPointsIS
   PetscInt,    pointer :: bcPoints(:)
-  real(pReal), pointer :: localArray(:)
-  real(pReal)          :: BCValue,BCDotValue,timeinc
+  real(pREAL), pointer :: localArray(:)
+  real(pREAL)          :: BCValue,BCDotValue,timeinc
   PetscErrorCode       :: err_PETSc
 
 

src/mesh/discretization_mesh.f90

@@ -49,11 +49,11 @@ module discretization_mesh
   PetscInt, dimension(:), allocatable, public, protected :: &
     mesh_boundaries
 
-  real(pReal), dimension(:,:), allocatable :: &
+  real(pREAL), dimension(:,:), allocatable :: &
     mesh_ipVolume, &                                                                                !< volume associated with IP (initially!)
     mesh_node0                                                                                      !< node x,y,z coordinates (initially!)
 
-  real(pReal), dimension(:,:,:), allocatable :: &
+  real(pREAL), dimension(:,:,:), allocatable :: &
     mesh_ipCoordinates                                                                              !< IP x,y,z coordinates (after deformation!)
 
 #ifdef PETSC_USE_64BIT_INDICES
@@ -92,7 +92,7 @@ subroutine discretization_mesh_init(restart)
     num_mesh
   integer :: p_i, dim                                                                               !< integration order (quadrature rule)
   type(tvec) :: coords_node0
-  real(pReal), pointer, dimension(:) :: &
+  real(pREAL), pointer, dimension(:) :: &
     mesh_node0_temp
 
   print'(/,1x,a)',   '<<<+-  discretization_mesh init  -+>>>'
@@ -176,7 +176,7 @@ subroutine discretization_mesh_init(restart)
   end do
   materialAt = materialAt + 1_pPETSCINT
 
-  allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
+  allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pREAL)
   mesh_node0(1:dimPlex,:) = reshape(mesh_node0_temp,[dimPlex,mesh_Nnodes])
 
 
@@ -200,7 +200,7 @@ subroutine mesh_FEM_build_ipVolumes(dimPlex)
   PetscInt           :: cellStart, cellEnd, cell
   PetscErrorCode     :: err_PETSc
 
-  allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal)
+  allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pREAL)
 
   call DMPlexGetHeightStratum(geomMesh,0_pPETSCINT,cellStart,cellEnd,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -209,7 +209,7 @@ subroutine mesh_FEM_build_ipVolumes(dimPlex)
   do cell = cellStart, cellEnd-1
     call  DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,err_PETSc)
     CHKERRQ(err_PETSc)
-    mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal)
+    mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pREAL)
   end do
 
 end subroutine mesh_FEM_build_ipVolumes
@@ -229,7 +229,7 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
   PetscErrorCode            :: err_PETSc
 
 
-  allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal)
+  allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pREAL)
 
   allocate(pV0(dimPlex))
   allocatE(pCellJ(dimPlex**2))
@@ -245,7 +245,7 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
         mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI)
         do dirJ = 1_pPETSCINT, dimPlex
           mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + &
-                                                pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0_pReal)
+                                                pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0_pREAL)
         end do
       end do
       qOffset = qOffset + dimPlex
@@ -259,7 +259,7 @@ end subroutine mesh_FEM_build_ipCoordinates
 !--------------------------------------------------------------------------------------------------
 subroutine writeGeometry(coordinates_points,coordinates_nodes)
 
-  real(pReal), dimension(:,:), intent(in) :: &
+  real(pREAL), dimension(:,:), intent(in) :: &
   coordinates_nodes, &
   coordinates_points
 

src/mesh/mesh_mech_FEM.f90

@@ -37,7 +37,7 @@ module mesh_mechanical_FEM
 ! derived types
   type tSolutionParams
     type(tFieldBC)  :: fieldBC
-    real(pReal)     :: timeinc
+    real(pREAL)     :: timeinc
   end type tSolutionParams
 
   type(tSolutionParams)  :: params
@@ -48,7 +48,7 @@ module mesh_mechanical_FEM
       itmax
     logical :: &
       BBarStabilisation
-    real(pReal) :: &
+    real(pREAL) :: &
       eps_struct_atol, &                                                                            !< absolute tolerance for mechanical equilibrium
       eps_struct_rtol                                                                               !< relative tolerance for mechanical equilibrium
   end type tNumerics
@@ -66,10 +66,10 @@ module mesh_mechanical_FEM
 !--------------------------------------------------------------------------------------------------
 ! stress, stiffness and compliance average etc.
   character(len=pSTRLEN) :: incInfo
-  real(pReal), dimension(3,3) :: &
-    P_av = 0.0_pReal
+  real(pREAL), dimension(3,3) :: &
+    P_av = 0.0_pREAL
   logical :: ForwardData
-  real(pReal), parameter :: eps = 1.0e-18_pReal
+  real(pREAL), parameter :: eps = 1.0e-18_pREAL
 
   external :: &                                                                                     ! ToDo: write interfaces
 #ifdef PETSC_USE_64BIT_INDICES
@@ -120,12 +120,12 @@ subroutine FEM_mechanical_init(fieldBC)
   PetscReal                              :: detJ
   PetscReal,         allocatable, target :: cellJMat(:,:)
 
-  real(pReal),                   pointer, dimension(:) :: px_scal
-  real(pReal),       allocatable, target, dimension(:) ::  x_scal
+  real(pREAL),                   pointer, dimension(:) :: px_scal
+  real(pREAL),       allocatable, target, dimension(:) ::  x_scal
 
   character(len=*), parameter            :: prefix = 'mechFE_'
   PetscErrorCode                         :: err_PETSc
-  real(pReal), dimension(3,3) :: devNull
+  real(pREAL), dimension(3,3) :: devNull
   type(tDict), pointer :: &
     num_mesh
 
@@ -137,12 +137,12 @@ subroutine FEM_mechanical_init(fieldBC)
   num%p_i               = int(num_mesh%get_asInt('p_i',defaultVal = 2),pPETSCINT)
   num%itmax             = int(num_mesh%get_asInt('itmax',defaultVal=250),pPETSCINT)
   num%BBarStabilisation = num_mesh%get_asBool('bbarstabilisation',defaultVal = .false.)
-  num%eps_struct_atol   = num_mesh%get_asReal('eps_struct_atol', defaultVal = 1.0e-10_pReal)
-  num%eps_struct_rtol   = num_mesh%get_asReal('eps_struct_rtol', defaultVal = 1.0e-4_pReal)
+  num%eps_struct_atol   = num_mesh%get_asReal('eps_struct_atol', defaultVal = 1.0e-10_pREAL)
+  num%eps_struct_rtol   = num_mesh%get_asReal('eps_struct_rtol', defaultVal = 1.0e-4_pREAL)
 
   if (num%itmax <= 1)                       call IO_error(301,ext_msg='itmax')
-  if (num%eps_struct_rtol <= 0.0_pReal)     call IO_error(301,ext_msg='eps_struct_rtol')
-  if (num%eps_struct_atol <= 0.0_pReal)     call IO_error(301,ext_msg='eps_struct_atol')
+  if (num%eps_struct_rtol <= 0.0_pREAL)     call IO_error(301,ext_msg='eps_struct_rtol')
+  if (num%eps_struct_atol <= 0.0_pREAL)     call IO_error(301,ext_msg='eps_struct_atol')
 
 !--------------------------------------------------------------------------------------------------
 ! Setup FEM mech mesh
@@ -264,16 +264,16 @@ subroutine FEM_mechanical_init(fieldBC)
   CHKERRQ(err_PETSc)
   call SNESSetConvergenceTest(mechanical_snes,FEM_mechanical_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,err_PETSc)
   CHKERRQ(err_PETSc)
-  call SNESSetTolerances(mechanical_snes,1.0_pReal,0.0_pReal,0.0_pReal,num%itmax,num%itmax,err_PETSc)
+  call SNESSetTolerances(mechanical_snes,1.0_pREAL,0.0_pREAL,0.0_pREAL,num%itmax,num%itmax,err_PETSc)
   CHKERRQ(err_PETSc)
   call SNESSetFromOptions(mechanical_snes,err_PETSc)
   CHKERRQ(err_PETSc)
 
 !--------------------------------------------------------------------------------------------------
 ! init fields
-  call VecSet(solution     ,0.0_pReal,err_PETSc)
+  call VecSet(solution     ,0.0_pREAL,err_PETSc)
   CHKERRQ(err_PETSc)
-  call VecSet(solution_rate,0.0_pReal,err_PETSc)
+  call VecSet(solution_rate,0.0_pREAL,err_PETSc)
   CHKERRQ(err_PETSc)
   allocate(x_scal(cellDof))
   allocate(nodalWeightsP(1))
@@ -289,7 +289,7 @@ subroutine FEM_mechanical_init(fieldBC)
   call DMPlexGetHeightStratum(mechanical_mesh,0_pPETSCINT,cellStart,cellEnd,err_PETSc)
   CHKERRQ(err_PETSc)
   do cell = cellStart, cellEnd-1                                                                    !< loop over all elements
-    x_scal = 0.0_pReal
+    x_scal = 0.0_pREAL
     call  DMPlexComputeCellGeometryAffineFEM(mechanical_mesh,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc)
     CHKERRQ(err_PETSc)
     cellJMat = reshape(pCellJ,shape=[dimPlex,dimPlex])
@@ -298,13 +298,13 @@ subroutine FEM_mechanical_init(fieldBC)
       CHKERRQ(err_PETSc)
       call PetscQuadratureGetData(functional,dimPlex,nc,nNodalPoints,nodalPointsP,nodalWeightsP,err_PETSc)
       CHKERRQ(err_PETSc)
-      x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pReal)
+      x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pREAL)
     end do
     px_scal => x_scal
     call DMPlexVecSetClosure(mechanical_mesh,section,solution_local,cell,px_scal,5,err_PETSc)
     CHKERRQ(err_PETSc)
   end do
-  call utilities_constitutiveResponse(0.0_pReal,devNull,.true.)
+  call utilities_constitutiveResponse(0.0_pREAL,devNull,.true.)
 
 end subroutine FEM_mechanical_init
 
@@ -317,7 +317,7 @@ type(tSolutionState) function FEM_mechanical_solution( &
 
 !--------------------------------------------------------------------------------------------------
 ! input data for solution
-  real(pReal), intent(in) :: &
+  real(pREAL), intent(in) :: &
     timeinc, &                                                                                      !< increment in time for current solution
     timeinc_old                                                                                     !< increment in time of last increment
   type(tFieldBC),      intent(in) :: &
@@ -369,8 +369,8 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
   PetscDS                            :: prob
   Vec                                :: x_local, f_local, xx_local
   PetscSection                       :: section
-  real(pReal), dimension(:), pointer :: x_scal, pf_scal
-  real(pReal), dimension(cellDof), target :: f_scal
+  real(pREAL), dimension(:), pointer :: x_scal, pf_scal
+  real(pREAL), dimension(cellDof), target :: f_scal
   PetscReal                          ::  IcellJMat(dimPlex,dimPlex)
   PetscReal,    dimension(:),pointer :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer
   PetscInt                           :: cellStart, cellEnd, cell, field, face, &
@@ -397,7 +397,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
   CHKERRQ(err_PETSc)
   call DMGetLocalVector(dm_local,x_local,err_PETSc)
   CHKERRQ(err_PETSc)
-  call VecWAXPY(x_local,1.0_pReal,xx_local,solution_local,err_PETSc)
+  call VecWAXPY(x_local,1.0_pREAL,xx_local,solution_local,err_PETSc)
   CHKERRQ(err_PETSc)
   do field = 1_pPETSCINT, dimPlex; do face = 1_pPETSCINT, mesh_Nboundaries
     if (params%fieldBC%componentBC(field)%Mask(face)) then
@@ -406,7 +406,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
         call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,err_PETSc)
         CHKERRQ(err_PETSc)
         call utilities_projectBCValues(x_local,section,0_pPETSCINT,field-1,bcPoints, &
-                                       0.0_pReal,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
+                                       0.0_pREAL,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
         call ISDestroy(bcPoints,err_PETSc)
         CHKERRQ(err_PETSc)
       end if
@@ -426,7 +426,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
     IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
     do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT
       m = cell*nQuadrature + qPt+1_pPETSCINT
-      BMat = 0.0_pReal
+      BMat = 0.0_pREAL
       do basis = 0_pPETSCINT, nBasis-1_pPETSCINT
         do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT
           cidx = basis*dimPlex+comp
@@ -438,11 +438,11 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
       homogenization_F(1:dimPlex,1:dimPlex,m) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
     end do
     if (num%BBarStabilisation) then
-      detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature,pReal))
+      detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature,pREAL))
       do qPt = 0, nQuadrature-1
         m = cell*nQuadrature + qPt+1
         homogenization_F(1:dimPlex,1:dimPlex,m) = homogenization_F(1:dimPlex,1:dimPlex,m) &
-                                                * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0_pReal/real(dimPlex,pReal))
+                                                * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0_pREAL/real(dimPlex,pREAL))
 
       end do
     end if
@@ -465,10 +465,10 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
     call  DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc)
     CHKERRQ(err_PETSc)
     IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
-    f_scal = 0.0_pReal
+    f_scal = 0.0_pREAL
     do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT
       m = cell*nQuadrature + qPt+1_pPETSCINT
-      BMat = 0.0_pReal
+      BMat = 0.0_pREAL
       do basis = 0_pPETSCINT, nBasis-1_pPETSCINT
         do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT
           cidx = basis*dimPlex+comp
@@ -517,10 +517,10 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
   PetscReal, dimension(:),   pointer :: basisField, basisFieldDer, &
                                           pV0, pCellJ, pInvcellJ
 
-  real(pReal), dimension(:),   pointer :: pK_e, x_scal
+  real(pREAL), dimension(:),   pointer :: pK_e, x_scal
 
-  real(pReal),dimension(cellDOF,cellDOF),  target :: K_e
-  real(pReal),dimension(cellDOF,cellDOF) :: K_eA, K_eB
+  real(pREAL),dimension(cellDOF,cellDOF),  target :: K_e
+  real(pREAL),dimension(cellDOF,cellDOF) :: K_eA, K_eB
 
   PetscInt :: cellStart, cellEnd, cell, field, face, &
               qPt, basis, comp, cidx,bcSize, m, i
@@ -547,7 +547,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
 
   call DMGetLocalVector(dm_local,x_local,err_PETSc)
   CHKERRQ(err_PETSc)
-  call VecWAXPY(x_local,1.0_pReal,xx_local,solution_local,err_PETSc)
+  call VecWAXPY(x_local,1.0_pREAL,xx_local,solution_local,err_PETSc)
   CHKERRQ(err_PETSc)
   do field = 1, dimPlex; do face = 1, mesh_Nboundaries
     if (params%fieldBC%componentBC(field)%Mask(face)) then
@@ -556,7 +556,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
         call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,err_PETSc)
         CHKERRQ(err_PETSc)
         call utilities_projectBCValues(x_local,section,0_pPETSCINT,field-1,bcPoints, &
-                                       0.0_pReal,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
+                                       0.0_pREAL,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
         call ISDestroy(bcPoints,err_PETSc)
         CHKERRQ(err_PETSc)
       end if
@@ -569,14 +569,14 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
     CHKERRQ(err_PETSc)
     call  DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc)
     CHKERRQ(err_PETSc)
-    K_eA = 0.0_pReal
-    K_eB = 0.0_pReal
-    MatB = 0.0_pReal
-    FAvg = 0.0_pReal
-    BMatAvg = 0.0_pReal
+    K_eA = 0.0_pREAL
+    K_eB = 0.0_pREAL
+    MatB = 0.0_pREAL
+    FAvg = 0.0_pREAL
+    BMatAvg = 0.0_pREAL
     do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT
       m = cell*nQuadrature + qPt + 1_pPETSCINT
-      BMat = 0.0_pReal
+      BMat = 0.0_pREAL
       do basis = 0_pPETSCINT, nBasis-1_pPETSCINT
         do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT
           cidx = basis*dimPlex+comp
@@ -591,7 +591,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
       if (num%BBarStabilisation) then
         F(1:dimPlex,1:dimPlex) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex])
         FInv = math_inv33(F)
-        K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0_pReal/real(dimPlex,pReal))
+        K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0_pREAL/real(dimPlex,pREAL))
         K_eB = K_eB - &
                matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[dimPlex**2,1_pPETSCINT]), &
                                        matmul(reshape(FInv(1:dimPlex,1:dimPlex), &
@@ -606,10 +606,10 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
     end do
     if (num%BBarStabilisation) then
       FInv = math_inv33(FAvg)
-      K_e = K_eA*math_det33(FAvg/real(nQuadrature,pReal))**(1.0_pReal/real(dimPlex,pReal)) + &
+      K_e = K_eA*math_det33(FAvg/real(nQuadrature,pREAL))**(1.0_pREAL/real(dimPlex,pREAL)) + &
             (matmul(matmul(transpose(BMatAvg), &
                            reshape(FInv(1:dimPlex,1:dimPlex),shape=[dimPlex**2,1_pPETSCINT],order=[2,1])),MatB) + &
-             K_eB)/real(dimPlex,pReal)
+             K_eB)/real(dimPlex,pREAL)
     else
       K_e = K_eA
     end if
@@ -662,7 +662,7 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC)
 
   type(tFieldBC), intent(in) :: &
     fieldBC
-  real(pReal),    intent(in) :: &
+  real(pREAL),    intent(in) :: &
     timeinc_old, &
     timeinc
   logical,        intent(in) :: &
@@ -686,13 +686,13 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC)
     CHKERRQ(err_PETSc)
     call DMGetLocalVector(dm_local,x_local,err_PETSc)
     CHKERRQ(err_PETSc)
-    call VecSet(x_local,0.0_pReal,err_PETSc)
+    call VecSet(x_local,0.0_pREAL,err_PETSc)
     CHKERRQ(err_PETSc)
     call DMGlobalToLocalBegin(dm_local,solution,INSERT_VALUES,x_local,err_PETSc)                         !< retrieve my partition of global solution vector
     CHKERRQ(err_PETSc)
     call DMGlobalToLocalEnd(dm_local,solution,INSERT_VALUES,x_local,err_PETSc)
     CHKERRQ(err_PETSc)
-    call VecAXPY(solution_local,1.0_pReal,x_local,err_PETSc)
+    call VecAXPY(solution_local,1.0_pREAL,x_local,err_PETSc)
     CHKERRQ(err_PETSc)
     do field = 1, dimPlex; do face = 1, mesh_Nboundaries
       if (fieldBC%componentBC(field)%Mask(face)) then
@@ -701,7 +701,7 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC)
           call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,err_PETSc)
           CHKERRQ(err_PETSc)
           call utilities_projectBCValues(solution_local,section,0_pPETSCINT,field-1,bcPoints, &
-                                         0.0_pReal,fieldBC%componentBC(field)%Value(face),timeinc_old)
+                                         0.0_pREAL,fieldBC%componentBC(field)%Value(face),timeinc_old)
           call ISDestroy(bcPoints,err_PETSc)
           CHKERRQ(err_PETSc)
         end if
@@ -746,7 +746,7 @@ subroutine FEM_mechanical_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reaso
   print'(/,1x,a,a,i0,a,f0.3)', trim(incInfo), &
                   ' @ Iteration ',PETScIter,' mechanical residual norm = ',fnorm/divTol
   print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-    'Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal
+    'Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pREAL
   flush(IO_STDOUT)
 
 end subroutine FEM_mechanical_converged
@@ -759,7 +759,7 @@ subroutine FEM_mechanical_updateCoords()
 
   PetscReal, pointer, dimension(:,:) :: &
     nodeCoords                                                                                      !< nodal coordinates (3,Nnodes)
-  real(pReal), pointer, dimension(:,:,:) :: &
+  real(pREAL), pointer, dimension(:,:,:) :: &
     ipCoords                                                                                        !< ip coordinates (3,nQuadrature,mesh_NcpElems)
 
   integer :: &
@@ -777,7 +777,7 @@ subroutine FEM_mechanical_updateCoords()
   PetscQuadrature :: mechQuad
   PetscReal, dimension(:), pointer :: basisField, basisFieldDer, &
     nodeCoords_linear                                                                               !< nodal coordinates (dimPlex*Nnodes)
-  real(pReal), dimension(:), pointer :: x_scal
+  real(pREAL), dimension(:), pointer :: x_scal
 
   call SNESGetDM(mechanical_snes,dm_local,err_PETSc)
   CHKERRQ(err_PETSc)
@@ -793,7 +793,7 @@ subroutine FEM_mechanical_updateCoords()
   ! write cell vertex displacements
   call DMPlexGetDepthStratum(dm_local,0_pPETSCINT,pStart,pEnd,err_PETSc)
   CHKERRQ(err_PETSc)
-  allocate(nodeCoords(3,pStart:pEnd-1),source=0.0_pReal)
+  allocate(nodeCoords(3,pStart:pEnd-1),source=0.0_pREAL)
   call VecGetArrayF90(x_local,nodeCoords_linear,err_PETSc)
   CHKERRQ(err_PETSc)
   do p=pStart, pEnd-1
@@ -811,7 +811,7 @@ subroutine FEM_mechanical_updateCoords()
   CHKERRQ(err_PETSc)
   call PetscDSGetTabulation(mechQuad,0_pPETSCINT,basisField,basisFieldDer,err_PETSc)
   CHKERRQ(err_PETSc)
-  allocate(ipCoords(3,nQuadrature,mesh_NcpElems),source=0.0_pReal)
+  allocate(ipCoords(3,nQuadrature,mesh_NcpElems),source=0.0_pREAL)
   do c=cellStart,cellEnd-1_pPETSCINT
     qOffset=0
     call DMPlexVecGetClosure(dm_local,section,x_local,c,x_scal,err_PETSc)                           !< get nodal coordinates of each element

src/misc.f90

@@ -78,9 +78,9 @@ end function misc_optional_int
 !--------------------------------------------------------------------------------------------------
 pure function misc_optional_real(given,default) result(var)
 
-  real(pReal), intent(in), optional :: given
-  real(pReal), intent(in)           :: default
-  real(pReal)                       :: var
+  real(pREAL), intent(in), optional :: given
+  real(pREAL), intent(in)           :: default
+  real(pREAL)                       :: var
 
 
   if (present(given)) then
@@ -116,7 +116,7 @@ end function misc_optional_str
 !--------------------------------------------------------------------------------------------------
 subroutine misc_selfTest()
 
-  real(pReal) :: r
+  real(pREAL) :: r
 
   call random_number(r)
   if (test_str('DAMASK') /= 'DAMASK')                        error stop 'optional_str, present'
@@ -126,11 +126,11 @@ subroutine misc_selfTest()
   if (test_int() /= 42)                                      error stop 'optional_int, not present'
   if (misc_optional(default=20191102) /= 20191102)           error stop 'optional_int, default only'
   if (dNeq(test_real(r),r))                                  error stop 'optional_real, present'
-  if (dNeq(test_real(),0.0_pReal))                           error stop 'optional_real, not present'
+  if (dNeq(test_real(),0.0_pREAL))                           error stop 'optional_real, not present'
   if (dNeq(misc_optional(default=r),r))                      error stop 'optional_real, default only'
-  if (test_bool(r<0.5_pReal) .neqv. r<0.5_pReal)             error stop 'optional_bool, present'
+  if (test_bool(r<0.5_pREAL) .neqv. r<0.5_pREAL)             error stop 'optional_bool, present'
   if (.not. test_bool())                                     error stop 'optional_bool, not present'
-  if (misc_optional(default=r>0.5_pReal) .neqv. r>0.5_pReal) error stop 'optional_bool, default only'
+  if (misc_optional(default=r>0.5_pREAL) .neqv. r>0.5_pREAL) error stop 'optional_bool, default only'
 
 contains
 
@@ -158,11 +158,11 @@ contains
 
   function test_real(real_in) result(real_out)
 
-    real(pReal)                       :: real_out
-    real(pReal), intent(in), optional :: real_in
+    real(pREAL)                       :: real_out
+    real(pREAL), intent(in), optional :: real_in
 
 
-    real_out = misc_optional_real(real_in,0.0_pReal)
+    real_out = misc_optional_real(real_in,0.0_pREAL)
 
   end function test_real
 

src/parallelization.f90

@@ -135,8 +135,8 @@ subroutine parallelization_init()
   call MPI_Type_size(MPI_DOUBLE,typeSize,err_MPI)
   if (err_MPI /= 0_MPI_INTEGER_KIND) &
     error stop 'Could not determine size of MPI_DOUBLE'
-  if (typeSize*8_MPI_INTEGER_KIND /= int(storage_size(0.0_pReal),MPI_INTEGER_KIND)) &
-    error stop 'Mismatch between MPI_DOUBLE and DAMASK pReal'
+  if (typeSize*8_MPI_INTEGER_KIND /= int(storage_size(0.0_pREAL),MPI_INTEGER_KIND)) &
+    error stop 'Mismatch between MPI_DOUBLE and DAMASK pREAL'
 
 !$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
 !$ if (got_env /= 0) then

src/phase.f90

@@ -29,15 +29,15 @@ module phase
       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
-    real(pReal), allocatable, dimension(:) :: &
+    real(pREAL), allocatable, dimension(:) :: &
       atol
     ! http://stackoverflow.com/questions/3948210
-    real(pReal), pointer,     dimension(:,:), contiguous :: &                                       !< is basically an allocatable+target, but in a type needs to be pointer
+    real(pREAL), pointer,     dimension(:,:), contiguous :: &                                       !< is basically an allocatable+target, but in a type needs to be pointer
       state0, &
       state, &                                                                                      !< state
       dotState, &                                                                                   !< rate of state change
       deltaState                                                                                    !< increment of state change
-    real(pReal), pointer,     dimension(:,:)  :: &
+    real(pREAL), pointer,     dimension(:,:)  :: &
       deltaState2
   end type
 
@@ -51,8 +51,8 @@ module phase
 
 
   character(len=2), allocatable, dimension(:) :: phase_lattice
-  real(pReal),      allocatable, dimension(:) :: phase_cOverA
-  real(pReal),      allocatable, dimension(:) :: phase_rho
+  real(pREAL),      allocatable, dimension(:) :: phase_cOverA
+  real(pREAL),      allocatable, dimension(:) :: phase_rho
 
   type(tRotationContainer), dimension(:), allocatable :: &
     phase_O_0, &
@@ -63,7 +63,7 @@ module phase
       iJacoLpresiduum, &                                                                            !< frequency of Jacobian update of residuum in Lp
       nState, &                                                                                     !< state loop limit
       nStress                                                                                       !< stress loop limit
-    real(pReal) :: &
+    real(pREAL) :: &
       subStepMinCryst, &                                                                            !< minimum (relative) size of sub-step allowed during cutback
       subStepSizeCryst, &                                                                           !< size of first substep when cutback
       subStepSizeLp, &                                                                              !< size of first substep when cutback in Lp calculation
@@ -133,11 +133,11 @@ module phase
 
 
     module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
-      real(pReal), intent(in) :: Delta_t
+      real(pREAL), intent(in) :: Delta_t
       integer, intent(in) :: &
         co, &                                                                                       !< counter in constituent loop
         ce
-      real(pReal), dimension(3,3,3,3) :: dPdF
+      real(pREAL), dimension(3,3,3,3) :: dPdF
     end function phase_mechanical_dPdF
 
     module subroutine mechanical_restartWrite(groupHandle,ph)
@@ -172,105 +172,105 @@ module phase
 
     module function mechanical_S(ph,en) result(S)
       integer, intent(in) :: ph,en
-      real(pReal), dimension(3,3) :: S
+      real(pREAL), dimension(3,3) :: S
     end function mechanical_S
 
     module function mechanical_L_p(ph,en) result(L_p)
       integer, intent(in) :: ph,en
-      real(pReal), dimension(3,3) :: L_p
+      real(pREAL), dimension(3,3) :: L_p
     end function mechanical_L_p
 
     module function mechanical_F_e(ph,en) result(F_e)
       integer, intent(in) :: ph,en
-      real(pReal), dimension(3,3) :: F_e
+      real(pREAL), dimension(3,3) :: F_e
     end function mechanical_F_e
 
     module function mechanical_F_i(ph,en) result(F_i)
       integer, intent(in) :: ph,en
-      real(pReal), dimension(3,3) :: F_i
+      real(pREAL), dimension(3,3) :: F_i
     end function mechanical_F_i
 
     module function phase_F(co,ce) result(F)
       integer, intent(in) :: co, ce
-      real(pReal), dimension(3,3) :: F
+      real(pREAL), dimension(3,3) :: F
     end function phase_F
 
     module function phase_P(co,ce) result(P)
       integer, intent(in) :: co, ce
-      real(pReal), dimension(3,3) :: P
+      real(pREAL), dimension(3,3) :: P
     end function phase_P
 
     pure module function thermal_T(ph,en) result(T)
       integer, intent(in) :: ph,en
-      real(pReal) :: T
+      real(pREAL) :: T
     end function thermal_T
 
     module function thermal_dot_T(ph,en) result(dot_T)
       integer, intent(in) :: ph,en
-      real(pReal) :: dot_T
+      real(pREAL) :: dot_T
     end function thermal_dot_T
 
     module function damage_phi(ph,en) result(phi)
       integer, intent(in) :: ph,en
-      real(pReal) :: phi
+      real(pREAL) :: phi
     end function damage_phi
 
 
     module subroutine phase_set_F(F,co,ce)
-      real(pReal), dimension(3,3), intent(in) :: F
+      real(pREAL), dimension(3,3), intent(in) :: F
       integer, intent(in) :: co, ce
     end subroutine phase_set_F
 
     module subroutine phase_thermal_setField(T,dot_T, co,ce)
-      real(pReal), intent(in) :: T, dot_T
+      real(pREAL), intent(in) :: T, dot_T
       integer, intent(in) :: co, ce
     end subroutine phase_thermal_setField
 
     module subroutine phase_set_phi(phi,co,ce)
-      real(pReal), intent(in) :: phi
+      real(pREAL), intent(in) :: phi
       integer, intent(in) :: co, ce
     end subroutine phase_set_phi
 
 
     module function phase_mu_phi(co,ce) result(mu)
       integer, intent(in) :: co, ce
-      real(pReal) :: mu
+      real(pREAL) :: mu
     end function phase_mu_phi
 
     module function phase_K_phi(co,ce) result(K)
       integer, intent(in) :: co, ce
-      real(pReal), dimension(3,3) :: K
+      real(pREAL), dimension(3,3) :: K
     end function phase_K_phi
 
 
     module function phase_mu_T(co,ce) result(mu)
       integer, intent(in) :: co, ce
-      real(pReal) :: mu
+      real(pREAL) :: mu
     end function phase_mu_T
 
     module function phase_K_T(co,ce) result(K)
       integer, intent(in) :: co, ce
-      real(pReal), dimension(3,3) :: K
+      real(pREAL), dimension(3,3) :: K
     end function phase_K_T
 
 ! == cleaned:end ===================================================================================
 
     module function phase_thermal_constitutive(Delta_t,ph,en) result(converged_)
 
-      real(pReal), intent(in) :: Delta_t
+      real(pREAL), intent(in) :: Delta_t
       integer, intent(in) :: ph, en
       logical :: converged_
 
     end function phase_thermal_constitutive
 
     module function phase_damage_constitutive(Delta_t,co,ce) result(converged_)
-      real(pReal), intent(in) :: Delta_t
+      real(pREAL), intent(in) :: Delta_t
       integer, intent(in) :: co, ce
       logical :: converged_
     end function phase_damage_constitutive
 
     module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
-      real(pReal), intent(in) :: Delta_t
+      real(pREAL), intent(in) :: Delta_t
       integer, intent(in) :: co, ce
       logical :: converged_
     end function phase_mechanical_constitutive
@@ -278,25 +278,25 @@ module phase
     !ToDo: Merge all the stiffness functions
     module function phase_homogenizedC66(ph,en) result(C)
       integer, intent(in) :: ph, en
-      real(pReal), dimension(6,6) :: C
+      real(pREAL), dimension(6,6) :: C
     end function phase_homogenizedC66
     module function phase_damage_C66(C66,ph,en) result(C66_degraded)
-      real(pReal), dimension(6,6), intent(in)  :: C66
+      real(pREAL), dimension(6,6), intent(in)  :: C66
       integer,                     intent(in)  :: ph,en
-      real(pReal), dimension(6,6) :: C66_degraded
+      real(pREAL), dimension(6,6) :: C66_degraded
     end function phase_damage_C66
 
     module function phase_f_phi(phi,co,ce) result(f)
       integer, intent(in) :: ce,co
-      real(pReal), intent(in) :: &
+      real(pREAL), intent(in) :: &
         phi                                                                                         !< damage parameter
-      real(pReal) :: &
+      real(pREAL) :: &
         f
     end function phase_f_phi
 
     module function phase_f_T(ph,en) result(f)
       integer, intent(in) :: ph, en
-      real(pReal) :: f
+      real(pREAL) :: f
     end function phase_f_T
 
     module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el)
@@ -316,11 +316,11 @@ module phase
 
     module subroutine damage_anisobrittle_LiAndItsTangent(L_i, dL_i_dM_i, M_i, ph,en)
       integer, intent(in) :: ph, en
-      real(pReal),   intent(in),  dimension(3,3) :: &
+      real(pREAL),   intent(in),  dimension(3,3) :: &
         M_i
-      real(pReal),   intent(out), dimension(3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3) :: &
         L_i                                                                                         !< damage velocity gradient
-      real(pReal),   intent(out), dimension(3,3,3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3,3,3) :: &
         dL_i_dM_i                                                                                   !< derivative of L_i with respect to M_i
     end subroutine damage_anisobrittle_LiAndItsTangent
 
@@ -389,7 +389,7 @@ subroutine phase_init
 
   phases => config_material%get_dict('phase')
   allocate(phase_lattice(phases%length))
-  allocate(phase_cOverA(phases%length),source=-1.0_pReal)
+  allocate(phase_cOverA(phases%length),source=-1.0_pREAL)
   allocate(phase_rho(phases%length))
   allocate(phase_O_0(phases%length))
 
@@ -403,7 +403,7 @@ subroutine phase_init
       call IO_error(130,ext_msg='phase_init: '//phase%get_asStr('lattice'))
     if (any(phase_lattice(ph) == ['hP','tI'])) &
       phase_cOverA(ph) = phase%get_asReal('c/a')
-    phase_rho(ph) = phase%get_asReal('rho',defaultVal=0.0_pReal)
+    phase_rho(ph) = phase%get_asReal('rho',defaultVal=0.0_pREAL)
     allocate(phase_O_0(ph)%data(count(material_ID_phase==ph)))
   end do
 
@@ -454,13 +454,13 @@ subroutine phase_allocateState(state, &
     state%offsetDeltaState = sizeState-sizeDeltaState                                               ! deltaState occupies latter part of state by definition
   end if
 
-  allocate(state%atol             (sizeState),          source=0.0_pReal)
-  allocate(state%state0           (sizeState,NEntries), source=0.0_pReal)
-  allocate(state%state            (sizeState,NEntries), source=0.0_pReal)
+  allocate(state%atol             (sizeState),          source=0.0_pREAL)
+  allocate(state%state0           (sizeState,NEntries), source=0.0_pREAL)
+  allocate(state%state            (sizeState,NEntries), source=0.0_pREAL)
 
-  allocate(state%dotState      (sizeDotState,NEntries), source=0.0_pReal)
+  allocate(state%dotState      (sizeDotState,NEntries), source=0.0_pREAL)
 
-  allocate(state%deltaState  (sizeDeltaState,NEntries), source=0.0_pReal)
+  allocate(state%deltaState  (sizeDeltaState,NEntries), source=0.0_pREAL)
   state%deltaState2 => state%state(state%offsetDeltaState+1: &
                                    state%offsetDeltaState+state%sizeDeltaState,:)
 
@@ -538,27 +538,27 @@ subroutine crystallite_init()
 
   num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict)
 
-  num%subStepMinCryst        = num_crystallite%get_asReal ('subStepMin',       defaultVal=1.0e-3_pReal)
-  num%subStepSizeCryst       = num_crystallite%get_asReal ('subStepSize',      defaultVal=0.25_pReal)
-  num%stepIncreaseCryst      = num_crystallite%get_asReal ('stepIncrease',     defaultVal=1.5_pReal)
-  num%subStepSizeLp          = num_crystallite%get_asReal ('subStepSizeLp',    defaultVal=0.5_pReal)
-  num%subStepSizeLi          = num_crystallite%get_asReal ('subStepSizeLi',    defaultVal=0.5_pReal)
-  num%rtol_crystalliteState  = num_crystallite%get_asReal ('rtol_State',       defaultVal=1.0e-6_pReal)
-  num%rtol_crystalliteStress = num_crystallite%get_asReal ('rtol_Stress',      defaultVal=1.0e-6_pReal)
-  num%atol_crystalliteStress = num_crystallite%get_asReal ('atol_Stress',      defaultVal=1.0e-8_pReal)
+  num%subStepMinCryst        = num_crystallite%get_asReal ('subStepMin',       defaultVal=1.0e-3_pREAL)
+  num%subStepSizeCryst       = num_crystallite%get_asReal ('subStepSize',      defaultVal=0.25_pREAL)
+  num%stepIncreaseCryst      = num_crystallite%get_asReal ('stepIncrease',     defaultVal=1.5_pREAL)
+  num%subStepSizeLp          = num_crystallite%get_asReal ('subStepSizeLp',    defaultVal=0.5_pREAL)
+  num%subStepSizeLi          = num_crystallite%get_asReal ('subStepSizeLi',    defaultVal=0.5_pREAL)
+  num%rtol_crystalliteState  = num_crystallite%get_asReal ('rtol_State',       defaultVal=1.0e-6_pREAL)
+  num%rtol_crystalliteStress = num_crystallite%get_asReal ('rtol_Stress',      defaultVal=1.0e-6_pREAL)
+  num%atol_crystalliteStress = num_crystallite%get_asReal ('atol_Stress',      defaultVal=1.0e-8_pREAL)
   num%iJacoLpresiduum        = num_crystallite%get_asInt  ('iJacoLpresiduum',  defaultVal=1)
   num%nState                 = num_crystallite%get_asInt  ('nState',           defaultVal=20)
   num%nStress                = num_crystallite%get_asInt  ('nStress',          defaultVal=40)
 
   extmsg = ''
-  if (num%subStepMinCryst   <= 0.0_pReal)      extmsg = trim(extmsg)//' subStepMinCryst'
-  if (num%subStepSizeCryst  <= 0.0_pReal)      extmsg = trim(extmsg)//' subStepSizeCryst'
-  if (num%stepIncreaseCryst <= 0.0_pReal)      extmsg = trim(extmsg)//' stepIncreaseCryst'
-  if (num%subStepSizeLp <= 0.0_pReal)          extmsg = trim(extmsg)//' subStepSizeLp'
-  if (num%subStepSizeLi <= 0.0_pReal)          extmsg = trim(extmsg)//' subStepSizeLi'
-  if (num%rtol_crystalliteState  <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteState'
-  if (num%rtol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteStress'
-  if (num%atol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_crystalliteStress'
+  if (num%subStepMinCryst   <= 0.0_pREAL)      extmsg = trim(extmsg)//' subStepMinCryst'
+  if (num%subStepSizeCryst  <= 0.0_pREAL)      extmsg = trim(extmsg)//' subStepSizeCryst'
+  if (num%stepIncreaseCryst <= 0.0_pREAL)      extmsg = trim(extmsg)//' stepIncreaseCryst'
+  if (num%subStepSizeLp <= 0.0_pREAL)          extmsg = trim(extmsg)//' subStepSizeLp'
+  if (num%subStepSizeLi <= 0.0_pREAL)          extmsg = trim(extmsg)//' subStepSizeLi'
+  if (num%rtol_crystalliteState  <= 0.0_pREAL) extmsg = trim(extmsg)//' rtol_crystalliteState'
+  if (num%rtol_crystalliteStress <= 0.0_pREAL) extmsg = trim(extmsg)//' rtol_crystalliteStress'
+  if (num%atol_crystalliteStress <= 0.0_pREAL) extmsg = trim(extmsg)//' atol_crystalliteStress'
   if (num%iJacoLpresiduum < 1)                 extmsg = trim(extmsg)//' iJacoLpresiduum'
   if (num%nState  < 1)                         extmsg = trim(extmsg)//' nState'
   if (num%nStress < 1)                         extmsg = trim(extmsg)//' nStress'
@@ -615,13 +615,13 @@ end subroutine crystallite_orientations
 !--------------------------------------------------------------------------------------------------
 function crystallite_push33ToRef(co,ce, tensor33)
 
-  real(pReal), dimension(3,3), intent(in) :: tensor33
+  real(pREAL), dimension(3,3), intent(in) :: tensor33
   integer, intent(in):: &
     co, &
     ce
-  real(pReal), dimension(3,3) :: crystallite_push33ToRef
+  real(pREAL), dimension(3,3) :: crystallite_push33ToRef
 
-  real(pReal), dimension(3,3) :: T
+  real(pREAL), dimension(3,3) :: T
   integer :: ph, en
 
 
@@ -639,9 +639,9 @@ end function crystallite_push33ToRef
 !--------------------------------------------------------------------------------------------------
 logical pure function converged(residuum,state,atol)
 
-  real(pReal), intent(in), dimension(:) ::&
+  real(pREAL), intent(in), dimension(:) ::&
     residuum, state, atol
-  real(pReal) :: &
+  real(pREAL) :: &
     rTol
 
   rTol = num%rTol_crystalliteState

src/phase_damage.f90

@@ -4,9 +4,9 @@
 submodule(phase) damage
 
   type :: tDamageParameters
-    real(pReal) :: &
-      mu = 0.0_pReal, &                                                                             !< viscosity
-      l_c = 0.0_pReal                                                                               !< characteristic length
+    real(pREAL) :: &
+      mu = 0.0_pREAL, &                                                                             !< viscosity
+      l_c = 0.0_pREAL                                                                               !< characteristic length
   end type tDamageParameters
 
   enum, bind(c); enumerator :: &
@@ -19,7 +19,7 @@ submodule(phase) damage
 
 
   type :: tDataContainer
-    real(pReal), dimension(:), allocatable :: phi
+    real(pREAL), dimension(:), allocatable :: phi
   end type tDataContainer
 
   integer(kind(DAMAGE_UNDEFINED_ID)),     dimension(:), allocatable :: &
@@ -42,16 +42,16 @@ submodule(phase) damage
 
     module subroutine isobrittle_deltaState(C, Fe, ph, en)
       integer, intent(in) :: ph,en
-      real(pReal),  intent(in), dimension(3,3) :: &
+      real(pREAL),  intent(in), dimension(3,3) :: &
         Fe
-      real(pReal),  intent(in), dimension(6,6) :: &
+      real(pREAL),  intent(in), dimension(6,6) :: &
         C
     end subroutine isobrittle_deltaState
 
 
     module subroutine anisobrittle_dotState(M_i, ph, en)
       integer, intent(in) :: ph,en
-      real(pReal),  intent(in), dimension(3,3) :: &
+      real(pREAL),  intent(in), dimension(3,3) :: &
         M_i
     end subroutine anisobrittle_dotState
 
@@ -99,7 +99,7 @@ module subroutine damage_init()
 
     Nmembers = count(material_ID_phase == ph)
 
-    allocate(current(ph)%phi(Nmembers),source=1.0_pReal)
+    allocate(current(ph)%phi(Nmembers),source=1.0_pREAL)
 
     phase => phases%get_dict(ph)
     source => phase%get_dict('damage',defaultVal=emptyDict)
@@ -131,7 +131,7 @@ end subroutine damage_init
 !--------------------------------------------------------------------------------------------------
 module function phase_damage_constitutive(Delta_t,co,ce) result(converged_)
 
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: &
     co, &
     ce
@@ -154,9 +154,9 @@ end function phase_damage_constitutive
 !--------------------------------------------------------------------------------------------------
 module function phase_damage_C66(C66,ph,en) result(C66_degraded)
 
-  real(pReal), dimension(6,6), intent(in)  :: C66
+  real(pREAL), dimension(6,6), intent(in)  :: C66
   integer,                     intent(in)  :: ph,en
-  real(pReal), dimension(6,6) :: C66_degraded
+  real(pREAL), dimension(6,6) :: C66_degraded
 
 
   damageType: select case (phase_damage(ph))
@@ -195,9 +195,9 @@ end subroutine damage_restore
 module function phase_f_phi(phi,co,ce) result(f)
 
   integer, intent(in) :: ce,co
-  real(pReal), intent(in) :: &
+  real(pREAL), intent(in) :: &
     phi                                                                                             !< damage parameter
-  real(pReal) :: &
+  real(pREAL) :: &
     f
 
   integer :: &
@@ -209,10 +209,10 @@ module function phase_f_phi(phi,co,ce) result(f)
 
   select case(phase_damage(ph))
     case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID)
-      f = 1.0_pReal &
+      f = 1.0_pREAL &
         - phi*damageState(ph)%state(1,en)
     case default
-      f = 0.0_pReal
+      f = 0.0_pREAL
   end select
 
 end function phase_f_phi
@@ -224,7 +224,7 @@ end function phase_f_phi
 !--------------------------------------------------------------------------------------------------
 function integrateDamageState(Delta_t,ph,en) result(broken)
 
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: &
     ph, &
     en
@@ -233,11 +233,11 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
   integer :: &
     NiterationState, &                                                                              !< number of iterations in state loop
     size_so
-  real(pReal) :: &
+  real(pREAL) :: &
     zeta
-  real(pReal), dimension(phase_damage_maxSizeDotState) :: &
+  real(pREAL), dimension(phase_damage_maxSizeDotState) :: &
     r                                                                                               ! state residuum
-  real(pReal), dimension(phase_damage_maxSizeDotState,2) :: source_dotState
+  real(pREAL), dimension(phase_damage_maxSizeDotState,2) :: source_dotState
   logical :: &
     converged_
 
@@ -254,7 +254,7 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
   size_so = damageState(ph)%sizeDotState
   damageState(ph)%state(1:size_so,en) = damageState(ph)%state0  (1:size_so,en) &
                                       + damageState(ph)%dotState(1:size_so,en) * Delta_t
-  source_dotState(1:size_so,2) = 0.0_pReal
+  source_dotState(1:size_so,2) = 0.0_pREAL
 
   iteration: do NiterationState = 1, num%nState
 
@@ -267,7 +267,7 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
 
       zeta = damper(damageState(ph)%dotState(:,en),source_dotState(1:size_so,1),source_dotState(1:size_so,2))
       damageState(ph)%dotState(:,en) = damageState(ph)%dotState(:,en) * zeta &
-                                     + source_dotState(1:size_so,1)* (1.0_pReal - zeta)
+                                     + source_dotState(1:size_so,1)* (1.0_pREAL - zeta)
       r(1:size_so) = damageState(ph)%state   (1:size_so,en)  &
                    - damageState(ph)%State0  (1:size_so,en)  &
                    - damageState(ph)%dotState(1:size_so,en) * Delta_t
@@ -291,20 +291,20 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
   !--------------------------------------------------------------------------------------------------
   !> @brief Calculate the damping for correction of state and dot state.
   !--------------------------------------------------------------------------------------------------
-  real(pReal) pure function damper(omega_0,omega_1,omega_2)
+  real(pREAL) pure function damper(omega_0,omega_1,omega_2)
 
-  real(pReal), dimension(:), intent(in) :: &
+  real(pREAL), dimension(:), intent(in) :: &
     omega_0, omega_1, omega_2
 
-  real(pReal) :: dot_prod12, dot_prod22
+  real(pREAL) :: dot_prod12, dot_prod22
 
   dot_prod12 = dot_product(omega_0-omega_1, omega_1-omega_2)
   dot_prod22 = dot_product(omega_1-omega_2, omega_1-omega_2)
 
-  if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pReal .and. dot_prod22 > 0.0_pReal) then
-    damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22)
+  if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pREAL .and. dot_prod22 > 0.0_pREAL) then
+    damper = 0.75_pREAL + 0.25_pREAL * tanh(2.0_pREAL + 4.0_pREAL * dot_prod12 / dot_prod22)
   else
-    damper = 1.0_pReal
+    damper = 1.0_pREAL
   end if
 
   end function damper
@@ -401,7 +401,7 @@ end function phase_damage_collectDotState
 module function phase_mu_phi(co,ce) result(mu)
 
   integer, intent(in) :: co, ce
-  real(pReal) :: mu
+  real(pREAL) :: mu
 
 
   mu = param(material_ID_phase(co,ce))%mu
@@ -415,7 +415,7 @@ end function phase_mu_phi
 module function phase_K_phi(co,ce) result(K)
 
   integer, intent(in) :: co, ce
-  real(pReal), dimension(3,3) :: K
+  real(pREAL), dimension(3,3) :: K
 
 
   K = crystallite_push33ToRef(co,ce,param(material_ID_phase(co,ce))%l_c**2*math_I3)
@@ -432,7 +432,7 @@ function phase_damage_deltaState(Fe, ph, en) result(broken)
   integer, intent(in) :: &
     ph, &
     en
-  real(pReal),   intent(in), dimension(3,3) :: &
+  real(pREAL),   intent(in), dimension(3,3) :: &
     Fe                                                                                              !< elastic deformation gradient
 
   integer :: &
@@ -496,7 +496,7 @@ end function source_active
 !----------------------------------------------------------------------------------------------
 module subroutine phase_set_phi(phi,co,ce)
 
-  real(pReal), intent(in) :: phi
+  real(pREAL), intent(in) :: phi
   integer, intent(in) :: ce, co
 
 
@@ -508,7 +508,7 @@ end subroutine phase_set_phi
 module function damage_phi(ph,en) result(phi)
 
   integer, intent(in) :: ph, en
-  real(pReal) :: phi
+  real(pREAL) :: phi
 
 
   phi = current(ph)%phi(en)

src/phase_damage_anisobrittle.f90

@@ -7,13 +7,13 @@
 submodule (phase:damage) anisobrittle
 
   type :: tParameters                                                                               !< container type for internal constitutive parameters
-    real(pReal) :: &
+    real(pREAL) :: &
       dot_o_0, &                                                                                    !< opening rate of cleavage planes
       p                                                                                             !< damage rate sensitivity
-    real(pReal), dimension(:), allocatable :: &
+    real(pREAL), dimension(:), allocatable :: &
       s_crit, &                                                                                     !< critical displacement
       g_crit                                                                                        !< critical load
-    real(pReal), dimension(:,:,:,:), allocatable :: &
+    real(pREAL), dimension(:,:,:,:), allocatable :: &
       cleavage_systems
     integer :: &
       sum_N_cl                                                                                      !< total number of cleavage planes
@@ -90,15 +90,15 @@ module function anisobrittle_init() result(mySources)
 #endif
 
         ! sanity checks
-        if (prm%p          <= 0.0_pReal)  extmsg = trim(extmsg)//' p'
-        if (prm%dot_o_0    <= 0.0_pReal)  extmsg = trim(extmsg)//' dot_o_0'
-        if (any(prm%g_crit <  0.0_pReal)) extmsg = trim(extmsg)//' g_crit'
-        if (any(prm%s_crit <  0.0_pReal)) extmsg = trim(extmsg)//' s_crit'
+        if (prm%p          <= 0.0_pREAL)  extmsg = trim(extmsg)//' p'
+        if (prm%dot_o_0    <= 0.0_pREAL)  extmsg = trim(extmsg)//' dot_o_0'
+        if (any(prm%g_crit <  0.0_pREAL)) extmsg = trim(extmsg)//' g_crit'
+        if (any(prm%s_crit <  0.0_pREAL)) extmsg = trim(extmsg)//' s_crit'
 
         Nmembers = count(material_ID_phase==ph)
         call phase_allocateState(damageState(ph),Nmembers,1,1,0)
-        damageState(ph)%atol = src%get_asReal('atol_phi',defaultVal=1.0e-9_pReal)
-        if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
+        damageState(ph)%atol = src%get_asReal('atol_phi',defaultVal=1.0e-9_pREAL)
+        if (any(damageState(ph)%atol < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_phi'
 
       end associate
 
@@ -117,17 +117,17 @@ module subroutine anisobrittle_dotState(M_i, ph,en)
 
   integer, intent(in) :: &
     ph,en
-  real(pReal),  intent(in), dimension(3,3) :: &
+  real(pREAL),  intent(in), dimension(3,3) :: &
     M_i
 
   integer :: &
     a, i
-  real(pReal) :: &
+  real(pREAL) :: &
     traction, traction_crit
 
 
   associate(prm => param(ph))
-    damageState(ph)%dotState(1,en) = 0.0_pReal
+    damageState(ph)%dotState(1,en) = 0.0_pREAL
     do a = 1, prm%sum_N_cl
       traction_crit = damage_phi(ph,en)**2 * prm%g_crit(a)
       do i = 1,3
@@ -135,7 +135,7 @@ module subroutine anisobrittle_dotState(M_i, ph,en)
 
         damageState(ph)%dotState(1,en) = damageState(ph)%dotState(1,en) &
           + prm%dot_o_0 / prm%s_crit(a) &
-            * (max(0.0_pReal, abs(traction) - traction_crit)/traction_crit)**prm%p
+            * (max(0.0_pREAL, abs(traction) - traction_crit)/traction_crit)**prm%p
       end do
     end do
   end associate
@@ -173,22 +173,22 @@ module subroutine damage_anisobrittle_LiAndItsTangent(L_i, dL_i_dM_i, M_i, ph,en
 
   integer, intent(in) :: &
     ph,en
-  real(pReal),   intent(in),  dimension(3,3) :: &
+  real(pREAL),   intent(in),  dimension(3,3) :: &
     M_i
-  real(pReal),   intent(out), dimension(3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3) :: &
     L_i                                                                                             !< damage velocity gradient
-  real(pReal),   intent(out), dimension(3,3,3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3,3,3) :: &
     dL_i_dM_i                                                                                       !< derivative of L_i with respect to M_i
 
   integer :: &
     a, k, l, m, n, i
-  real(pReal) :: &
+  real(pREAL) :: &
     traction, traction_crit, &
     udot, dudot_dt
 
 
-  L_i = 0.0_pReal
-  dL_i_dM_i = 0.0_pReal
+  L_i = 0.0_pREAL
+  dL_i_dM_i = 0.0_pREAL
   associate(prm => param(ph))
     do a = 1,prm%sum_N_cl
       traction_crit = damage_phi(ph,en)**2 * prm%g_crit(a)
@@ -196,9 +196,9 @@ module subroutine damage_anisobrittle_LiAndItsTangent(L_i, dL_i_dM_i, M_i, ph,en
       do i = 1, 3
         traction = math_tensordot(M_i,prm%cleavage_systems(1:3,1:3,i,a))
         if (abs(traction) > traction_crit + tol_math_check) then
-          udot = sign(1.0_pReal,traction)* prm%dot_o_0 * ((abs(traction) - traction_crit)/traction_crit)**prm%p
+          udot = sign(1.0_pREAL,traction)* prm%dot_o_0 * ((abs(traction) - traction_crit)/traction_crit)**prm%p
           L_i = L_i + udot*prm%cleavage_systems(1:3,1:3,i,a)
-          dudot_dt = sign(1.0_pReal,traction)*udot*prm%p / (abs(traction) - traction_crit)
+          dudot_dt = sign(1.0_pREAL,traction)*udot*prm%p / (abs(traction) - traction_crit)
           forall (k=1:3,l=1:3,m=1:3,n=1:3) &
             dL_i_dM_i(k,l,m,n) = dL_i_dM_i(k,l,m,n) &
                                + dudot_dt*prm%cleavage_systems(k,l,i,a) * prm%cleavage_systems(m,n,i,a)

src/phase_damage_isobrittle.f90

@@ -7,14 +7,14 @@
 submodule(phase:damage) isobrittle
 
   type :: tParameters                                                                               !< container type for internal constitutive parameters
-    real(pReal) :: &
+    real(pREAL) :: &
       W_crit                                                                                        !< critical elastic strain energy
     character(len=pSTRLEN), allocatable, dimension(:) :: &
       output
   end type tParameters
 
   type :: tIsobrittleState
-    real(pReal), pointer, dimension(:) :: &                                                         !< vectors along Nmembers
+    real(pREAL), pointer, dimension(:) :: &                                                         !< vectors along Nmembers
       r_W                                                                                           !< ratio between actual and critical strain energy density
   end type tIsobrittleState
 
@@ -77,12 +77,12 @@ module function isobrittle_init() result(mySources)
 #endif
 
         ! sanity checks
-        if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit'
+        if (prm%W_crit <= 0.0_pREAL) extmsg = trim(extmsg)//' W_crit'
 
         Nmembers = count(material_ID_phase==ph)
         call phase_allocateState(damageState(ph),Nmembers,1,0,1)
-        damageState(ph)%atol = src%get_asReal('atol_phi',defaultVal=1.0e-9_pReal)
-        if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
+        damageState(ph)%atol = src%get_asReal('atol_phi',defaultVal=1.0e-9_pREAL)
+        if (any(damageState(ph)%atol < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_phi'
 
         stt%r_W => damageState(ph)%state(1,:)
         dlt%r_W => damageState(ph)%deltaState(1,:)
@@ -105,23 +105,23 @@ end function isobrittle_init
 module subroutine isobrittle_deltaState(C, Fe, ph,en)
 
   integer, intent(in) :: ph,en
-  real(pReal),  intent(in), dimension(3,3) :: &
+  real(pREAL),  intent(in), dimension(3,3) :: &
     Fe
-  real(pReal),  intent(in), dimension(6,6) :: &
+  real(pREAL),  intent(in), dimension(6,6) :: &
     C
 
-  real(pReal), dimension(6) :: &
+  real(pREAL), dimension(6) :: &
     epsilon
-  real(pReal) :: &
+  real(pREAL) :: &
     r_W
 
 
-  epsilon = math_33toVoigt6_strain(0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3))
+  epsilon = math_33toVoigt6_strain(0.5_pREAL*(matmul(transpose(Fe),Fe)-math_I3))
 
   associate(prm => param(ph), stt => state(ph), dlt => deltaState(ph))
 
-    r_W = (0.5_pReal*dot_product(epsilon,matmul(C,epsilon)))/prm%W_crit
-    dlt%r_W(en) = merge(r_W - stt%r_W(en), 0.0_pReal, r_W > stt%r_W(en))
+    r_W = (0.5_pREAL*dot_product(epsilon,matmul(C,epsilon)))/prm%W_crit
+    dlt%r_W(en) = merge(r_W - stt%r_W(en), 0.0_pREAL, r_W > stt%r_W(en))
 
   end associate
 

src/phase_mechanical.f90

@@ -57,22 +57,22 @@ submodule(phase) mechanical
       integer, intent(in) :: &
         ph, &
         en
-      real(pReal),   intent(in),  dimension(3,3) :: &
+      real(pREAL),   intent(in),  dimension(3,3) :: &
         Fe, &                                                                                       !< elastic deformation gradient
         Fi                                                                                          !< intermediate deformation gradient
-      real(pReal),   intent(out), dimension(3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3) :: &
         S                                                                                           !< 2nd Piola-Kirchhoff stress tensor in lattice configuration
-      real(pReal),   intent(out), dimension(3,3,3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3,3,3) :: &
         dS_dFe, &                                                                                   !< derivative of 2nd P-K stress with respect to elastic deformation gradient
         dS_dFi                                                                                      !< derivative of 2nd P-K stress with respect to intermediate deformation gradient
     end subroutine phase_hooke_SandItsTangents
 
     module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
-      real(pReal), dimension(3,3),     intent(out) :: &
+      real(pREAL), dimension(3,3),     intent(out) :: &
         Li                                                                                          !< inleastic velocity gradient
-      real(pReal), dimension(3,3,3,3), intent(out)  :: &
+      real(pREAL), dimension(3,3,3,3), intent(out)  :: &
         dLi_dMi                                                                                     !< derivative of Li with respect to Mandel stress
-      real(pReal), dimension(3,3),     intent(in) :: &
+      real(pREAL), dimension(3,3),     intent(in) :: &
         Mi                                                                                          !< Mandel stress
       integer,                         intent(in) :: &
         ph, &
@@ -83,9 +83,9 @@ submodule(phase) mechanical
       integer, intent(in) :: &
         ph, &
         en
-      real(pReal),  intent(in) :: &
+      real(pREAL),  intent(in) :: &
         subdt                                                                                           !< timestep
-      real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+      real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
         dotState
     end function plastic_dotState
 
@@ -101,13 +101,13 @@ submodule(phase) mechanical
                                              S, Fi, ph,en)
       integer, intent(in) :: &
         ph,en
-      real(pReal),   intent(in),  dimension(3,3) :: &
+      real(pREAL),   intent(in),  dimension(3,3) :: &
         S                                                                                               !< 2nd Piola-Kirchhoff stress
-      real(pReal),   intent(in),  dimension(3,3) :: &
+      real(pREAL),   intent(in),  dimension(3,3) :: &
         Fi                                                                                              !< intermediate deformation gradient
-      real(pReal),   intent(out), dimension(3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3) :: &
         Li                                                                                              !< intermediate velocity gradient
-      real(pReal),   intent(out), dimension(3,3,3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3,3,3) :: &
         dLi_dS, &                                                                                       !< derivative of Li with respect to S
         dLi_dFi
 
@@ -118,12 +118,12 @@ submodule(phase) mechanical
                                                S, Fi, ph,en)
       integer, intent(in) :: &
         ph,en
-      real(pReal),   intent(in),  dimension(3,3) :: &
+      real(pREAL),   intent(in),  dimension(3,3) :: &
         S, &                                                                                            !< 2nd Piola-Kirchhoff stress
         Fi                                                                                              !< intermediate deformation gradient
-      real(pReal),   intent(out), dimension(3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3) :: &
         Lp                                                                                              !< plastic velocity gradient
-      real(pReal),   intent(out), dimension(3,3,3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3,3,3) :: &
         dLp_dS, &
         dLp_dFi                                                                                         !< derivative of Lp with respect to Fi
     end subroutine plastic_LpAndItsTangents
@@ -160,23 +160,23 @@ submodule(phase) mechanical
     end subroutine plastic_nonlocal_result
 
     module function plastic_dislotwin_homogenizedC(ph,en) result(homogenizedC)
-      real(pReal), dimension(6,6) :: homogenizedC
+      real(pREAL), dimension(6,6) :: homogenizedC
       integer,     intent(in) :: ph,en
     end function plastic_dislotwin_homogenizedC
 
     pure module function elastic_C66(ph,en) result(C66)
-      real(pReal), dimension(6,6) :: C66
+      real(pREAL), dimension(6,6) :: C66
       integer,     intent(in) :: ph, en
     end function elastic_C66
 
     pure module function elastic_mu(ph,en,isotropic_bound) result(mu)
-      real(pReal) :: mu
+      real(pREAL) :: mu
       integer, intent(in) :: ph, en
       character(len=*), intent(in) :: isotropic_bound
     end function elastic_mu
 
     pure module function elastic_nu(ph,en,isotropic_bound) result(nu)
-      real(pReal) :: nu
+      real(pREAL) :: nu
       integer, intent(in) :: ph, en
       character(len=*), intent(in) :: isotropic_bound
     end function elastic_nu
@@ -243,13 +243,13 @@ module subroutine mechanical_init(phases)
     allocate(phase_mechanical_Fi(ph)%data(3,3,Nmembers))
     allocate(phase_mechanical_Fp(ph)%data(3,3,Nmembers))
     allocate(phase_mechanical_F(ph)%data(3,3,Nmembers))
-    allocate(phase_mechanical_Li(ph)%data(3,3,Nmembers),source=0.0_pReal)
-    allocate(phase_mechanical_Li0(ph)%data(3,3,Nmembers),source=0.0_pReal)
-    allocate(phase_mechanical_Lp(ph)%data(3,3,Nmembers),source=0.0_pReal)
-    allocate(phase_mechanical_Lp0(ph)%data(3,3,Nmembers),source=0.0_pReal)
-    allocate(phase_mechanical_S(ph)%data(3,3,Nmembers),source=0.0_pReal)
-    allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pReal)
-    allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pReal)
+    allocate(phase_mechanical_Li(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+    allocate(phase_mechanical_Li0(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+    allocate(phase_mechanical_Lp(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+    allocate(phase_mechanical_Lp0(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+    allocate(phase_mechanical_S(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+    allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+    allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pREAL)
 
     phase => phases%get_dict(ph)
     mech  => phase%get_dict('mechanical')
@@ -359,11 +359,11 @@ end subroutine mechanical_result
 !--------------------------------------------------------------------------------------------------
 function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
 
-  real(pReal), dimension(3,3), intent(in) :: F,subFp0,subFi0
-  real(pReal),                 intent(in) :: Delta_t
+  real(pREAL), dimension(3,3), intent(in) :: F,subFp0,subFi0
+  real(pREAL),                 intent(in) :: Delta_t
   integer, intent(in) :: ph, en
 
-  real(pReal), dimension(3,3)::       Fp_new, &                                                     ! plastic deformation gradient at end of timestep
+  real(pREAL), dimension(3,3)::       Fp_new, &                                                     ! plastic deformation gradient at end of timestep
                                       invFp_new, &                                                  ! inverse of Fp_new
                                       invFp_current, &                                              ! inverse of Fp_current
                                       Lpguess, &                                                    ! current guess for plastic velocity gradient
@@ -386,11 +386,11 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
                                       A, &
                                       B, &
                                       temp_33
-  real(pReal), dimension(9) ::        temp_9                                                        ! needed for matrix inversion by LAPACK
+  real(pREAL), dimension(9) ::        temp_9                                                        ! needed for matrix inversion by LAPACK
   integer,     dimension(9) ::        devNull_9                                                     ! needed for matrix inversion by LAPACK
-  real(pReal), dimension(9,9) ::      dRLp_dLp, &                                                   ! partial derivative of residuum (Jacobian for Newton-Raphson scheme)
+  real(pREAL), dimension(9,9) ::      dRLp_dLp, &                                                   ! partial derivative of residuum (Jacobian for Newton-Raphson scheme)
                                       dRLi_dLi                                                      ! partial derivative of residuumI (Jacobian for Newton-Raphson scheme)
-  real(pReal), dimension(3,3,3,3)::   dS_dFe, &                                                     ! partial derivative of 2nd Piola-Kirchhoff stress
+  real(pREAL), dimension(3,3,3,3)::   dS_dFe, &                                                     ! partial derivative of 2nd Piola-Kirchhoff stress
                                       dS_dFi, &
                                       dFe_dLp, &                                                    ! partial derivative of elastic deformation gradient
                                       dFe_dLi, &
@@ -399,7 +399,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
                                       dLi_dFi, &
                                       dLp_dS, &
                                       dLi_dS
-  real(pReal)                         steplengthLp, &
+  real(pREAL)                         steplengthLp, &
                                       steplengthLi, &
                                       atol_Lp, &
                                       atol_Li
@@ -427,8 +427,8 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
   A = matmul(F,invFp_current)                                                                       ! intermediate tensor needed later to calculate dFe_dLp
 
   jacoCounterLi  = 0
-  steplengthLi   = 1.0_pReal
-  residuumLi_old = 0.0_pReal
+  steplengthLi   = 1.0_pREAL
+  residuumLi_old = 0.0_pREAL
   Liguess_old    = Liguess
 
   NiterationStressLi = 0
@@ -440,8 +440,8 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
     Fi_new    = math_inv33(invFi_new)
 
     jacoCounterLp  = 0
-    steplengthLp   = 1.0_pReal
-    residuumLp_old = 0.0_pReal
+    steplengthLp   = 1.0_pREAL
+    residuumLp_old = 0.0_pREAL
     Lpguess_old    = Lpguess
 
     NiterationStressLp = 0
@@ -469,7 +469,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
       elseif (NiterationStressLp == 1 .or. norm2(residuumLp) < norm2(residuumLp_old)) then          ! not converged, but improved norm of residuum (always proceed in first iteration)...
         residuumLp_old = residuumLp                                                                 ! ...remember old values and...
         Lpguess_old    = Lpguess
-        steplengthLp   = 1.0_pReal                                                                  ! ...proceed with normal step length (calculate new search direction)
+        steplengthLp   = 1.0_pREAL                                                                  ! ...proceed with normal step length (calculate new search direction)
       else                                                                                          ! not converged and residuum not improved...
         steplengthLp = num%subStepSizeLp * steplengthLp                                             ! ...try with smaller step length in same direction
         Lpguess      = Lpguess_old &
@@ -509,7 +509,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
     elseif (NiterationStressLi == 1 .or. norm2(residuumLi) < norm2(residuumLi_old)) then            ! not converged, but improved norm of residuum (always proceed in first iteration)...
       residuumLi_old = residuumLi                                                                   ! ...remember old values and...
       Liguess_old    = Liguess
-      steplengthLi   = 1.0_pReal                                                                    ! ...proceed with normal step length (calculate new search direction)
+      steplengthLi   = 1.0_pREAL                                                                    ! ...proceed with normal step length (calculate new search direction)
     else                                                                                            ! not converged and residuum not improved...
       steplengthLi = num%subStepSizeLi * steplengthLi                                               ! ...try with smaller step length in same direction
       Liguess      = Liguess_old &
@@ -550,7 +550,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
   phase_mechanical_S(ph)%data(1:3,1:3,en)  = S
   phase_mechanical_Lp(ph)%data(1:3,1:3,en) = Lpguess
   phase_mechanical_Li(ph)%data(1:3,1:3,en) = Liguess
-  phase_mechanical_Fp(ph)%data(1:3,1:3,en) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal)    ! regularize
+  phase_mechanical_Fp(ph)%data(1:3,1:3,en) = Fp_new / math_det33(Fp_new)**(1.0_pREAL/3.0_pREAL)    ! regularize
   phase_mechanical_Fi(ph)%data(1:3,1:3,en) = Fi_new
   phase_mechanical_Fe(ph)%data(1:3,1:3,en) = matmul(matmul(F,invFp_new),invFi_new)
   broken = .false.
@@ -564,9 +564,9 @@ end function integrateStress
 !--------------------------------------------------------------------------------------------------
 function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
 
-  real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
-  real(pReal), intent(in),dimension(:)   :: subState0
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+  real(pREAL), intent(in),dimension(:)   :: subState0
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: &
     ph, &
     en
@@ -576,12 +576,12 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
   integer :: &
     NiterationState, &                                                                              !< number of iterations in state loop
     sizeDotState
-  real(pReal) :: &
+  real(pREAL) :: &
     zeta
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     r, &                                                                                            ! state residuum
     dotState
-  real(pReal), dimension(plasticState(ph)%sizeDotState,2) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState,2) :: &
     dotState_last
 
 
@@ -595,7 +595,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
 
   iteration: do NiterationState = 1, num%nState
 
-    dotState_last(1:sizeDotState,2) = merge(dotState_last(1:sizeDotState,1),0.0_pReal, nIterationState > 1)
+    dotState_last(1:sizeDotState,2) = merge(dotState_last(1:sizeDotState,1),0.0_pREAL, nIterationState > 1)
     dotState_last(1:sizeDotState,1) = dotState
 
     broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
@@ -606,7 +606,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
 
     zeta = damper(dotState,dotState_last(1:sizeDotState,1),dotState_last(1:sizeDotState,2))
     dotState = dotState * zeta &
-             + dotState_last(1:sizeDotState,1) * (1.0_pReal - zeta)
+             + dotState_last(1:sizeDotState,1) * (1.0_pREAL - zeta)
     r = plasticState(ph)%state(1:sizeDotState,en) &
       - subState0 &
       - dotState * Delta_t
@@ -625,21 +625,21 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
   !--------------------------------------------------------------------------------------------------
   !> @brief calculate the damping for correction of state and dot state
   !--------------------------------------------------------------------------------------------------
-  real(pReal) pure function damper(omega_0,omega_1,omega_2)
+  real(pREAL) pure function damper(omega_0,omega_1,omega_2)
 
-    real(pReal), dimension(:), intent(in) :: &
+    real(pREAL), dimension(:), intent(in) :: &
       omega_0, omega_1, omega_2
 
-    real(pReal) :: dot_prod12, dot_prod22
+    real(pREAL) :: dot_prod12, dot_prod22
 
 
     dot_prod12 = dot_product(omega_0-omega_1, omega_1-omega_2)
     dot_prod22 = dot_product(omega_1-omega_2, omega_1-omega_2)
 
-    if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pReal .and. dot_prod22 > 0.0_pReal) then
-      damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22)
+    if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pREAL .and. dot_prod22 > 0.0_pREAL) then
+      damper = 0.75_pREAL + 0.25_pREAL * tanh(2.0_pREAL + 4.0_pREAL * dot_prod12 / dot_prod22)
     else
-      damper = 1.0_pReal
+      damper = 1.0_pREAL
     end if
 
   end function damper
@@ -652,16 +652,16 @@ end function integrateStateFPI
 !--------------------------------------------------------------------------------------------------
 function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
 
-  real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
-  real(pReal), intent(in),dimension(:)   :: subState0
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+  real(pREAL), intent(in),dimension(:)   :: subState0
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: &
     ph, &
     en                                                                                               !< grain index in grain loop
   logical :: &
     broken
 
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
   integer :: &
     sizeDotState
@@ -692,9 +692,9 @@ end function integrateStateEuler
 !--------------------------------------------------------------------------------------------------
 function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
 
-  real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
-  real(pReal), intent(in),dimension(:)   :: subState0
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+  real(pREAL), intent(in),dimension(:)   :: subState0
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: &
     ph, &
     en
@@ -703,7 +703,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
 
   integer :: &
     sizeDotState
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     r, &
     dotState
 
@@ -715,7 +715,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
 
   sizeDotState = plasticState(ph)%sizeDotState
 
-  r = - dotState * 0.5_pReal * Delta_t
+  r = - dotState * 0.5_pREAL * Delta_t
 #ifndef __INTEL_LLVM_COMPILER
   plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
 #else
@@ -731,7 +731,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
   dotState = plastic_dotState(Delta_t,ph,en)
   if (any(IEEE_is_NaN(dotState))) return
 
-  broken = .not. converged(r + 0.5_pReal * dotState * Delta_t, &
+  broken = .not. converged(r + 0.5_pREAL * dotState * Delta_t, &
                            plasticState(ph)%state(1:sizeDotState,en), &
                            plasticState(ph)%atol(1:sizeDotState))
 
@@ -743,22 +743,22 @@ end function integrateStateAdaptiveEuler
 !---------------------------------------------------------------------------------------------------
 function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
 
-  real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
-  real(pReal), intent(in),dimension(:)   :: subState0
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+  real(pREAL), intent(in),dimension(:)   :: subState0
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: ph, en
   logical :: broken
 
-  real(pReal), dimension(3,3), parameter :: &
+  real(pREAL), dimension(3,3), parameter :: &
     A = reshape([&
-      0.5_pReal, 0.0_pReal, 0.0_pReal, &
-      0.0_pReal, 0.5_pReal, 0.0_pReal, &
-      0.0_pReal, 0.0_pReal, 1.0_pReal],&
+      0.5_pREAL, 0.0_pREAL, 0.0_pREAL, &
+      0.0_pREAL, 0.5_pREAL, 0.0_pREAL, &
+      0.0_pREAL, 0.0_pREAL, 1.0_pREAL],&
       shape(A))
-  real(pReal), dimension(3), parameter :: &
-    C = [0.5_pReal, 0.5_pReal, 1.0_pReal]
-  real(pReal), dimension(4), parameter :: &
-    B = [6.0_pReal, 3.0_pReal, 3.0_pReal, 6.0_pReal]**(-1)
+  real(pREAL), dimension(3), parameter :: &
+    C = [0.5_pREAL, 0.5_pREAL, 1.0_pREAL]
+  real(pREAL), dimension(4), parameter :: &
+    B = [6.0_pREAL, 3.0_pREAL, 3.0_pREAL, 6.0_pREAL]**(-1)
 
 
   broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C)
@@ -771,29 +771,29 @@ end function integrateStateRK4
 !---------------------------------------------------------------------------------------------------
 function integrateStateRKCK45(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
 
-  real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
-  real(pReal), intent(in),dimension(:)   :: subState0
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+  real(pREAL), intent(in),dimension(:)   :: subState0
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: ph, en
   logical :: broken
 
-  real(pReal), dimension(5,5), parameter :: &
+  real(pREAL), dimension(5,5), parameter :: &
     A = reshape([&
-      1._pReal/5._pReal,       .0_pReal,             .0_pReal,               .0_pReal,                  .0_pReal, &
-      3._pReal/40._pReal,      9._pReal/40._pReal,   .0_pReal,               .0_pReal,                  .0_pReal, &
-      3_pReal/10._pReal,       -9._pReal/10._pReal,  6._pReal/5._pReal,      .0_pReal,                  .0_pReal, &
-      -11._pReal/54._pReal,    5._pReal/2._pReal,    -70.0_pReal/27.0_pReal, 35.0_pReal/27.0_pReal,     .0_pReal, &
-      1631._pReal/55296._pReal,175._pReal/512._pReal,575._pReal/13824._pReal,44275._pReal/110592._pReal,253._pReal/4096._pReal],&
+      1._pREAL/5._pREAL,       .0_pREAL,             .0_pREAL,               .0_pREAL,                  .0_pREAL, &
+      3._pREAL/40._pREAL,      9._pREAL/40._pREAL,   .0_pREAL,               .0_pREAL,                  .0_pREAL, &
+      3_pREAL/10._pREAL,       -9._pREAL/10._pREAL,  6._pREAL/5._pREAL,      .0_pREAL,                  .0_pREAL, &
+      -11._pREAL/54._pREAL,    5._pREAL/2._pREAL,    -70.0_pREAL/27.0_pREAL, 35.0_pREAL/27.0_pREAL,     .0_pREAL, &
+      1631._pREAL/55296._pREAL,175._pREAL/512._pREAL,575._pREAL/13824._pREAL,44275._pREAL/110592._pREAL,253._pREAL/4096._pREAL],&
       shape(A))
-  real(pReal), dimension(5), parameter :: &
-    C = [0.2_pReal, 0.3_pReal, 0.6_pReal, 1.0_pReal, 0.875_pReal]
-  real(pReal), dimension(6), parameter :: &
+  real(pREAL), dimension(5), parameter :: &
+    C = [0.2_pREAL, 0.3_pREAL, 0.6_pREAL, 1.0_pREAL, 0.875_pREAL]
+  real(pREAL), dimension(6), parameter :: &
     B = &
-      [37.0_pReal/378.0_pReal, .0_pReal, 250.0_pReal/621.0_pReal, &
-      125.0_pReal/594.0_pReal, .0_pReal, 512.0_pReal/1771.0_pReal], &
+      [37.0_pREAL/378.0_pREAL, .0_pREAL, 250.0_pREAL/621.0_pREAL, &
+      125.0_pREAL/594.0_pREAL, .0_pREAL, 512.0_pREAL/1771.0_pREAL], &
     DB = B - &
-      [2825.0_pReal/27648.0_pReal,    .0_pReal,                18575.0_pReal/48384.0_pReal,&
-      13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal,  1._pReal/4._pReal]
+      [2825.0_pREAL/27648.0_pREAL,    .0_pREAL,                18575.0_pREAL/48384.0_pREAL,&
+      13525.0_pREAL/55296.0_pREAL, 277.0_pREAL/14336.0_pREAL,  1._pREAL/4._pREAL]
 
 
   broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
@@ -807,12 +807,12 @@ end function integrateStateRKCK45
 !--------------------------------------------------------------------------------------------------
 function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB) result(broken)
 
-  real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
-  real(pReal), intent(in),dimension(:)   :: subState0
-  real(pReal), intent(in) :: Delta_t
-  real(pReal), dimension(:,:), intent(in) :: A
-  real(pReal), dimension(:),   intent(in) :: B, C
-  real(pReal), dimension(:),   intent(in), optional :: DB
+  real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+  real(pREAL), intent(in),dimension(:)   :: subState0
+  real(pREAL), intent(in) :: Delta_t
+  real(pREAL), dimension(:,:), intent(in) :: A
+  real(pREAL), dimension(:),   intent(in) :: B, C
+  real(pREAL), dimension(:),   intent(in), optional :: DB
   integer, intent(in) :: &
     ph, &
     en
@@ -822,9 +822,9 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
     stage, &                                                                                        ! stage index in integration stage loop
     n, &
     sizeDotState
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
-  real(pReal), dimension(plasticState(ph)%sizeDotState,size(B)) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState,size(B)) :: &
     plastic_RKdotState
 
 
@@ -945,7 +945,7 @@ subroutine results(group,ph)
   function to_quaternion(dataset)
 
     type(tRotation), dimension(:), intent(in) :: dataset
-    real(pReal), dimension(4,size(dataset,1)) :: to_quaternion
+    real(pREAL), dimension(4,size(dataset,1)) :: to_quaternion
 
     integer :: i
 
@@ -986,26 +986,26 @@ end subroutine mechanical_forward
 !--------------------------------------------------------------------------------------------------
 module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
 
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: &
     co, &
     ce
   logical :: converged_
 
-  real(pReal) :: &
+  real(pREAL) :: &
     formerSubStep
   integer :: &
     ph, en, sizeDotState
   logical :: todo
-  real(pReal) :: subFrac,subStep
-  real(pReal), dimension(3,3) :: &
+  real(pREAL) :: subFrac,subStep
+  real(pREAL), dimension(3,3) :: &
     subFp0, &
     subFi0, &
     subLp0, &
     subLi0, &
     subF0, &
     subF
-  real(pReal), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: subState0
+  real(pREAL), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: subState0
 
 
   ph = material_ID_phase(co,ce)
@@ -1017,9 +1017,9 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
   subFp0 = phase_mechanical_Fp0(ph)%data(1:3,1:3,en)
   subFi0 = phase_mechanical_Fi0(ph)%data(1:3,1:3,en)
   subF0  = phase_mechanical_F0(ph)%data(1:3,1:3,en)
-  subFrac = 0.0_pReal
+  subFrac = 0.0_pREAL
   todo = .true.
-  subStep = 1.0_pReal/num%subStepSizeCryst
+  subStep = 1.0_pREAL/num%subStepSizeCryst
   converged_ = .false.                                                                              ! pretend failed step of 1/subStepSizeCryst
 
   todo = .true.
@@ -1028,9 +1028,9 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
     if (converged_) then
       formerSubStep = subStep
       subFrac = subFrac + subStep
-      subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep)
+      subStep = min(1.0_pREAL - subFrac, num%stepIncreaseCryst * subStep)
 
-      todo = subStep > 0.0_pReal                        ! still time left to integrate on?
+      todo = subStep > 0.0_pREAL                        ! still time left to integrate on?
 
       if (todo) then
         subF0  = subF
@@ -1047,7 +1047,7 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
       phase_mechanical_Fp(ph)%data(1:3,1:3,en) = subFp0
       phase_mechanical_Fi(ph)%data(1:3,1:3,en) = subFi0
       phase_mechanical_S(ph)%data(1:3,1:3,en) = phase_mechanical_S0(ph)%data(1:3,1:3,en)
-      if (subStep < 1.0_pReal) then                                                                 ! actual (not initial) cutback
+      if (subStep < 1.0_pREAL) then                                                                 ! actual (not initial) cutback
         phase_mechanical_Lp(ph)%data(1:3,1:3,en) = subLp0
         phase_mechanical_Li(ph)%data(1:3,1:3,en) = subLi0
       end if
@@ -1105,19 +1105,19 @@ end subroutine mechanical_restore
 !--------------------------------------------------------------------------------------------------
 module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
 
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: &
     co, &                                                                                            !< counter in constituent loop
     ce
-  real(pReal), dimension(3,3,3,3) :: dPdF
+  real(pREAL), dimension(3,3,3,3) :: dPdF
 
   integer :: &
     o, &
     p, ph, en
-  real(pReal), dimension(3,3)     ::   devNull, &
+  real(pREAL), dimension(3,3)     ::   devNull, &
                                        invSubFp0,invSubFi0,invFp,invFi, &
                                        temp_33_1, temp_33_2, temp_33_3
-  real(pReal), dimension(3,3,3,3) ::   dSdFe, &
+  real(pREAL), dimension(3,3,3,3) ::   dSdFe, &
                                        dSdF, &
                                        dSdFi, &
                                        dLidS, &                                                     ! tangent in lattice configuration
@@ -1129,7 +1129,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
                                        rhs_3333, &
                                        lhs_3333, &
                                        temp_3333
-  real(pReal), dimension(9,9)::        temp_99
+  real(pREAL), dimension(9,9)::        temp_99
   logical :: error
 
 
@@ -1150,9 +1150,9 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
   invSubFi0 = math_inv33(phase_mechanical_Fi0(ph)%data(1:3,1:3,en))
 
   if (sum(abs(dLidS)) < tol_math_check) then
-    dFidS = 0.0_pReal
+    dFidS = 0.0_pREAL
   else
-    lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal
+    lhs_3333 = 0.0_pREAL; rhs_3333 = 0.0_pREAL
     do o=1,3; do p=1,3
 #ifndef __INTEL_LLVM_COMPILER
       lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) &
@@ -1171,7 +1171,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
     if (error) then
       call IO_warning(600,'inversion error in analytic tangent calculation', &
                       label1='phase',ID1=ph,label2='entry',ID2=en)
-      dFidS = 0.0_pReal
+      dFidS = 0.0_pREAL
     else
       dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333)
     end if
@@ -1223,7 +1223,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
   temp_33_2 = matmul(phase_mechanical_F(ph)%data(1:3,1:3,en),invFp)
   temp_33_3 = matmul(temp_33_2,phase_mechanical_S(ph)%data(1:3,1:3,en))
 
-  dPdF = 0.0_pReal
+  dPdF = 0.0_pREAL
   do p=1,3
     dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1))
   end do
@@ -1283,7 +1283,7 @@ end subroutine mechanical_restartRead
 module function mechanical_S(ph,en) result(S)
 
   integer, intent(in) :: ph,en
-  real(pReal), dimension(3,3) :: S
+  real(pREAL), dimension(3,3) :: S
 
 
   S = phase_mechanical_S(ph)%data(1:3,1:3,en)
@@ -1297,7 +1297,7 @@ end function mechanical_S
 module function mechanical_L_p(ph,en) result(L_p)
 
   integer, intent(in) :: ph,en
-  real(pReal), dimension(3,3) :: L_p
+  real(pREAL), dimension(3,3) :: L_p
 
 
   L_p = phase_mechanical_Lp(ph)%data(1:3,1:3,en)
@@ -1311,7 +1311,7 @@ end function mechanical_L_p
 module function mechanical_F_e(ph,en) result(F_e)
 
   integer, intent(in) :: ph,en
-  real(pReal), dimension(3,3) :: F_e
+  real(pREAL), dimension(3,3) :: F_e
 
 
   F_e = phase_mechanical_Fe(ph)%data(1:3,1:3,en)
@@ -1325,7 +1325,7 @@ end function mechanical_F_e
 module function mechanical_F_i(ph,en) result(F_i)
 
   integer, intent(in) :: ph,en
-  real(pReal), dimension(3,3) :: F_i
+  real(pREAL), dimension(3,3) :: F_i
 
 
   F_i = phase_mechanical_Fi(ph)%data(1:3,1:3,en)
@@ -1339,7 +1339,7 @@ end function mechanical_F_i
 module function phase_P(co,ce) result(P)
 
   integer, intent(in) :: co, ce
-  real(pReal), dimension(3,3) :: P
+  real(pREAL), dimension(3,3) :: P
 
 
   P = phase_mechanical_P(material_ID_phase(co,ce))%data(1:3,1:3,material_entry_phase(co,ce))
@@ -1353,7 +1353,7 @@ end function phase_P
 module function phase_F(co,ce) result(F)
 
   integer, intent(in) :: co, ce
-  real(pReal), dimension(3,3) :: F
+  real(pREAL), dimension(3,3) :: F
 
 
   F = phase_mechanical_F(material_ID_phase(co,ce))%data(1:3,1:3,material_entry_phase(co,ce))
@@ -1366,7 +1366,7 @@ end function phase_F
 !--------------------------------------------------------------------------------------------------
 module subroutine phase_set_F(F,co,ce)
 
-  real(pReal), dimension(3,3), intent(in) :: F
+  real(pREAL), dimension(3,3), intent(in) :: F
   integer, intent(in) :: co, ce
 
 

src/phase_mechanical_eigen.f90

@@ -20,9 +20,9 @@ submodule(phase:mechanical) eigen
 
     module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
       integer, intent(in) :: ph, me
-      real(pReal),   intent(out), dimension(3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3) :: &
         Li                                                                                          !< thermal velocity gradient
-      real(pReal),   intent(out), dimension(3,3,3,3) :: &
+      real(pREAL),   intent(out), dimension(3,3,3,3) :: &
         dLi_dTstar                                                                                  !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero)
     end subroutine thermalexpansion_LiAndItsTangent
 
@@ -145,32 +145,32 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
 
   integer, intent(in) :: &
     ph,en
-  real(pReal),   intent(in),  dimension(3,3) :: &
+  real(pREAL),   intent(in),  dimension(3,3) :: &
     S                                                                                               !< 2nd Piola-Kirchhoff stress
-  real(pReal),   intent(in),  dimension(3,3) :: &
+  real(pREAL),   intent(in),  dimension(3,3) :: &
     Fi                                                                                              !< intermediate deformation gradient
-  real(pReal),   intent(out), dimension(3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3) :: &
     Li                                                                                              !< intermediate velocity gradient
-  real(pReal),   intent(out), dimension(3,3,3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3,3,3) :: &
     dLi_dS, &                                                                                       !< derivative of Li with respect to S
     dLi_dFi
 
-  real(pReal), dimension(3,3) :: &
+  real(pREAL), dimension(3,3) :: &
     my_Li, &                                                                                        !< intermediate velocity gradient
     FiInv, &
     temp_33
-  real(pReal), dimension(3,3,3,3) :: &
+  real(pREAL), dimension(3,3,3,3) :: &
     my_dLi_dS
-  real(pReal) :: &
+  real(pREAL) :: &
     detFi
   integer :: &
     k, i, j
   logical :: active
 
   active = .false.
-  Li = 0.0_pReal
-  dLi_dS  = 0.0_pReal
-  dLi_dFi = 0.0_pReal
+  Li = 0.0_pREAL
+  dLi_dS  = 0.0_pREAL
+  dLi_dFi = 0.0_pREAL
 
 
   plasticType: select case (phase_plasticity(ph))

src/phase_mechanical_eigen_thermalexpansion.f90

@@ -75,13 +75,13 @@ end function thermalexpansion_init
 module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
 
   integer, intent(in) :: ph, me
-  real(pReal),   intent(out), dimension(3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3) :: &
     Li                                                                                              !< thermal velocity gradient
-  real(pReal),   intent(out), dimension(3,3,3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3,3,3) :: &
     dLi_dTstar                                                                                      !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero)
 
-  real(pReal) :: T, dot_T
-  real(pReal), dimension(3,3) :: Alpha
+  real(pREAL) :: T, dot_T
+  real(pREAL), dimension(3,3) :: Alpha
 
 
   T     = thermal_T(ph,me)
@@ -89,14 +89,14 @@ module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
 
   associate(prm => param(kinematics_thermal_expansion_instance(ph)))
 
-    Alpha = 0.0_pReal
+    Alpha = 0.0_pREAL
     Alpha(1,1) = prm%Alpha_11%at(T)
     if (any(phase_lattice(ph) == ['hP','tI'])) Alpha(3,3) = prm%Alpha_33%at(T)
     Alpha = lattice_symmetrize_33(Alpha,phase_lattice(ph))
     Li = dot_T * Alpha
 
   end associate
-  dLi_dTstar = 0.0_pReal
+  dLi_dTstar = 0.0_pREAL
 
 end subroutine thermalexpansion_LiAndItsTangent
 

src/phase_mechanical_elastic.f90

@@ -77,13 +77,13 @@ pure module function elastic_C66(ph,en) result(C66)
     ph, &
     en
 
-  real(pReal), dimension(6,6) :: C66
-  real(pReal) :: T
+  real(pREAL), dimension(6,6) :: C66
+  real(pREAL) :: T
 
 
   associate(prm => param(ph))
 
-    C66 = 0.0_pReal
+    C66 = 0.0_pREAL
     T = thermal_T(ph,en)
 
     C66(1,1) = prm%C_11%at(T)
@@ -113,7 +113,7 @@ pure module function elastic_mu(ph,en,isotropic_bound) result(mu)
     ph, &
     en
   character(len=*), intent(in) :: isotropic_bound
-  real(pReal) :: &
+  real(pREAL) :: &
     mu
 
 
@@ -135,7 +135,7 @@ pure module function elastic_nu(ph,en,isotropic_bound) result(nu)
     ph, &
     en
   character(len=*), intent(in) :: isotropic_bound
-  real(pReal) :: &
+  real(pREAL) :: &
     nu
 
 
@@ -160,18 +160,18 @@ module subroutine phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
   integer, intent(in) :: &
     ph, &
     en
-  real(pReal),   intent(in),  dimension(3,3) :: &
+  real(pREAL),   intent(in),  dimension(3,3) :: &
     Fe, &                                                                                           !< elastic deformation gradient
     Fi                                                                                              !< intermediate deformation gradient
-  real(pReal),   intent(out), dimension(3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3) :: &
     S                                                                                               !< 2nd Piola-Kirchhoff stress tensor in lattice configuration
-  real(pReal),   intent(out), dimension(3,3,3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3,3,3) :: &
     dS_dFe, &                                                                                       !< derivative of 2nd P-K stress with respect to elastic deformation gradient
     dS_dFi                                                                                          !< derivative of 2nd P-K stress with respect to intermediate deformation gradient
 
-  real(pReal), dimension(3,3) :: E
-  real(pReal), dimension(6,6) :: C66
-  real(pReal), dimension(3,3,3,3) :: C
+  real(pREAL), dimension(3,3) :: E
+  real(pREAL), dimension(6,6) :: C66
+  real(pREAL), dimension(3,3,3,3) :: C
   integer :: &
     i, j
 
@@ -179,12 +179,12 @@ module subroutine phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
   C66 = phase_damage_C66(phase_homogenizedC66(ph,en),ph,en)
   C = math_Voigt66to3333_stiffness(C66)
 
-  E = 0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3)                                                  !< Green-Lagrange strain in unloaded configuration
+  E = 0.5_pREAL*(matmul(transpose(Fe),Fe)-math_I3)                                                  !< Green-Lagrange strain in unloaded configuration
   S = math_Voigt6to33_stress(matmul(C66,math_33toVoigt6_strain(matmul(matmul(transpose(Fi),E),Fi))))!< 2PK stress in lattice configuration in work conjugate with GL strain pulled back to lattice configuration
 
   do i =1,3; do j=1,3
     dS_dFe(i,j,1:3,1:3) = matmul(Fe,matmul(matmul(Fi,C(i,j,1:3,1:3)),transpose(Fi)))                !< dS_ij/dFe_kl = C_ijmn * Fi_lm * Fi_on * Fe_ko
-    dS_dFi(i,j,1:3,1:3) = 2.0_pReal*matmul(matmul(E,Fi),C(i,j,1:3,1:3))                             !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn
+    dS_dFi(i,j,1:3,1:3) = 2.0_pREAL*matmul(matmul(E,Fi),C(i,j,1:3,1:3))                             !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn
   end do; end do
 
 end subroutine phase_hooke_SandItsTangents
@@ -195,7 +195,7 @@ end subroutine phase_hooke_SandItsTangents
 !--------------------------------------------------------------------------------------------------
 module function phase_homogenizedC66(ph,en) result(C)
 
-  real(pReal), dimension(6,6) :: C
+  real(pREAL), dimension(6,6) :: C
   integer,      intent(in)    :: ph, en
 
 

src/phase_mechanical_plastic.f90

@@ -38,11 +38,11 @@ submodule(phase:mechanical) plastic
     end function plastic_nonlocal_init
 
     module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
-      real(pReal), dimension(3,3),     intent(out) :: &
+      real(pREAL), dimension(3,3),     intent(out) :: &
         Lp
-      real(pReal), dimension(3,3,3,3), intent(out) :: &
+      real(pREAL), dimension(3,3,3,3), intent(out) :: &
         dLp_dMp
-      real(pReal), dimension(3,3),     intent(in) :: &
+      real(pREAL), dimension(3,3),     intent(in) :: &
         Mp
       integer,                         intent(in) :: &
         ph, &
@@ -50,11 +50,11 @@ submodule(phase:mechanical) plastic
     end subroutine isotropic_LpAndItsTangent
 
     pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
-      real(pReal), dimension(3,3),     intent(out) :: &
+      real(pREAL), dimension(3,3),     intent(out) :: &
         Lp
-      real(pReal), dimension(3,3,3,3), intent(out) :: &
+      real(pREAL), dimension(3,3,3,3), intent(out) :: &
         dLp_dMp
-      real(pReal), dimension(3,3),     intent(in) :: &
+      real(pREAL), dimension(3,3),     intent(in) :: &
         Mp
       integer,                         intent(in) :: &
         ph, &
@@ -62,11 +62,11 @@ submodule(phase:mechanical) plastic
     end subroutine phenopowerlaw_LpAndItsTangent
 
     pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
-      real(pReal), dimension(3,3),     intent(out) :: &
+      real(pREAL), dimension(3,3),     intent(out) :: &
         Lp
-      real(pReal), dimension(3,3,3,3), intent(out) :: &
+      real(pREAL), dimension(3,3,3,3), intent(out) :: &
         dLp_dMp
-      real(pReal), dimension(3,3),     intent(in) :: &
+      real(pREAL), dimension(3,3),     intent(in) :: &
         Mp
       integer,                         intent(in) :: &
         ph, &
@@ -74,11 +74,11 @@ submodule(phase:mechanical) plastic
     end subroutine kinehardening_LpAndItsTangent
 
     module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
-      real(pReal), dimension(3,3),     intent(out) :: &
+      real(pREAL), dimension(3,3),     intent(out) :: &
         Lp
-      real(pReal), dimension(3,3,3,3), intent(out) :: &
+      real(pREAL), dimension(3,3,3,3), intent(out) :: &
         dLp_dMp
-      real(pReal), dimension(3,3),     intent(in) :: &
+      real(pREAL), dimension(3,3),     intent(in) :: &
         Mp
       integer,                         intent(in) :: &
         ph, &
@@ -86,11 +86,11 @@ submodule(phase:mechanical) plastic
     end subroutine dislotwin_LpAndItsTangent
 
     pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
-      real(pReal), dimension(3,3),     intent(out) :: &
+      real(pREAL), dimension(3,3),     intent(out) :: &
         Lp
-      real(pReal), dimension(3,3,3,3), intent(out) :: &
+      real(pREAL), dimension(3,3,3,3), intent(out) :: &
         dLp_dMp
-      real(pReal), dimension(3,3),     intent(in) :: &
+      real(pREAL), dimension(3,3),     intent(in) :: &
         Mp
       integer,                         intent(in) :: &
         ph, &
@@ -98,11 +98,11 @@ submodule(phase:mechanical) plastic
     end subroutine dislotungsten_LpAndItsTangent
 
     module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
-      real(pReal), dimension(3,3),     intent(out) :: &
+      real(pREAL), dimension(3,3),     intent(out) :: &
         Lp
-      real(pReal), dimension(3,3,3,3), intent(out) :: &
+      real(pREAL), dimension(3,3,3,3), intent(out) :: &
         dLp_dMp
-      real(pReal), dimension(3,3),     intent(in) :: &
+      real(pREAL), dimension(3,3),     intent(in) :: &
         Mp                                                                                          !< Mandel stress
       integer,                         intent(in) :: &
         ph, &
@@ -111,59 +111,59 @@ submodule(phase:mechanical) plastic
 
 
     module function isotropic_dotState(Mp,ph,en) result(dotState)
-      real(pReal), dimension(3,3),  intent(in) :: &
+      real(pREAL), dimension(3,3),  intent(in) :: &
         Mp                                                                                          !< Mandel stress
       integer,                      intent(in) :: &
         ph, &
         en
-      real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+      real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
         dotState
     end function isotropic_dotState
 
     module function phenopowerlaw_dotState(Mp,ph,en) result(dotState)
-      real(pReal), dimension(3,3),  intent(in) :: &
+      real(pREAL), dimension(3,3),  intent(in) :: &
         Mp                                                                                          !< Mandel stress
       integer,                      intent(in) :: &
         ph, &
         en
-      real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+      real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
         dotState
     end function phenopowerlaw_dotState
 
     module function plastic_kinehardening_dotState(Mp,ph,en) result(dotState)
-      real(pReal), dimension(3,3),  intent(in) :: &
+      real(pREAL), dimension(3,3),  intent(in) :: &
         Mp                                                                                          !< Mandel stress
       integer,                      intent(in) :: &
         ph, &
         en
-      real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+      real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
         dotState
     end function plastic_kinehardening_dotState
 
     module function dislotwin_dotState(Mp,ph,en) result(dotState)
-      real(pReal), dimension(3,3),  intent(in) :: &
+      real(pREAL), dimension(3,3),  intent(in) :: &
         Mp                                                                                          !< Mandel stress
       integer,                      intent(in) :: &
         ph, &
         en
-      real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+      real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
         dotState
     end function dislotwin_dotState
 
     module function dislotungsten_dotState(Mp,ph,en) result(dotState)
-      real(pReal), dimension(3,3),  intent(in) :: &
+      real(pREAL), dimension(3,3),  intent(in) :: &
         Mp                                                                                          !< Mandel stress
       integer,                      intent(in) :: &
         ph, &
         en
-      real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+      real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
         dotState
     end function dislotungsten_dotState
 
     module subroutine nonlocal_dotState(Mp,timestep,ph,en)
-      real(pReal), dimension(3,3), intent(in) :: &
+      real(pREAL), dimension(3,3), intent(in) :: &
         Mp                                                                                          !< MandelStress
-      real(pReal), intent(in) :: &
+      real(pREAL), intent(in) :: &
         timestep                                                                                    !< substepped crystallite time increment
       integer, intent(in) :: &
         ph, &
@@ -189,7 +189,7 @@ submodule(phase:mechanical) plastic
     end subroutine nonlocal_dependentState
 
     module subroutine plastic_kinehardening_deltaState(Mp,ph,en)
-      real(pReal), dimension(3,3),  intent(in) :: &
+      real(pREAL), dimension(3,3),  intent(in) :: &
         Mp                                                                                          !< Mandel stress
       integer,                      intent(in) :: &
         ph, &
@@ -197,7 +197,7 @@ submodule(phase:mechanical) plastic
     end subroutine plastic_kinehardening_deltaState
 
     module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
-      real(pReal), dimension(3,3), intent(in) :: &
+      real(pREAL), dimension(3,3), intent(in) :: &
         Mp
       integer, intent(in) :: &
         ph, &
@@ -234,27 +234,27 @@ module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
                                            S, Fi, ph,en)
   integer, intent(in) :: &
     ph,en
-  real(pReal),   intent(in),  dimension(3,3) :: &
+  real(pREAL),   intent(in),  dimension(3,3) :: &
     S, &                                                                                            !< 2nd Piola-Kirchhoff stress
     Fi                                                                                              !< intermediate deformation gradient
-  real(pReal),   intent(out), dimension(3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3) :: &
     Lp                                                                                              !< plastic velocity gradient
-  real(pReal),   intent(out), dimension(3,3,3,3) :: &
+  real(pREAL),   intent(out), dimension(3,3,3,3) :: &
     dLp_dS, &
     dLp_dFi                                                                                         !< derivative en Lp with respect to Fi
 
-  real(pReal), dimension(3,3,3,3) :: &
+  real(pREAL), dimension(3,3,3,3) :: &
     dLp_dMp                                                                                         !< derivative of Lp with respect to Mandel stress
-  real(pReal), dimension(3,3) :: &
+  real(pREAL), dimension(3,3) :: &
     Mp                                                                                              !< Mandel stress work conjugate with Lp
   integer :: &
     i, j
 
 
   if (phase_plasticity(ph) == PLASTIC_NONE_ID) then
-    Lp      = 0.0_pReal
-    dLp_dFi = 0.0_pReal
-    dLp_dS  = 0.0_pReal
+    Lp      = 0.0_pREAL
+    dLp_dFi = 0.0_pREAL
+    dLp_dS  = 0.0_pREAL
   else
 
     Mp = matmul(matmul(transpose(Fi),Fi),S)
@@ -300,11 +300,11 @@ module function plastic_dotState(subdt,ph,en) result(dotState)
   integer, intent(in) :: &
     ph, &
     en
-  real(pReal),  intent(in) :: &
+  real(pREAL),  intent(in) :: &
     subdt                                                                                           !< timestep
-  real(pReal),              dimension(3,3) :: &
+  real(pREAL),              dimension(3,3) :: &
     Mp
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
 
 
@@ -376,7 +376,7 @@ module function plastic_deltaState(ph, en) result(broken)
     en
   logical :: broken
 
-  real(pReal), dimension(3,3) :: &
+  real(pREAL), dimension(3,3) :: &
     Mp
   integer :: &
     mySize

src/phase_mechanical_plastic_dislotungsten.f90

@@ -8,11 +8,11 @@
 submodule(phase:plastic) dislotungsten
 
   type :: tParameters
-    real(pReal) :: &
-      D    = 1.0_pReal, &                                                                           !< grain size
-      D_0  = 1.0_pReal, &                                                                           !< prefactor for self-diffusion coefficient
-      Q_cl = 1.0_pReal                                                                              !< activation energy for dislocation climb
-    real(pReal),               allocatable, dimension(:) :: &
+    real(pREAL) :: &
+      D    = 1.0_pREAL, &                                                                           !< grain size
+      D_0  = 1.0_pREAL, &                                                                           !< prefactor for self-diffusion coefficient
+      Q_cl = 1.0_pREAL                                                                              !< activation energy for dislocation climb
+    real(pREAL),               allocatable, dimension(:) :: &
       b_sl, &                                                                                       !< magnitude of Burgers vector [m]
       d_caron, &                                                                                    !< distance of spontaneous annhihilation
       i_sl, &                                                                                       !< Adj. parameter for distance between 2 forest dislocations
@@ -26,10 +26,10 @@ submodule(phase:plastic) dislotungsten
       h, &                                                                                          !< height of the kink pair
       w, &                                                                                          !< width of the kink pair
       omega                                                                                         !< attempt frequency for kink pair nucleation
-    real(pReal),               allocatable, dimension(:,:) :: &
+    real(pREAL),               allocatable, dimension(:,:) :: &
       h_sl_sl, &                                                                                    !< slip resistance from slip activity
       forestProjection
-    real(pReal),               allocatable, dimension(:,:,:) :: &
+    real(pREAL),               allocatable, dimension(:,:,:) :: &
       P_sl, &
       P_nS_pos, &
       P_nS_neg
@@ -53,14 +53,14 @@ submodule(phase:plastic) dislotungsten
   end type tIndexDotState
 
   type :: tDislotungstenState
-    real(pReal), dimension(:,:), pointer :: &
+    real(pREAL), dimension(:,:), pointer :: &
       rho_mob, &
       rho_dip, &
       gamma_sl
   end type tDislotungstenState
 
   type :: tDislotungstenDependentState
-    real(pReal), dimension(:,:), allocatable :: &
+    real(pREAL), dimension(:,:), allocatable :: &
       Lambda_sl, &
       tau_pass
   end type tDislotungstenDependentState
@@ -89,7 +89,7 @@ module function plastic_dislotungsten_init() result(myPlasticity)
     startIndex, endIndex
   integer,    dimension(:), allocatable :: &
     N_sl
-  real(pReal),dimension(:), allocatable :: &
+  real(pREAL),dimension(:), allocatable :: &
     rho_mob_0, &                                                                                    !< initial dislocation density
     rho_dip_0, &                                                                                    !< initial dipole density
     a                                                                                               !< non-Schmid coefficients
@@ -203,16 +203,16 @@ module function plastic_dislotungsten_init() result(myPlasticity)
       prm%d_caron        = pl%get_asReal('D_a') * prm%b_sl
 
       ! sanity checks
-      if (    prm%D_0          <  0.0_pReal)  extmsg = trim(extmsg)//' D_0'
-      if (    prm%Q_cl         <= 0.0_pReal)  extmsg = trim(extmsg)//' Q_cl'
-      if (any(rho_mob_0        <  0.0_pReal)) extmsg = trim(extmsg)//' rho_mob_0'
-      if (any(rho_dip_0        <  0.0_pReal)) extmsg = trim(extmsg)//' rho_dip_0'
-      if (any(prm%b_sl         <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl'
-      if (any(prm%Q_s          <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_s'
-      if (any(prm%tau_Peierls  <  0.0_pReal)) extmsg = trim(extmsg)//' tau_Peierls'
-      if (any(prm%B            <  0.0_pReal)) extmsg = trim(extmsg)//' B'
-      if (any(prm%d_caron      <  0.0_pReal)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
-      if (any(prm%f_at         <= 0.0_pReal)) extmsg = trim(extmsg)//' f_at or b_sl'
+      if (    prm%D_0          <  0.0_pREAL)  extmsg = trim(extmsg)//' D_0'
+      if (    prm%Q_cl         <= 0.0_pREAL)  extmsg = trim(extmsg)//' Q_cl'
+      if (any(rho_mob_0        <  0.0_pREAL)) extmsg = trim(extmsg)//' rho_mob_0'
+      if (any(rho_dip_0        <  0.0_pREAL)) extmsg = trim(extmsg)//' rho_dip_0'
+      if (any(prm%b_sl         <= 0.0_pREAL)) extmsg = trim(extmsg)//' b_sl'
+      if (any(prm%Q_s          <= 0.0_pREAL)) extmsg = trim(extmsg)//' Q_s'
+      if (any(prm%tau_Peierls  <  0.0_pREAL)) extmsg = trim(extmsg)//' tau_Peierls'
+      if (any(prm%B            <  0.0_pREAL)) extmsg = trim(extmsg)//' B'
+      if (any(prm%d_caron      <  0.0_pREAL)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
+      if (any(prm%f_at         <= 0.0_pREAL)) extmsg = trim(extmsg)//' f_at or b_sl'
 
     else slipActive
       rho_mob_0 = emptyRealArray; rho_dip_0 = emptyRealArray
@@ -239,25 +239,25 @@ module function plastic_dislotungsten_init() result(myPlasticity)
     idx_dot%rho_mob = [startIndex,endIndex]
     stt%rho_mob => plasticState(ph)%state(startIndex:endIndex,:)
     stt%rho_mob =  spread(rho_mob_0,2,Nmembers)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_rho'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_sl
     idx_dot%rho_dip = [startIndex,endIndex]
     stt%rho_dip => plasticState(ph)%state(startIndex:endIndex,:)
     stt%rho_dip =  spread(rho_dip_0,2,Nmembers)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pReal)
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_sl
     idx_dot%gamma_sl = [startIndex,endIndex]
     stt%gamma_sl => plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
 
-    allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pReal)
-    allocate(dst%tau_pass(prm%sum_N_sl,Nmembers),  source=0.0_pReal)
+    allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pREAL)
+    allocate(dst%tau_pass(prm%sum_N_sl,Nmembers),  source=0.0_pREAL)
 
     end associate
 
@@ -275,11 +275,11 @@ end function plastic_dislotungsten_init
 !--------------------------------------------------------------------------------------------------
 pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
                                                      Mp,ph,en)
-  real(pReal), dimension(3,3),     intent(out) :: &
+  real(pREAL), dimension(3,3),     intent(out) :: &
     Lp                                                                                              !< plastic velocity gradient
-  real(pReal), dimension(3,3,3,3), intent(out) :: &
+  real(pREAL), dimension(3,3,3,3), intent(out) :: &
     dLp_dMp                                                                                         !< derivative of Lp with respect to the Mandel stress
-  real(pReal), dimension(3,3), intent(in) :: &
+  real(pREAL), dimension(3,3), intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                     intent(in) :: &
     ph, &
@@ -287,16 +287,16 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
 
   integer :: &
     i,k,l,m,n
-  real(pReal) :: &
+  real(pREAL) :: &
     T                                                                                               !< temperature
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_pos,dot_gamma_neg, &
     ddot_gamma_dtau_pos,ddot_gamma_dtau_neg
 
 
   T = thermal_T(ph,en)
-  Lp = 0.0_pReal
-  dLp_dMp = 0.0_pReal
+  Lp = 0.0_pREAL
+  dLp_dMp = 0.0_pREAL
 
   associate(prm => param(ph))
 
@@ -319,15 +319,15 @@ end subroutine dislotungsten_LpAndItsTangent
 !--------------------------------------------------------------------------------------------------
 module function dislotungsten_dotState(Mp,ph,en) result(dotState)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
 
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_pos, dot_gamma_neg,&
     tau_pos,&
     tau_neg, &
@@ -335,7 +335,7 @@ module function dislotungsten_dotState(Mp,ph,en) result(dotState)
     dot_rho_dip_formation, &
     dot_rho_dip_climb, &
     d_hat
-  real(pReal) :: &
+  real(pREAL) :: &
     mu, T
 
 
@@ -353,26 +353,26 @@ module function dislotungsten_dotState(Mp,ph,en) result(dotState)
 
     dot_gamma_sl = abs(dot_gamma_pos+dot_gamma_neg)
 
-    where(dEq0((tau_pos+tau_neg)*0.5_pReal))
-      dot_rho_dip_formation = 0.0_pReal
-      dot_rho_dip_climb     = 0.0_pReal
+    where(dEq0((tau_pos+tau_neg)*0.5_pREAL))
+      dot_rho_dip_formation = 0.0_pREAL
+      dot_rho_dip_climb     = 0.0_pREAL
     else where
-      d_hat = math_clip(3.0_pReal*mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos+tau_neg)*0.5_pReal), &
+      d_hat = math_clip(3.0_pREAL*mu*prm%b_sl/(16.0_pREAL*PI*abs(tau_pos+tau_neg)*0.5_pREAL), &
                         prm%d_caron, &                                                              ! lower limit
                         dst%Lambda_sl(:,en))                                                        ! upper limit
-      dot_rho_dip_formation = merge(2.0_pReal*(d_hat-prm%d_caron)*stt%rho_mob(:,en)*dot_gamma_sl/prm%b_sl, &
-                                    0.0_pReal, &
+      dot_rho_dip_formation = merge(2.0_pREAL*(d_hat-prm%d_caron)*stt%rho_mob(:,en)*dot_gamma_sl/prm%b_sl, &
+                                    0.0_pREAL, &
                                     prm%dipoleformation)
-      v_cl = (3.0_pReal*mu*prm%D_0*exp(-prm%Q_cl/(K_B*T))*prm%f_at/(TAU*K_B*T)) &
-           * (1.0_pReal/(d_hat+prm%d_caron))
-      dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,en))/(d_hat-prm%d_caron)                    ! ToDo: Discuss with Franz: Stress dependency?
+      v_cl = (3.0_pREAL*mu*prm%D_0*exp(-prm%Q_cl/(K_B*T))*prm%f_at/(TAU*K_B*T)) &
+           * (1.0_pREAL/(d_hat+prm%d_caron))
+      dot_rho_dip_climb = (4.0_pREAL*v_cl*stt%rho_dip(:,en))/(d_hat-prm%d_caron)                    ! ToDo: Discuss with Franz: Stress dependency?
     end where
 
     dot_rho_mob = dot_gamma_sl/(prm%b_sl*dst%Lambda_sl(:,en)) &                                     ! multiplication
                       - dot_rho_dip_formation &
-                - (2.0_pReal*prm%d_caron)/prm%b_sl*stt%rho_mob(:,en)*dot_gamma_sl                   ! Spontaneous annihilation of 2 edges
+                - (2.0_pREAL*prm%d_caron)/prm%b_sl*stt%rho_mob(:,en)*dot_gamma_sl                   ! Spontaneous annihilation of 2 edges
     dot_rho_dip = dot_rho_dip_formation &
-                - (2.0_pReal*prm%d_caron)/prm%b_sl*stt%rho_dip(:,en)*dot_gamma_sl &                 ! Spontaneous annihilation of an edge with a dipole
+                - (2.0_pREAL*prm%d_caron)/prm%b_sl*stt%rho_dip(:,en)*dot_gamma_sl &                 ! Spontaneous annihilation of an edge with a dipole
                       - dot_rho_dip_climb
 
   end associate
@@ -389,7 +389,7 @@ module subroutine dislotungsten_dependentState(ph,en)
     ph, &
     en
 
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     Lambda_sl_inv
 
 
@@ -398,9 +398,9 @@ module subroutine dislotungsten_dependentState(ph,en)
     dst%tau_pass(:,en) = elastic_mu(ph,en,prm%isotropic_bound)*prm%b_sl &
                        * sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
 
-    Lambda_sl_inv = 1.0_pReal/prm%D &
+    Lambda_sl_inv = 1.0_pREAL/prm%D &
                   + sqrt(matmul(prm%forestProjection,stt%rho_mob(:,en)+stt%rho_dip(:,en)))/prm%i_sl
-    dst%Lambda_sl(:,en) = Lambda_sl_inv**(-1.0_pReal)
+    dst%Lambda_sl(:,en) = Lambda_sl_inv**(-1.0_pREAL)
 
   end associate
 
@@ -458,24 +458,24 @@ end subroutine plastic_dislotungsten_result
 pure subroutine kinetics(Mp,T,ph,en, &
                  dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg,tau_pos_out,tau_neg_out)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
-  real(pReal),                  intent(in) :: &
+  real(pREAL),                  intent(in) :: &
     T                                                                                               !< temperature
   integer,                      intent(in) :: &
     ph, &
     en
 
-  real(pReal),                  intent(out), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL),                  intent(out), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_pos, &
     dot_gamma_neg
-  real(pReal),                  intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL),                  intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
     ddot_gamma_dtau_pos, &
     ddot_gamma_dtau_neg, &
     tau_pos_out, &
     tau_neg_out
 
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     StressRatio, &
     StressRatio_p,StressRatio_pminus1, &
     dvel, &
@@ -495,7 +495,7 @@ pure subroutine kinetics(Mp,T,ph,en, &
     if (present(tau_neg_out)) tau_neg_out = tau_neg
 
     associate(BoltzmannRatio  => prm%Q_s/(K_B*T), &
-              b_rho_half      => stt%rho_mob(:,en) * prm%b_sl * 0.5_pReal, &
+              b_rho_half      => stt%rho_mob(:,en) * prm%b_sl * 0.5_pREAL, &
               effectiveLength => dst%Lambda_sl(:,en) - prm%w)
 
       tau_eff = abs(tau_pos)-dst%tau_pass(:,en)
@@ -503,28 +503,28 @@ pure subroutine kinetics(Mp,T,ph,en, &
       significantPositiveTau: where(tau_eff > tol_math_check)
         StressRatio = tau_eff/prm%tau_Peierls
         StressRatio_p       = StressRatio** prm%p
-        StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
+        StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL)
 
-        t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pReal-StressRatio_p) ** prm%q) &
+        t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pREAL-StressRatio_p) ** prm%q) &
             / (prm%omega*effectiveLength)
-        t_k = effectiveLength * prm%B /(2.0_pReal*prm%b_sl*tau_eff)                                 ! corrected eq. (14)
+        t_k = effectiveLength * prm%B /(2.0_pREAL*prm%b_sl*tau_eff)                                 ! corrected eq. (14)
 
         dot_gamma_pos = b_rho_half * sign(prm%h/(t_n + t_k),tau_pos)
       else where significantPositiveTau
-        dot_gamma_pos = 0.0_pReal
+        dot_gamma_pos = 0.0_pREAL
       end where significantPositiveTau
 
       if (present(ddot_gamma_dtau_pos)) then
         significantPositiveTau2: where(abs(tau_pos)-dst%tau_pass(:,en) > tol_math_check)
-          dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) &
+          dtn = -1.0_pREAL * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pREAL-StressRatio_p)**(prm%q - 1.0_pREAL) &
               * StressRatio_pminus1 / prm%tau_Peierls
-          dtk = -1.0_pReal * t_k / tau_pos
+          dtk = -1.0_pREAL * t_k / tau_pos
 
-          dvel = -1.0_pReal * prm%h * (dtk + dtn) / (t_n + t_k)**2
+          dvel = -1.0_pREAL * prm%h * (dtk + dtn) / (t_n + t_k)**2
 
           ddot_gamma_dtau_pos = b_rho_half * dvel
         else where significantPositiveTau2
-          ddot_gamma_dtau_pos = 0.0_pReal
+          ddot_gamma_dtau_pos = 0.0_pREAL
         end where significantPositiveTau2
       end if
 
@@ -533,28 +533,28 @@ pure subroutine kinetics(Mp,T,ph,en, &
       significantNegativeTau: where(tau_eff > tol_math_check)
         StressRatio = tau_eff/prm%tau_Peierls
         StressRatio_p       = StressRatio** prm%p
-        StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
+        StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL)
 
-        t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pReal-StressRatio_p) ** prm%q) &
+        t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pREAL-StressRatio_p) ** prm%q) &
             / (prm%omega*effectiveLength)
-        t_k = effectiveLength * prm%B /(2.0_pReal*prm%b_sl*tau_eff)                                 ! corrected eq. (14)
+        t_k = effectiveLength * prm%B /(2.0_pREAL*prm%b_sl*tau_eff)                                 ! corrected eq. (14)
 
         dot_gamma_neg = b_rho_half * sign(prm%h/(t_n + t_k),tau_neg)
       else where significantNegativeTau
-        dot_gamma_neg = 0.0_pReal
+        dot_gamma_neg = 0.0_pREAL
       end where significantNegativeTau
 
       if (present(ddot_gamma_dtau_neg)) then
         significantNegativeTau2: where(abs(tau_neg)-dst%tau_pass(:,en) > tol_math_check)
-          dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) &
+          dtn = -1.0_pREAL * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pREAL-StressRatio_p)**(prm%q - 1.0_pREAL) &
               * StressRatio_pminus1 / prm%tau_Peierls
-          dtk = -1.0_pReal * t_k / tau_neg
+          dtk = -1.0_pREAL * t_k / tau_neg
 
-          dvel = -1.0_pReal * prm%h * (dtk + dtn) / (t_n + t_k)**2
+          dvel = -1.0_pREAL * prm%h * (dtk + dtn) / (t_n + t_k)**2
 
           ddot_gamma_dtau_neg = b_rho_half * dvel
         else where significantNegativeTau2
-          ddot_gamma_dtau_neg = 0.0_pReal
+          ddot_gamma_dtau_neg = 0.0_pREAL
         end where significantNegativeTau2
       end if
 

src/phase_mechanical_plastic_dislotwin.f90

@@ -9,31 +9,31 @@
 !--------------------------------------------------------------------------------------------------
 submodule(phase:plastic) dislotwin
 
-  real(pReal), parameter :: gamma_char_tr = sqrt(0.125_pReal)                                       !< Characteristic shear for transformation
+  real(pREAL), parameter :: gamma_char_tr = sqrt(0.125_pREAL)                                       !< Characteristic shear for transformation
   type :: tParameters
-    real(pReal) :: &
-      Q_cl       = 1.0_pReal, &                                                                     !< activation energy for dislocation climb
-      omega      = 1.0_pReal, &                                                                     !< frequency factor for dislocation climb
-      D          = 1.0_pReal, &                                                                     !< grain size
-      p_sb       = 1.0_pReal, &                                                                     !< p-exponent in shear band velocity
-      q_sb       = 1.0_pReal, &                                                                     !< q-exponent in shear band velocity
-      i_tw       = 1.0_pReal, &                                                                     !< adjustment parameter to calculate MFP for twinning
-      i_tr       = 1.0_pReal, &                                                                     !< adjustment parameter to calculate MFP for transformation
-      L_tw       = 1.0_pReal, &                                                                     !< length of twin nuclei
-      L_tr       = 1.0_pReal, &                                                                     !< length of trans nuclei
-      x_c        = 1.0_pReal, &                                                                     !< critical distance for formation of twin/trans nucleus
-      V_cs       = 1.0_pReal, &                                                                     !< cross slip volume
-      tau_sb     = 1.0_pReal, &                                                                     !< value for shearband resistance
-      gamma_0_sb = 1.0_pReal, &                                                                     !< value for shearband velocity_0
-      E_sb       = 1.0_pReal, &                                                                     !< activation energy for shear bands
-      h          = 1.0_pReal, &                                                                     !< stack height of hex nucleus
-      cOverA_hP  = 1.0_pReal, &
-      V_mol      = 1.0_pReal, &
-      rho        = 1.0_pReal
+    real(pREAL) :: &
+      Q_cl       = 1.0_pREAL, &                                                                     !< activation energy for dislocation climb
+      omega      = 1.0_pREAL, &                                                                     !< frequency factor for dislocation climb
+      D          = 1.0_pREAL, &                                                                     !< grain size
+      p_sb       = 1.0_pREAL, &                                                                     !< p-exponent in shear band velocity
+      q_sb       = 1.0_pREAL, &                                                                     !< q-exponent in shear band velocity
+      i_tw       = 1.0_pREAL, &                                                                     !< adjustment parameter to calculate MFP for twinning
+      i_tr       = 1.0_pREAL, &                                                                     !< adjustment parameter to calculate MFP for transformation
+      L_tw       = 1.0_pREAL, &                                                                     !< length of twin nuclei
+      L_tr       = 1.0_pREAL, &                                                                     !< length of trans nuclei
+      x_c        = 1.0_pREAL, &                                                                     !< critical distance for formation of twin/trans nucleus
+      V_cs       = 1.0_pREAL, &                                                                     !< cross slip volume
+      tau_sb     = 1.0_pREAL, &                                                                     !< value for shearband resistance
+      gamma_0_sb = 1.0_pREAL, &                                                                     !< value for shearband velocity_0
+      E_sb       = 1.0_pREAL, &                                                                     !< activation energy for shear bands
+      h          = 1.0_pREAL, &                                                                     !< stack height of hex nucleus
+      cOverA_hP  = 1.0_pREAL, &
+      V_mol      = 1.0_pREAL, &
+      rho        = 1.0_pREAL
     type(tPolynomial) :: &
       Gamma_sf, &                                                                                   !< stacking fault energy
       Delta_G                                                                                       !< free energy difference between austensite and martensite
-    real(pReal),               allocatable, dimension(:) :: &
+    real(pREAL),               allocatable, dimension(:) :: &
       b_sl, &                                                                                       !< absolute length of Burgers vector [m] for each slip system
       b_tw, &                                                                                       !< absolute length of Burgers vector [m] for each twin system
       b_tr, &                                                                                       !< absolute length of Burgers vector [m] for each transformation system
@@ -51,7 +51,7 @@ submodule(phase:plastic) dislotwin
       gamma_char_tw, &                                                                              !< characteristic shear for twins
       B, &                                                                                          !< drag coefficient
       d_caron                                                                                       !< distance of spontaneous annhihilation
-    real(pReal),               allocatable, dimension(:,:) :: &
+    real(pREAL),               allocatable, dimension(:,:) :: &
       h_sl_sl, &                                                                                    !< components of slip-slip interaction matrix
       h_sl_tw, &                                                                                    !< components of slip-twin interaction matrix
       h_sl_tr, &                                                                                    !< components of slip-trans interaction matrix
@@ -59,7 +59,7 @@ submodule(phase:plastic) dislotwin
       h_tr_tr, &                                                                                    !< components of trans-trans interaction matrix
       n0_sl, &                                                                                      !< slip system normal
       forestProjection
-    real(pReal),               allocatable, dimension(:,:,:) :: &
+    real(pREAL),               allocatable, dimension(:,:,:) :: &
       P_sl, &
       P_tw, &
       P_tr
@@ -96,7 +96,7 @@ submodule(phase:plastic) dislotwin
   end type tIndexDotState
 
   type :: tDislotwinState
-    real(pReal),                  dimension(:,:),   pointer :: &
+    real(pREAL),                  dimension(:,:),   pointer :: &
       rho_mob, &
       rho_dip, &
       gamma_sl, &
@@ -105,7 +105,7 @@ submodule(phase:plastic) dislotwin
   end type tDislotwinState
 
   type :: tDislotwinDependentState
-    real(pReal),                  dimension(:,:),   allocatable :: &
+    real(pREAL),                  dimension(:,:),   allocatable :: &
       Lambda_sl, &                                                                                  !< mean free path between 2 obstacles seen by a moving dislocation
       Lambda_tw, &                                                                                  !< mean free path between 2 obstacles seen by a growing twin
       Lambda_tr, &                                                                                  !< mean free path between 2 obstacles seen by a growing martensite
@@ -136,8 +136,8 @@ module function plastic_dislotwin_init() result(myPlasticity)
     startIndex, endIndex
   integer,     dimension(:), allocatable :: &
     N_sl
-  real(pReal) :: a_cF
-  real(pReal), allocatable, dimension(:) :: &
+  real(pREAL) :: a_cF
+  real(pREAL), allocatable, dimension(:) :: &
     rho_mob_0, &                                                                                    !< initial unipolar dislocation density per slip system
     rho_dip_0                                                                                       !< initial dipole dislocation density per slip system
   character(len=:), allocatable :: &
@@ -220,7 +220,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
       prm%q                    = pl%get_as1dReal('q_sl',        requiredSize=size(N_sl))
       prm%tau_0                = pl%get_as1dReal('tau_0',       requiredSize=size(N_sl))
       prm%B                    = pl%get_as1dReal('B',           requiredSize=size(N_sl), &
-                                                 defaultVal=[(0.0_pReal, i=1,size(N_sl))])
+                                                 defaultVal=[(0.0_pREAL, i=1,size(N_sl))])
 
       prm%Q_cl = pl%get_asReal('Q_cl')
 
@@ -229,8 +229,8 @@ module function plastic_dislotwin_init() result(myPlasticity)
 
       ! multiplication factor according to crystal structure (nearest neighbors bcc vs fcc/hex)
       ! details: Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981
-      prm%omega = pl%get_asReal('omega',  defaultVal = 1000.0_pReal) &
-                * merge(12.0_pReal,8.0_pReal,any(phase_lattice(ph) == ['cF','hP']))
+      prm%omega = pl%get_asReal('omega',  defaultVal = 1000.0_pREAL) &
+                * merge(12.0_pREAL,8.0_pREAL,any(phase_lattice(ph) == ['cF','hP']))
 
       ! expand: family => system
       rho_mob_0        = math_expand(rho_mob_0,       N_sl)
@@ -246,17 +246,17 @@ module function plastic_dislotwin_init() result(myPlasticity)
       prm%d_caron      = pl%get_asReal('D_a') * prm%b_sl
 
       ! sanity checks
-      if (    prm%Q_cl          <= 0.0_pReal)          extmsg = trim(extmsg)//' Q_cl'
-      if (any(rho_mob_0         <  0.0_pReal))         extmsg = trim(extmsg)//' rho_mob_0'
-      if (any(rho_dip_0         <  0.0_pReal))         extmsg = trim(extmsg)//' rho_dip_0'
-      if (any(prm%v_0           <  0.0_pReal))         extmsg = trim(extmsg)//' v_0'
-      if (any(prm%b_sl          <= 0.0_pReal))         extmsg = trim(extmsg)//' b_sl'
-      if (any(prm%Q_sl           <= 0.0_pReal))        extmsg = trim(extmsg)//' Q_sl'
-      if (any(prm%i_sl          <= 0.0_pReal))         extmsg = trim(extmsg)//' i_sl'
-      if (any(prm%B             <  0.0_pReal))         extmsg = trim(extmsg)//' B'
-      if (any(prm%d_caron       <  0.0_pReal))         extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
-      if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal))  extmsg = trim(extmsg)//' p_sl'
-      if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal))  extmsg = trim(extmsg)//' q_sl'
+      if (    prm%Q_cl          <= 0.0_pREAL)          extmsg = trim(extmsg)//' Q_cl'
+      if (any(rho_mob_0         <  0.0_pREAL))         extmsg = trim(extmsg)//' rho_mob_0'
+      if (any(rho_dip_0         <  0.0_pREAL))         extmsg = trim(extmsg)//' rho_dip_0'
+      if (any(prm%v_0           <  0.0_pREAL))         extmsg = trim(extmsg)//' v_0'
+      if (any(prm%b_sl          <= 0.0_pREAL))         extmsg = trim(extmsg)//' b_sl'
+      if (any(prm%Q_sl           <= 0.0_pREAL))        extmsg = trim(extmsg)//' Q_sl'
+      if (any(prm%i_sl          <= 0.0_pREAL))         extmsg = trim(extmsg)//' i_sl'
+      if (any(prm%B             <  0.0_pREAL))         extmsg = trim(extmsg)//' B'
+      if (any(prm%d_caron       <  0.0_pREAL))         extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
+      if (any(prm%p<=0.0_pREAL .or. prm%p>1.0_pREAL))  extmsg = trim(extmsg)//' p_sl'
+      if (any(prm%q< 1.0_pREAL .or. prm%q>2.0_pREAL))  extmsg = trim(extmsg)//' q_sl'
     else slipActive
       rho_mob_0 = emptyRealArray; rho_dip_0 = emptyRealArray
       allocate(prm%b_sl,prm%Q_sl,prm%v_0,prm%i_sl,prm%p,prm%q,prm%B,source=emptyRealArray)
@@ -289,11 +289,11 @@ module function plastic_dislotwin_init() result(myPlasticity)
 
       ! sanity checks
       if (.not. prm%fccTwinTransNucleation)   extmsg = trim(extmsg)//' TWIP for non-fcc'
-      if (    prm%L_tw          < 0.0_pReal)  extmsg = trim(extmsg)//' L_tw'
-      if (    prm%i_tw          < 0.0_pReal)  extmsg = trim(extmsg)//' i_tw'
-      if (any(prm%b_tw          < 0.0_pReal)) extmsg = trim(extmsg)//' b_tw'
-      if (any(prm%t_tw          < 0.0_pReal)) extmsg = trim(extmsg)//' t_tw'
-      if (any(prm%r             < 0.0_pReal)) extmsg = trim(extmsg)//' p_tw'
+      if (    prm%L_tw          < 0.0_pREAL)  extmsg = trim(extmsg)//' L_tw'
+      if (    prm%i_tw          < 0.0_pREAL)  extmsg = trim(extmsg)//' i_tw'
+      if (any(prm%b_tw          < 0.0_pREAL)) extmsg = trim(extmsg)//' b_tw'
+      if (any(prm%t_tw          < 0.0_pREAL)) extmsg = trim(extmsg)//' t_tw'
+      if (any(prm%r             < 0.0_pREAL)) extmsg = trim(extmsg)//' p_tw'
     else twinActive
       allocate(prm%gamma_char_tw,prm%b_tw,prm%t_tw,prm%r,source=emptyRealArray)
       allocate(prm%h_tw_tw(0,0))
@@ -310,10 +310,10 @@ module function plastic_dislotwin_init() result(myPlasticity)
       prm%i_tr       = pl%get_asReal('i_tr')
       prm%Delta_G    = polynomial(pl,'Delta_G','T')
       prm%L_tr       = pl%get_asReal('L_tr')
-      a_cF           = prm%b_tr(1)*sqrt(6.0_pReal)                                                  ! b_tr is Shockley partial
-      prm%h          = 5.0_pReal * a_cF/sqrt(3.0_pReal)
+      a_cF           = prm%b_tr(1)*sqrt(6.0_pREAL)                                                  ! b_tr is Shockley partial
+      prm%h          = 5.0_pREAL * a_cF/sqrt(3.0_pREAL)
       prm%cOverA_hP  = pl%get_asReal('c/a_hP')
-      prm%rho        = 4.0_pReal/(sqrt(3.0_pReal)*a_cF**2)/N_A
+      prm%rho        = 4.0_pREAL/(sqrt(3.0_pREAL)*a_cF**2)/N_A
       prm%V_mol      = pl%get_asReal('V_mol')
       prm%h_tr_tr = lattice_interaction_TransByTrans(prm%N_tr,pl%get_as1dReal('h_tr-tr'),&
                                                      phase_lattice(ph))
@@ -327,11 +327,11 @@ module function plastic_dislotwin_init() result(myPlasticity)
 
       ! sanity checks
       if (.not. prm%fccTwinTransNucleation)   extmsg = trim(extmsg)//' TRIP for non-fcc'
-      if (    prm%L_tr          < 0.0_pReal)  extmsg = trim(extmsg)//' L_tr'
-      if (    prm%V_mol         < 0.0_pReal)  extmsg = trim(extmsg)//' V_mol'
-      if (    prm%i_tr          < 0.0_pReal)  extmsg = trim(extmsg)//' i_tr'
-      if (any(prm%t_tr          < 0.0_pReal)) extmsg = trim(extmsg)//' t_tr'
-      if (any(prm%s             < 0.0_pReal)) extmsg = trim(extmsg)//' p_tr'
+      if (    prm%L_tr          < 0.0_pREAL)  extmsg = trim(extmsg)//' L_tr'
+      if (    prm%V_mol         < 0.0_pREAL)  extmsg = trim(extmsg)//' V_mol'
+      if (    prm%i_tr          < 0.0_pREAL)  extmsg = trim(extmsg)//' i_tr'
+      if (any(prm%t_tr          < 0.0_pREAL)) extmsg = trim(extmsg)//' t_tr'
+      if (any(prm%s             < 0.0_pREAL)) extmsg = trim(extmsg)//' p_tr'
     else transActive
       allocate(prm%s,prm%b_tr,prm%t_tr,source=emptyRealArray)
       allocate(prm%h_tr_tr(0,0))
@@ -339,18 +339,18 @@ module function plastic_dislotwin_init() result(myPlasticity)
 
 !--------------------------------------------------------------------------------------------------
 ! shearband related parameters
-    prm%gamma_0_sb = pl%get_asReal('gamma_0_sb',defaultVal=0.0_pReal)
-    if (prm%gamma_0_sb > 0.0_pReal) then
+    prm%gamma_0_sb = pl%get_asReal('gamma_0_sb',defaultVal=0.0_pREAL)
+    if (prm%gamma_0_sb > 0.0_pREAL) then
       prm%tau_sb       = pl%get_asReal('tau_sb')
       prm%E_sb         = pl%get_asReal('Q_sb')
       prm%p_sb         = pl%get_asReal('p_sb')
       prm%q_sb         = pl%get_asReal('q_sb')
 
       ! sanity checks
-      if (prm%tau_sb <  0.0_pReal) extmsg = trim(extmsg)//' tau_sb'
-      if (prm%E_sb   <  0.0_pReal) extmsg = trim(extmsg)//' Q_sb'
-      if (prm%p_sb   <= 0.0_pReal) extmsg = trim(extmsg)//' p_sb'
-      if (prm%q_sb   <= 0.0_pReal) extmsg = trim(extmsg)//' q_sb'
+      if (prm%tau_sb <  0.0_pREAL) extmsg = trim(extmsg)//' tau_sb'
+      if (prm%E_sb   <  0.0_pREAL) extmsg = trim(extmsg)//' Q_sb'
+      if (prm%p_sb   <= 0.0_pREAL) extmsg = trim(extmsg)//' p_sb'
+      if (prm%q_sb   <= 0.0_pREAL) extmsg = trim(extmsg)//' q_sb'
     end if
 
 !--------------------------------------------------------------------------------------------------
@@ -361,8 +361,8 @@ module function plastic_dislotwin_init() result(myPlasticity)
     if (prm%sum_N_tw + prm%sum_N_tr > 0) then
       prm%x_c  = pl%get_asReal('x_c')
       prm%V_cs = pl%get_asReal('V_cs')
-      if (prm%x_c  < 0.0_pReal)  extmsg = trim(extmsg)//' x_c'
-      if (prm%V_cs < 0.0_pReal)  extmsg = trim(extmsg)//' V_cs'
+      if (prm%x_c  < 0.0_pREAL)  extmsg = trim(extmsg)//' x_c'
+      if (prm%V_cs < 0.0_pREAL)  extmsg = trim(extmsg)//' V_cs'
     end if
 
     if (prm%sum_N_tw + prm%sum_N_tr > 0 .or. prm%extendedDislocations) &
@@ -402,41 +402,41 @@ module function plastic_dislotwin_init() result(myPlasticity)
     idx_dot%rho_mob = [startIndex,endIndex]
     stt%rho_mob=>plasticState(ph)%state(startIndex:endIndex,:)
     stt%rho_mob= spread(rho_mob_0,2,Nmembers)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_rho'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_sl
     idx_dot%rho_dip = [startIndex,endIndex]
     stt%rho_dip=>plasticState(ph)%state(startIndex:endIndex,:)
     stt%rho_dip= spread(rho_dip_0,2,Nmembers)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pReal)
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_sl
     idx_dot%gamma_sl = [startIndex,endIndex]
     stt%gamma_sl=>plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_tw
     idx_dot%f_tw = [startIndex,endIndex]
     stt%f_tw=>plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_f_tw',defaultVal=1.0e-6_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_f_tw'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_f_tw',defaultVal=1.0e-6_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_f_tw'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_tr
     idx_dot%f_tr = [startIndex,endIndex]
     stt%f_tr=>plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_f_tr',defaultVal=1.0e-6_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_f_tr'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_f_tr',defaultVal=1.0e-6_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_f_tr'
 
-    allocate(dst%tau_pass (prm%sum_N_sl,Nmembers),source=0.0_pReal)
-    allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers),source=0.0_pReal)
-    allocate(dst%Lambda_tw(prm%sum_N_tw,Nmembers),source=0.0_pReal)
-    allocate(dst%Lambda_tr(prm%sum_N_tr,Nmembers),source=0.0_pReal)
+    allocate(dst%tau_pass (prm%sum_N_sl,Nmembers),source=0.0_pREAL)
+    allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers),source=0.0_pREAL)
+    allocate(dst%Lambda_tw(prm%sum_N_tw,Nmembers),source=0.0_pREAL)
+    allocate(dst%Lambda_tr(prm%sum_N_tr,Nmembers),source=0.0_pREAL)
 
     end associate
 
@@ -456,21 +456,21 @@ module function plastic_dislotwin_homogenizedC(ph,en) result(homogenizedC)
 
   integer,     intent(in) :: &
     ph, en
-  real(pReal), dimension(6,6) :: &
+  real(pREAL), dimension(6,6) :: &
     homogenizedC, &
     C
-  real(pReal), dimension(:,:,:), allocatable :: &
+  real(pREAL), dimension(:,:,:), allocatable :: &
     C66_tw, &
     C66_tr
   integer :: i
-  real(pReal) :: f_matrix
+  real(pREAL) :: f_matrix
 
 
   C = elastic_C66(ph,en)
 
   associate(prm => param(ph), stt => state(ph))
 
-    f_matrix = 1.0_pReal &
+    f_matrix = 1.0_pREAL &
              - sum(stt%f_tw(1:prm%sum_N_tw,en)) &
              - sum(stt%f_tr(1:prm%sum_N_tr,en))
 
@@ -502,28 +502,28 @@ end function plastic_dislotwin_homogenizedC
 !--------------------------------------------------------------------------------------------------
 module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
-  real(pReal), dimension(3,3),     intent(out) :: Lp
-  real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp
-  real(pReal), dimension(3,3),     intent(in)  :: Mp
+  real(pREAL), dimension(3,3),     intent(out) :: Lp
+  real(pREAL), dimension(3,3,3,3), intent(out) :: dLp_dMp
+  real(pREAL), dimension(3,3),     intent(in)  :: Mp
   integer,                         intent(in)  :: ph,en
 
   integer :: i,k,l,m,n
-  real(pReal) :: &
+  real(pREAL) :: &
     f_matrix,StressRatio_p,&
     E_kB_T, &
     ddot_gamma_dtau, &
     tau, &
     T
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_sl,ddot_gamma_dtau_sl
-  real(pReal), dimension(param(ph)%sum_N_tw) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw) :: &
     dot_gamma_tw,ddot_gamma_dtau_tw
-  real(pReal), dimension(param(ph)%sum_N_tr) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tr) :: &
     dot_gamma_tr,ddot_gamma_dtau_tr
-  real(pReal):: dot_gamma_sb
-  real(pReal), dimension(3,3) :: eigVectors, P_sb
-  real(pReal), dimension(3)   :: eigValues
-  real(pReal), dimension(3,6), parameter :: &
+  real(pREAL):: dot_gamma_sb
+  real(pREAL), dimension(3,3) :: eigVectors, P_sb
+  real(pREAL), dimension(3)   :: eigValues
+  real(pREAL), dimension(3,6), parameter :: &
     sb_sComposition = &
       reshape(real([&
          1, 0, 1, &
@@ -532,7 +532,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
          1,-1, 0, &
          0, 1, 1, &
          0, 1,-1  &
-         ],pReal),[ 3,6]), &
+         ],pREAL),[ 3,6]), &
     sb_mComposition = &
       reshape(real([&
          1, 0,-1, &
@@ -541,16 +541,16 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
          1, 1, 0, &
          0, 1,-1, &
          0, 1, 1  &
-         ],pReal),[ 3,6])
+         ],pREAL),[ 3,6])
 
 
   T = thermal_T(ph,en)
-  Lp = 0.0_pReal
-  dLp_dMp = 0.0_pReal
+  Lp = 0.0_pREAL
+  dLp_dMp = 0.0_pREAL
 
   associate(prm => param(ph), stt => state(ph))
 
-    f_matrix = 1.0_pReal &
+    f_matrix = 1.0_pREAL &
              - sum(stt%f_tw(1:prm%sum_N_tw,en)) &
              - sum(stt%f_tr(1:prm%sum_N_tr,en))
 
@@ -587,7 +587,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
       call math_eigh33(eigValues,eigVectors,Mp)                                                     ! is Mp symmetric by design?
 
       do i = 1,6
-        P_sb = 0.5_pReal * math_outer(matmul(eigVectors,sb_sComposition(1:3,i)),&
+        P_sb = 0.5_pREAL * math_outer(matmul(eigVectors,sb_sComposition(1:3,i)),&
                                       matmul(eigVectors,sb_mComposition(1:3,i)))
         tau = math_tensordot(Mp,P_sb)
 
@@ -595,8 +595,8 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
           StressRatio_p = (abs(tau)/prm%tau_sb)**prm%p_sb
           dot_gamma_sb = sign(prm%gamma_0_sb*exp(-E_kB_T*(1-StressRatio_p)**prm%q_sb), tau)
           ddot_gamma_dtau = abs(dot_gamma_sb)*E_kB_T*prm%p_sb*prm%q_sb/prm%tau_sb &
-                          * (abs(tau)/prm%tau_sb)**(prm%p_sb-1.0_pReal) &
-                          * (1.0_pReal-StressRatio_p)**(prm%q_sb-1.0_pReal)
+                          * (abs(tau)/prm%tau_sb)**(prm%p_sb-1.0_pREAL) &
+                          * (1.0_pREAL-StressRatio_p)**(prm%q_sb-1.0_pREAL)
 
           Lp = Lp + dot_gamma_sb * P_sb
           forall (k=1:3,l=1:3,m=1:3,n=1:3) &
@@ -617,31 +617,31 @@ end subroutine dislotwin_LpAndItsTangent
 !--------------------------------------------------------------------------------------------------
 module function dislotwin_dotState(Mp,ph,en) result(dotState)
 
-  real(pReal), dimension(3,3),  intent(in):: &
+  real(pREAL), dimension(3,3),  intent(in):: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
 
   integer :: i
-  real(pReal) :: &
+  real(pREAL) :: &
     f_matrix, &
     d_hat, &
     v_cl, &                                                                                         !< climb velocity
     tau, &
     sigma_cl, &                                                                                     !< climb stress
     b_d                                                                                             !< ratio of Burgers vector to stacking fault width
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_rho_dip_formation, &
     dot_rho_dip_climb, &
     dot_gamma_sl
-  real(pReal), dimension(param(ph)%sum_N_tw) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw) :: &
     dot_gamma_tw
-  real(pReal), dimension(param(ph)%sum_N_tr) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tr) :: &
     dot_gamma_tr
-  real(pReal) :: &
+  real(pREAL) :: &
     mu, nu, &
     T
 
@@ -657,7 +657,7 @@ module function dislotwin_dotState(Mp,ph,en) result(dotState)
     nu = elastic_nu(ph,en,prm%isotropic_bound)
     T = thermal_T(ph,en)
 
-    f_matrix = 1.0_pReal &
+    f_matrix = 1.0_pREAL &
              - sum(stt%f_tw(1:prm%sum_N_tw,en)) &
              - sum(stt%f_tr(1:prm%sum_N_tr,en))
 
@@ -668,30 +668,30 @@ module function dislotwin_dotState(Mp,ph,en) result(dotState)
       tau = math_tensordot(Mp,prm%P_sl(1:3,1:3,i))
 
       significantSlipStress: if (dEq0(tau) .or. prm%omitDipoles) then
-        dot_rho_dip_formation(i) = 0.0_pReal
-        dot_rho_dip_climb(i) = 0.0_pReal
+        dot_rho_dip_formation(i) = 0.0_pREAL
+        dot_rho_dip_climb(i) = 0.0_pREAL
       else significantSlipStress
-        d_hat = 3.0_pReal*mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau))
+        d_hat = 3.0_pREAL*mu*prm%b_sl(i)/(16.0_pREAL*PI*abs(tau))
         d_hat = math_clip(d_hat, right = dst%Lambda_sl(i,en))
         d_hat = math_clip(d_hat, left  = prm%d_caron(i))
 
-        dot_rho_dip_formation(i) = 2.0_pReal*(d_hat-prm%d_caron(i))/prm%b_sl(i) &
+        dot_rho_dip_formation(i) = 2.0_pREAL*(d_hat-prm%d_caron(i))/prm%b_sl(i) &
                                  * stt%rho_mob(i,en)*abs_dot_gamma_sl(i)
 
         if (dEq(d_hat,prm%d_caron(i))) then
-          dot_rho_dip_climb(i) = 0.0_pReal
+          dot_rho_dip_climb(i) = 0.0_pREAL
         else
           ! Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981
           sigma_cl = dot_product(prm%n0_sl(1:3,i),matmul(Mp,prm%n0_sl(1:3,i)))
           if (prm%extendedDislocations) then
-            b_d = 24.0_pReal*PI*(1.0_pReal - nu)/(2.0_pReal + nu) * prm%Gamma_sf%at(T) / (mu*prm%b_sl(i))
+            b_d = 24.0_pREAL*PI*(1.0_pREAL - nu)/(2.0_pREAL + nu) * prm%Gamma_sf%at(T) / (mu*prm%b_sl(i))
           else
-            b_d = 1.0_pReal
+            b_d = 1.0_pREAL
           end if
-          v_cl = 2.0_pReal*prm%omega*b_d**2*exp(-prm%Q_cl/(K_B*T)) &
-               * (exp(abs(sigma_cl)*prm%b_sl(i)**3/(K_B*T)) - 1.0_pReal)
+          v_cl = 2.0_pREAL*prm%omega*b_d**2*exp(-prm%Q_cl/(K_B*T)) &
+               * (exp(abs(sigma_cl)*prm%b_sl(i)**3/(K_B*T)) - 1.0_pREAL)
 
-          dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,en) &
+          dot_rho_dip_climb(i) = 4.0_pREAL*v_cl*stt%rho_dip(i,en) &
                                / (d_hat-prm%d_caron(i))
         end if
       end if significantSlipStress
@@ -699,10 +699,10 @@ module function dislotwin_dotState(Mp,ph,en) result(dotState)
 
     dot_rho_mob = abs_dot_gamma_sl/(prm%b_sl*dst%Lambda_sl(:,en)) &
                 - dot_rho_dip_formation &
-                - 2.0_pReal*prm%d_caron/prm%b_sl * stt%rho_mob(:,en)*abs_dot_gamma_sl
+                - 2.0_pREAL*prm%d_caron/prm%b_sl * stt%rho_mob(:,en)*abs_dot_gamma_sl
 
     dot_rho_dip = dot_rho_dip_formation &
-                - 2.0_pReal*prm%d_caron/prm%b_sl * stt%rho_dip(:,en)*abs_dot_gamma_sl &
+                - 2.0_pREAL*prm%d_caron/prm%b_sl * stt%rho_dip(:,en)*abs_dot_gamma_sl &
                 - dot_rho_dip_climb
 
     if (prm%sum_N_tw > 0) call kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,dot_gamma_tw)
@@ -725,17 +725,17 @@ module subroutine dislotwin_dependentState(ph,en)
     ph, &
     en
 
-  real(pReal) :: &
+  real(pREAL) :: &
     sumf_tw, sumf_tr
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     inv_lambda_sl
-  real(pReal), dimension(param(ph)%sum_N_tw) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw) :: &
     inv_lambda_tw_tw, &                                                                             !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin
     f_over_t_tw
-   real(pReal), dimension(param(ph)%sum_N_tr) :: &
+   real(pREAL), dimension(param(ph)%sum_N_tr) :: &
     inv_lambda_tr_tr, &                                                                             !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite
     f_over_t_tr
-  real(pReal) :: &
+  real(pREAL) :: &
     mu
 
 
@@ -752,16 +752,16 @@ module subroutine dislotwin_dependentState(ph,en)
 
     inv_lambda_sl = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,en)+stt%rho_dip(:,en)))/prm%i_sl
     if (prm%sum_N_tw > 0 .and. prm%sum_N_sl > 0) &
-      inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pReal-sumf_tw)
+      inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pREAL-sumf_tw)
     if (prm%sum_N_tr > 0 .and. prm%sum_N_sl > 0) &
-      inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pReal-sumf_tr)
-    dst%Lambda_sl(:,en) = prm%D / (1.0_pReal+prm%D*inv_lambda_sl)
+      inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pREAL-sumf_tr)
+    dst%Lambda_sl(:,en) = prm%D / (1.0_pREAL+prm%D*inv_lambda_sl)
 
-    inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pReal-sumf_tw)
-    dst%Lambda_tw(:,en) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw)
+    inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pREAL-sumf_tw)
+    dst%Lambda_tw(:,en) = prm%i_tw*prm%D/(1.0_pREAL+prm%D*inv_lambda_tw_tw)
 
-    inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_tr)
-    dst%Lambda_tr(:,en) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr)
+    inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pREAL-sumf_tr)
+    dst%Lambda_tr(:,en) = prm%i_tr*prm%D/(1.0_pREAL+prm%D*inv_lambda_tr_tr)
 
     !* threshold stress for dislocation motion
     dst%tau_pass(:,en) = mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
@@ -834,22 +834,22 @@ end subroutine plastic_dislotwin_result
 pure subroutine kinetics_sl(Mp,T,ph,en, &
                             dot_gamma_sl,ddot_gamma_dtau_sl,tau_sl)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
-  real(pReal),                  intent(in) :: &
+  real(pREAL),                  intent(in) :: &
     T                                                                                               !< temperature
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(param(ph)%sum_N_sl), intent(out) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl), intent(out) :: &
     dot_gamma_sl
-  real(pReal), dimension(param(ph)%sum_N_sl), optional, intent(out) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl), optional, intent(out) :: &
     ddot_gamma_dtau_sl, &
     tau_sl
 
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     ddot_gamma_dtau
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     tau, &
     stressRatio, &
     StressRatio_p, &
@@ -873,23 +873,23 @@ pure subroutine kinetics_sl(Mp,T,ph,en, &
       stressRatio    = tau_eff/prm%tau_0
       StressRatio_p  = stressRatio** prm%p
       Q_kB_T = prm%Q_sl/(K_B*T)
-      v_wait_inverse = exp(Q_kB_T*(1.0_pReal-StressRatio_p)** prm%q) &
+      v_wait_inverse = exp(Q_kB_T*(1.0_pREAL-StressRatio_p)** prm%q) &
                      / prm%v_0
       v_run_inverse  = prm%B/(tau_eff*prm%b_sl)
 
       dot_gamma_sl = sign(stt%rho_mob(:,en)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau)
 
-      dV_wait_inverse_dTau = -1.0_pReal * v_wait_inverse * prm%p * prm%q * Q_kB_T &
-                           * (stressRatio**(prm%p-1.0_pReal)) &
-                           * (1.0_pReal-StressRatio_p)**(prm%q-1.0_pReal) &
+      dV_wait_inverse_dTau = -1.0_pREAL * v_wait_inverse * prm%p * prm%q * Q_kB_T &
+                           * (stressRatio**(prm%p-1.0_pREAL)) &
+                           * (1.0_pREAL-StressRatio_p)**(prm%q-1.0_pREAL) &
                            / prm%tau_0
-      dV_run_inverse_dTau  = -1.0_pReal * v_run_inverse/tau_eff
-      dV_dTau              = -1.0_pReal * (dV_wait_inverse_dTau+dV_run_inverse_dTau) &
+      dV_run_inverse_dTau  = -1.0_pREAL * v_run_inverse/tau_eff
+      dV_dTau              = -1.0_pREAL * (dV_wait_inverse_dTau+dV_run_inverse_dTau) &
                            / (v_wait_inverse+v_run_inverse)**2
       ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,en)*prm%b_sl
     else where significantStress
-      dot_gamma_sl    = 0.0_pReal
-      ddot_gamma_dtau = 0.0_pReal
+      dot_gamma_sl    = 0.0_pREAL
+      ddot_gamma_dtau = 0.0_pREAL
     end where significantStress
 
   end associate
@@ -910,21 +910,21 @@ end subroutine kinetics_sl
 pure subroutine kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,&
                             dot_gamma_tw,ddot_gamma_dtau_tw)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
-  real(pReal),                  intent(in) :: &
+  real(pREAL),                  intent(in) :: &
     T                                                                                               !< temperature
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl), intent(in) :: &
     abs_dot_gamma_sl
-  real(pReal), dimension(param(ph)%sum_N_tw), intent(out) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw), intent(out) :: &
     dot_gamma_tw
-  real(pReal), dimension(param(ph)%sum_N_tw), optional, intent(out) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw), optional, intent(out) :: &
     ddot_gamma_dtau_tw
 
-  real(pReal) :: &
+  real(pREAL) :: &
     tau, tau_r, tau_hat, &
     dot_N_0, &
     x0, V, &
@@ -943,10 +943,10 @@ pure subroutine kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,&
     nu = elastic_nu(ph,en,prm%isotropic_bound)
     Gamma_sf = prm%Gamma_sf%at(T)
 
-    tau_hat = 3.0_pReal*prm%b_tw(1)*mu/prm%L_tw &
-            + Gamma_sf/(3.0_pReal*prm%b_tw(1))
-    x0 = mu*prm%b_sl(1)**2*(2.0_pReal+nu)/(Gamma_sf*8.0_pReal*PI*(1.0_pReal-nu))
-    tau_r = mu*prm%b_sl(1)/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c)+cos(PI/3.0_pReal)/x0)
+    tau_hat = 3.0_pREAL*prm%b_tw(1)*mu/prm%L_tw &
+            + Gamma_sf/(3.0_pREAL*prm%b_tw(1))
+    x0 = mu*prm%b_sl(1)**2*(2.0_pREAL+nu)/(Gamma_sf*8.0_pREAL*PI*(1.0_pREAL-nu))
+    tau_r = mu*prm%b_sl(1)/(2.0_pREAL*PI)*(1.0_pREAL/(x0+prm%x_c)+cos(PI/3.0_pREAL)/x0)
 
     do i = 1, prm%sum_N_tw
       tau = math_tensordot(Mp,prm%P_tw(1:3,1:3,i))
@@ -956,18 +956,18 @@ pure subroutine kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,&
         dP_dTau = prm%r(i) * (tau_hat/tau)**prm%r(i)/tau * P
 
         s = prm%fcc_twinNucleationSlipPair(1:2,i)
-        dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tw*3.0_pReal)
+        dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tw*3.0_pREAL)
 
-        P_ncs = 1.0_pReal-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
-        dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pReal)
+        P_ncs = 1.0_pREAL-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
+        dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pREAL)
 
-        V = PI/4.0_pReal*dst%Lambda_tw(i,en)**2*prm%t_tw(i)
+        V = PI/4.0_pREAL*dst%Lambda_tw(i,en)**2*prm%t_tw(i)
         dot_gamma_tw(i) = V*dot_N_0*P_ncs*P*prm%gamma_char_tw(i)
         if (present(ddot_gamma_dtau_tw)) &
           ddot_gamma_dtau_tw(i) = V*dot_N_0*(P*dP_ncs_dtau + P_ncs*dP_dtau)*prm%gamma_char_tw(i)
       else
-        dot_gamma_tw(i) = 0.0_pReal
-        if (present(ddot_gamma_dtau_tw)) ddot_gamma_dtau_tw(i) = 0.0_pReal
+        dot_gamma_tw(i) = 0.0_pREAL
+        if (present(ddot_gamma_dtau_tw)) ddot_gamma_dtau_tw(i) = 0.0_pREAL
       end if
     end do
 
@@ -986,21 +986,21 @@ end subroutine kinetics_tw
 pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,&
                             dot_gamma_tr,ddot_gamma_dtau_tr)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
-  real(pReal),                  intent(in) :: &
+  real(pREAL),                  intent(in) :: &
     T                                                                                               !< temperature
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl), intent(in) :: &
     abs_dot_gamma_sl
-  real(pReal), dimension(param(ph)%sum_N_tr), intent(out) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tr), intent(out) :: &
     dot_gamma_tr
-  real(pReal), dimension(param(ph)%sum_N_tr), optional, intent(out) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tr), optional, intent(out) :: &
     ddot_gamma_dtau_tr
 
-  real(pReal) :: &
+  real(pREAL) :: &
     tau, tau_r, tau_hat, &
     dot_N_0, &
     x0, V, &
@@ -1019,10 +1019,10 @@ pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,&
     nu = elastic_nu(ph,en,prm%isotropic_bound)
     Gamma_sf = prm%Gamma_sf%at(T)
 
-    tau_hat = 3.0_pReal*prm%b_tr(1)*mu/prm%L_tr &
-            + (Gamma_sf + (prm%h/prm%V_mol - 2.0_pReal*prm%rho)*prm%Delta_G%at(T))/(3.0_pReal*prm%b_tr(1))
-    x0 = mu*prm%b_sl(1)**2*(2.0_pReal+nu)/(Gamma_sf*8.0_pReal*PI*(1.0_pReal-nu))
-    tau_r = mu*prm%b_sl(1)/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c)+cos(PI/3.0_pReal)/x0)
+    tau_hat = 3.0_pREAL*prm%b_tr(1)*mu/prm%L_tr &
+            + (Gamma_sf + (prm%h/prm%V_mol - 2.0_pREAL*prm%rho)*prm%Delta_G%at(T))/(3.0_pREAL*prm%b_tr(1))
+    x0 = mu*prm%b_sl(1)**2*(2.0_pREAL+nu)/(Gamma_sf*8.0_pREAL*PI*(1.0_pREAL-nu))
+    tau_r = mu*prm%b_sl(1)/(2.0_pREAL*PI)*(1.0_pREAL/(x0+prm%x_c)+cos(PI/3.0_pREAL)/x0)
 
     do i = 1, prm%sum_N_tr
       tau = math_tensordot(Mp,prm%P_tr(1:3,1:3,i))
@@ -1032,18 +1032,18 @@ pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,&
         dP_dTau = prm%s(i) * (tau_hat/tau)**prm%s(i)/tau * P
 
         s = prm%fcc_twinNucleationSlipPair(1:2,i)
-        dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tr*3.0_pReal)
+        dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tr*3.0_pREAL)
 
-        P_ncs = 1.0_pReal-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
-        dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pReal)
+        P_ncs = 1.0_pREAL-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
+        dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pREAL)
 
-        V = PI/4.0_pReal*dst%Lambda_tr(i,en)**2*prm%t_tr(i)
+        V = PI/4.0_pREAL*dst%Lambda_tr(i,en)**2*prm%t_tr(i)
         dot_gamma_tr(i) = V*dot_N_0*P_ncs*P*gamma_char_tr
         if (present(ddot_gamma_dtau_tr)) &
           ddot_gamma_dtau_tr(i) = V*dot_N_0*(P*dP_ncs_dtau + P_ncs*dP_dtau)*gamma_char_tr
       else
-        dot_gamma_tr(i) = 0.0_pReal
-        if (present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr(i) = 0.0_pReal
+        dot_gamma_tr(i) = 0.0_pREAL
+        if (present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr(i) = 0.0_pREAL
       end if
     end do
 

src/phase_mechanical_plastic_isotropic.f90

@@ -10,7 +10,7 @@
 submodule(phase:plastic) isotropic
 
   type :: tParameters
-    real(pReal) :: &
+    real(pREAL) :: &
       M, &                                                                                          !< Taylor factor
       dot_gamma_0, &                                                                                !< reference strain rate
       n, &                                                                                          !< stress exponent
@@ -30,7 +30,7 @@ submodule(phase:plastic) isotropic
   end type tParameters
 
   type :: tIsotropicState
-    real(pReal), pointer, dimension(:) :: &
+    real(pREAL), pointer, dimension(:) :: &
       xi
   end type tIsotropicState
 
@@ -52,7 +52,7 @@ module function plastic_isotropic_init() result(myPlasticity)
     ph, &
     Nmembers, &
     sizeState, sizeDotState
-  real(pReal) :: &
+  real(pREAL) :: &
     xi_0                                                                                            !< initial critical stress
   character(len=:), allocatable :: &
     refs, &
@@ -103,24 +103,24 @@ module function plastic_isotropic_init() result(myPlasticity)
     prm%dot_gamma_0 = pl%get_asReal('dot_gamma_0')
     prm%n           = pl%get_asReal('n')
     prm%h_0         = pl%get_asReal('h_0')
-    prm%h           = pl%get_asReal('h',    defaultVal=3.0_pReal)                                   ! match for fcc random polycrystal
+    prm%h           = pl%get_asReal('h',    defaultVal=3.0_pREAL)                                   ! match for fcc random polycrystal
     prm%M           = pl%get_asReal('M')
-    prm%h_ln        = pl%get_asReal('h_ln', defaultVal=0.0_pReal)
-    prm%c_1         = pl%get_asReal('c_1',  defaultVal=0.0_pReal)
-    prm%c_4         = pl%get_asReal('c_4',  defaultVal=0.0_pReal)
-    prm%c_3         = pl%get_asReal('c_3',  defaultVal=0.0_pReal)
-    prm%c_2         = pl%get_asReal('c_2',  defaultVal=0.0_pReal)
+    prm%h_ln        = pl%get_asReal('h_ln', defaultVal=0.0_pREAL)
+    prm%c_1         = pl%get_asReal('c_1',  defaultVal=0.0_pREAL)
+    prm%c_4         = pl%get_asReal('c_4',  defaultVal=0.0_pREAL)
+    prm%c_3         = pl%get_asReal('c_3',  defaultVal=0.0_pREAL)
+    prm%c_2         = pl%get_asReal('c_2',  defaultVal=0.0_pREAL)
     prm%a           = pl%get_asReal('a')
 
     prm%dilatation  = pl%get_asBool('dilatation',defaultVal = .false.)
 
 !--------------------------------------------------------------------------------------------------
 !  sanity checks
-    if (xi_0            <  0.0_pReal) extmsg = trim(extmsg)//' xi_0'
-    if (prm%dot_gamma_0 <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0'
-    if (prm%n           <= 0.0_pReal) extmsg = trim(extmsg)//' n'
-    if (prm%a           <= 0.0_pReal) extmsg = trim(extmsg)//' a'
-    if (prm%M           <= 0.0_pReal) extmsg = trim(extmsg)//' M'
+    if (xi_0            <  0.0_pREAL) extmsg = trim(extmsg)//' xi_0'
+    if (prm%dot_gamma_0 <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0'
+    if (prm%n           <= 0.0_pREAL) extmsg = trim(extmsg)//' n'
+    if (prm%a           <= 0.0_pREAL) extmsg = trim(extmsg)//' a'
+    if (prm%M           <= 0.0_pREAL) extmsg = trim(extmsg)//' M'
 
 !--------------------------------------------------------------------------------------------------
 ! allocate state arrays
@@ -135,8 +135,8 @@ module function plastic_isotropic_init() result(myPlasticity)
 ! state aliases and initialization
     stt%xi => plasticState(ph)%state(1,:)
     stt%xi = xi_0
-    plasticState(ph)%atol(1) = pl%get_asReal('atol_xi',defaultVal=1.0_pReal)
-    if (plasticState(ph)%atol(1) < 0.0_pReal) extmsg = trim(extmsg)//' atol_xi'
+    plasticState(ph)%atol(1) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
+    if (plasticState(ph)%atol(1) < 0.0_pREAL) extmsg = trim(extmsg)//' atol_xi'
 
     end associate
 
@@ -154,20 +154,20 @@ end function plastic_isotropic_init
 !--------------------------------------------------------------------------------------------------
 module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
-  real(pReal), dimension(3,3),     intent(out) :: &
+  real(pREAL), dimension(3,3),     intent(out) :: &
     Lp                                                                                              !< plastic velocity gradient
-  real(pReal), dimension(3,3,3,3), intent(out) :: &
+  real(pREAL), dimension(3,3,3,3), intent(out) :: &
     dLp_dMp                                                                                         !< derivative of Lp with respect to the Mandel stress
 
-  real(pReal), dimension(3,3), intent(in) :: &
+  real(pREAL), dimension(3,3), intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                     intent(in) :: &
     ph, &
     en
 
-  real(pReal), dimension(3,3) :: &
+  real(pREAL), dimension(3,3) :: &
     Mp_dev                                                                                          !< deviatoric part of the Mandel stress
-  real(pReal) :: &
+  real(pREAL) :: &
     dot_gamma, &                                                                                    !< strainrate
     norm_Mp_dev, &                                                                                  !< norm of the deviatoric part of the Mandel stress
     squarenorm_Mp_dev                                                                               !< square of the norm of the deviatoric part of the Mandel stress
@@ -181,20 +181,20 @@ module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
     squarenorm_Mp_dev = math_tensordot(Mp_dev,Mp_dev)
     norm_Mp_dev = sqrt(squarenorm_Mp_dev)
 
-    if (norm_Mp_dev > 0.0_pReal) then
-      dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%M*stt%xi(en)))**prm%n
+    if (norm_Mp_dev > 0.0_pREAL) then
+      dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pREAL) * norm_Mp_dev/(prm%M*stt%xi(en)))**prm%n
 
       Lp = dot_gamma * Mp_dev/norm_Mp_dev
       forall (k=1:3,l=1:3,m=1:3,n=1:3) &
-        dLp_dMp(k,l,m,n) = (prm%n-1.0_pReal) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev
+        dLp_dMp(k,l,m,n) = (prm%n-1.0_pREAL) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev
       forall (k=1:3,l=1:3) &
-        dLp_dMp(k,l,k,l) = dLp_dMp(k,l,k,l) + 1.0_pReal
+        dLp_dMp(k,l,k,l) = dLp_dMp(k,l,k,l) + 1.0_pREAL
       forall (k=1:3,m=1:3) &
-        dLp_dMp(k,k,m,m) = dLp_dMp(k,k,m,m) - 1.0_pReal/3.0_pReal
+        dLp_dMp(k,k,m,m) = dLp_dMp(k,k,m,m) - 1.0_pREAL/3.0_pREAL
       dLp_dMp = dot_gamma * dLp_dMp / norm_Mp_dev
     else
-      Lp = 0.0_pReal
-      dLp_dMp = 0.0_pReal
+      Lp = 0.0_pREAL
+      dLp_dMp = 0.0_pREAL
     end if
 
   end associate
@@ -207,18 +207,18 @@ end subroutine isotropic_LpAndItsTangent
 !--------------------------------------------------------------------------------------------------
 module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
 
-  real(pReal), dimension(3,3),     intent(out) :: &
+  real(pREAL), dimension(3,3),     intent(out) :: &
     Li                                                                                              !< inleastic velocity gradient
-  real(pReal), dimension(3,3,3,3), intent(out)  :: &
+  real(pREAL), dimension(3,3,3,3), intent(out)  :: &
     dLi_dMi                                                                                         !< derivative of Li with respect to Mandel stress
 
-  real(pReal), dimension(3,3), intent(in) :: &
+  real(pREAL), dimension(3,3), intent(in) :: &
     Mi                                                                                              !< Mandel stress
   integer,                     intent(in) :: &
     ph, &
     en
 
-  real(pReal) :: &
+  real(pREAL) :: &
     tr                                                                                              !< trace of spherical part of Mandel stress (= 3 x pressure)
   integer :: &
     k, l, m, n
@@ -228,14 +228,14 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
 
     tr=math_trace33(math_spherical33(Mi))
 
-    if (prm%dilatation .and. abs(tr) > 0.0_pReal) then                                              ! no stress or J2 plasticity --> Li and its derivative are zero
+    if (prm%dilatation .and. abs(tr) > 0.0_pREAL) then                                              ! no stress or J2 plasticity --> Li and its derivative are zero
       Li = math_I3 &
-         * prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(en))**(-prm%n) &
-         * tr * abs(tr)**(prm%n-1.0_pReal)
+         * prm%dot_gamma_0 * (3.0_pREAL*prm%M*stt%xi(en))**(-prm%n) &
+         * tr * abs(tr)**(prm%n-1.0_pREAL)
       forall (k=1:3,l=1:3,m=1:3,n=1:3) dLi_dMi(k,l,m,n) = prm%n / tr * Li(k,l) * math_I3(m,n)
     else
-      Li      = 0.0_pReal
-      dLi_dMi = 0.0_pReal
+      Li      = 0.0_pREAL
+      dLi_dMi = 0.0_pREAL
     end if
 
   end associate
@@ -248,15 +248,15 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
 !--------------------------------------------------------------------------------------------------
 module function isotropic_dotState(Mp,ph,en) result(dotState)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
 
-  real(pReal) :: &
+  real(pREAL) :: &
     dot_gamma, &                                                                                    !< strainrate
     xi_inf_star, &                                                                                  !< saturation xi
     norm_Mp                                                                                         !< norm of the (deviatoric) Mandel stress
@@ -267,21 +267,21 @@ module function isotropic_dotState(Mp,ph,en) result(dotState)
                     sqrt(math_tensordot(math_deviatoric33(Mp),math_deviatoric33(Mp))), &
                     prm%dilatation)
 
-  dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp /(prm%M*stt%xi(en))) **prm%n
+  dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pREAL) * norm_Mp /(prm%M*stt%xi(en))) **prm%n
 
-  if (dot_gamma > 1e-12_pReal) then
+  if (dot_gamma > 1e-12_pREAL) then
     if (dEq0(prm%c_1)) then
       xi_inf_star = prm%xi_inf
     else
       xi_inf_star = prm%xi_inf &
-                  + asinh( (dot_gamma / prm%c_1)**(1.0_pReal / prm%c_2))**(1.0_pReal / prm%c_3) &
-                  / prm%c_4 * (dot_gamma / prm%dot_gamma_0)**(1.0_pReal / prm%n)
+                  + asinh( (dot_gamma / prm%c_1)**(1.0_pREAL / prm%c_2))**(1.0_pREAL / prm%c_3) &
+                  / prm%c_4 * (dot_gamma / prm%dot_gamma_0)**(1.0_pREAL / prm%n)
     end if
     dot_xi = dot_gamma &
            * ( prm%h_0 + prm%h_ln * log(dot_gamma) ) &
-           * sign(abs(1.0_pReal - stt%xi(en)/xi_inf_star)**prm%a *prm%h, 1.0_pReal-stt%xi(en)/xi_inf_star)
+           * sign(abs(1.0_pREAL - stt%xi(en)/xi_inf_star)**prm%a *prm%h, 1.0_pREAL-stt%xi(en)/xi_inf_star)
   else
-    dot_xi = 0.0_pReal
+    dot_xi = 0.0_pREAL
   end if
 
   end associate

src/phase_mechanical_plastic_kinehardening.f90

@@ -8,10 +8,10 @@
 submodule(phase:plastic) kinehardening
 
   type :: tParameters
-    real(pReal) :: &
-      n           = 1.0_pReal, &                                                                    !< stress exponent for slip
-      dot_gamma_0 = 1.0_pReal                                                                       !< reference shear strain rate for slip
-    real(pReal),              allocatable, dimension(:) :: &
+    real(pREAL) :: &
+      n           = 1.0_pREAL, &                                                                    !< stress exponent for slip
+      dot_gamma_0 = 1.0_pREAL                                                                       !< reference shear strain rate for slip
+    real(pREAL),              allocatable, dimension(:) :: &
       h_0_xi, &                                                                                     !< initial hardening rate of forest stress per slip family
                                                                                                     !! θ_0,for
       h_0_chi, &                                                                                    !< initial hardening rate of back stress per slip family
@@ -22,9 +22,9 @@ submodule(phase:plastic) kinehardening
                                                                                                     !! θ_1,bs
       xi_inf, &                                                                                     !< back-extrapolated forest stress from terminal linear hardening
       chi_inf                                                                                       !< back-extrapolated back stress from terminal linear hardening
-    real(pReal),              allocatable, dimension(:,:) :: &
+    real(pREAL),              allocatable, dimension(:,:) :: &
       h_sl_sl                                                                                       !< slip resistance change per slip activity
-    real(pReal),              allocatable, dimension(:,:,:) :: &
+    real(pREAL),              allocatable, dimension(:,:,:) :: &
       P, &
       P_nS_pos, &
       P_nS_neg
@@ -46,7 +46,7 @@ submodule(phase:plastic) kinehardening
   end type tIndexDotState
 
   type :: tKinehardeningState
-    real(pReal), pointer, dimension(:,:) :: &
+    real(pREAL), pointer, dimension(:,:) :: &
       xi, &                                                                                         !< forest stress
                                                                                                     !! τ_for
       chi, &                                                                                        !< back stress
@@ -82,7 +82,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
     startIndex, endIndex
   integer,     dimension(:), allocatable :: &
     N_sl
-  real(pReal), dimension(:), allocatable :: &
+  real(pREAL), dimension(:), allocatable :: &
     xi_0, &                                                                                         !< initial forest stress
                                                                                                     !! τ_for,0
     a                                                                                               !< non-Schmid coefficients
@@ -175,11 +175,11 @@ module function plastic_kinehardening_init() result(myPlasticity)
 
 !--------------------------------------------------------------------------------------------------
 !  sanity checks
-      if (    prm%dot_gamma_0  <= 0.0_pReal)   extmsg = trim(extmsg)//' dot_gamma_0'
-      if (    prm%n            <= 0.0_pReal)   extmsg = trim(extmsg)//' n'
-      if (any(xi_0             <= 0.0_pReal))  extmsg = trim(extmsg)//' xi_0'
-      if (any(prm%xi_inf       <= 0.0_pReal))  extmsg = trim(extmsg)//' xi_inf'
-      if (any(prm%chi_inf      <= 0.0_pReal))  extmsg = trim(extmsg)//' chi_inf'
+      if (    prm%dot_gamma_0  <= 0.0_pREAL)   extmsg = trim(extmsg)//' dot_gamma_0'
+      if (    prm%n            <= 0.0_pREAL)   extmsg = trim(extmsg)//' n'
+      if (any(xi_0             <= 0.0_pREAL))  extmsg = trim(extmsg)//' xi_0'
+      if (any(prm%xi_inf       <= 0.0_pREAL))  extmsg = trim(extmsg)//' xi_inf'
+      if (any(prm%chi_inf      <= 0.0_pREAL))  extmsg = trim(extmsg)//' chi_inf'
 
     else slipActive
       xi_0 = emptyRealArray
@@ -208,21 +208,21 @@ module function plastic_kinehardening_init() result(myPlasticity)
     idx_dot%xi = [startIndex,endIndex]
     stt%xi => plasticState(ph)%state(startIndex:endIndex,:)
     stt%xi = spread(xi_0, 2, Nmembers)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_xi'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_sl
     idx_dot%chi = [startIndex,endIndex]
     stt%chi => plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pReal)
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_sl
     idx_dot%gamma = [startIndex,endIndex]
     stt%gamma => plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
 
     o = plasticState(ph)%offsetDeltaState
     startIndex = endIndex + 1
@@ -257,12 +257,12 @@ end function plastic_kinehardening_init
 !--------------------------------------------------------------------------------------------------
 pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
-  real(pReal), dimension(3,3),     intent(out) :: &
+  real(pREAL), dimension(3,3),     intent(out) :: &
     Lp                                                                                              !< plastic velocity gradient
-  real(pReal), dimension(3,3,3,3), intent(out) :: &
+  real(pREAL), dimension(3,3,3,3), intent(out) :: &
     dLp_dMp                                                                                         !< derivative of Lp with respect to the Mandel stress
 
-  real(pReal), dimension(3,3), intent(in) :: &
+  real(pREAL), dimension(3,3), intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,               intent(in) :: &
     ph, &
@@ -270,12 +270,12 @@ pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
   integer :: &
     i,k,l,m,n
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_pos,dot_gamma_neg, &
     ddot_gamma_dtau_pos,ddot_gamma_dtau_neg
 
-  Lp = 0.0_pReal
-  dLp_dMp = 0.0_pReal
+  Lp = 0.0_pREAL
+  dLp_dMp = 0.0_pREAL
 
   associate(prm => param(ph))
 
@@ -299,17 +299,17 @@ end subroutine kinehardening_LpAndItsTangent
 !--------------------------------------------------------------------------------------------------
 module function plastic_kinehardening_dotState(Mp,ph,en) result(dotState)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
 
-  real(pReal) :: &
+  real(pREAL) :: &
     sumGamma
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_pos,dot_gamma_neg
 
 
@@ -326,14 +326,14 @@ module function plastic_kinehardening_dotState(Mp,ph,en) result(dotState)
     dot_xi = matmul(prm%h_sl_sl,dot_gamma) &
            * ( prm%h_inf_xi &
                + ( prm%h_0_xi  &
-                 - prm%h_inf_xi * (1_pReal -sumGamma*prm%h_0_xi/prm%xi_inf) ) &
+                 - prm%h_inf_xi * (1_pREAL -sumGamma*prm%h_0_xi/prm%xi_inf) ) &
                *                       exp(-sumGamma*prm%h_0_xi/prm%xi_inf) &
              )
 
     dot_chi = stt%sgn_gamma(:,en)*dot_gamma &
             * ( prm%h_inf_chi &
                + ( prm%h_0_chi &
-                 - prm%h_inf_chi*(1_pReal -(stt%gamma(:,en)-stt%gamma_flip(:,en))*prm%h_0_chi/(prm%chi_inf+stt%chi_flip(:,en))) ) &
+                 - prm%h_inf_chi*(1_pREAL -(stt%gamma(:,en)-stt%gamma_flip(:,en))*prm%h_0_chi/(prm%chi_inf+stt%chi_flip(:,en))) ) &
                *                      exp(-(stt%gamma(:,en)-stt%gamma_flip(:,en))*prm%h_0_chi/(prm%chi_inf+stt%chi_flip(:,en))) &
               )
 
@@ -347,13 +347,13 @@ end function plastic_kinehardening_dotState
 !--------------------------------------------------------------------------------------------------
 module subroutine plastic_kinehardening_deltaState(Mp,ph,en)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
 
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_pos,dot_gamma_neg, &
     sgn_gamma
 
@@ -362,17 +362,17 @@ module subroutine plastic_kinehardening_deltaState(Mp,ph,en)
 
     call kinetics(Mp,ph,en, dot_gamma_pos,dot_gamma_neg)
     sgn_gamma = merge(state(ph)%sgn_gamma(:,en), &
-                      sign(1.0_pReal,dot_gamma_pos+dot_gamma_neg), &
-                      dEq0(dot_gamma_pos+dot_gamma_neg,1e-10_pReal))
+                      sign(1.0_pREAL,dot_gamma_pos+dot_gamma_neg), &
+                      dEq0(dot_gamma_pos+dot_gamma_neg,1e-10_pREAL))
 
-    where(dNeq(sgn_gamma,stt%sgn_gamma(:,en),0.1_pReal)) ! ToDo sgn_gamma*stt%sgn_gamma(:,en)<0
+    where(dNeq(sgn_gamma,stt%sgn_gamma(:,en),0.1_pREAL)) ! ToDo sgn_gamma*stt%sgn_gamma(:,en)<0
       dlt%sgn_gamma (:,en) = sgn_gamma            - stt%sgn_gamma (:,en)
       dlt%chi_flip  (:,en) = abs(stt%chi  (:,en)) - stt%chi_flip  (:,en)
       dlt%gamma_flip(:,en) =     stt%gamma(:,en)  - stt%gamma_flip(:,en)
     else where
-      dlt%sgn_gamma (:,en) = 0.0_pReal
-      dlt%chi_flip  (:,en) = 0.0_pReal
-      dlt%gamma_flip(:,en) = 0.0_pReal
+      dlt%sgn_gamma (:,en) = 0.0_pREAL
+      dlt%chi_flip  (:,en) = 0.0_pREAL
+      dlt%gamma_flip(:,en) = 0.0_pREAL
     end where
 
   end associate
@@ -434,20 +434,20 @@ end subroutine plastic_kinehardening_result
 pure subroutine kinetics(Mp,ph,en, &
                          dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
 
-  real(pReal),                  intent(out), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL),                  intent(out), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_pos, &
     dot_gamma_neg
-  real(pReal),                  intent(out), dimension(param(ph)%sum_N_sl), optional :: &
+  real(pREAL),                  intent(out), dimension(param(ph)%sum_N_sl), optional :: &
     ddot_gamma_dtau_pos, &
     ddot_gamma_dtau_neg
 
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     tau_pos, &
     tau_neg
   integer :: i
@@ -458,35 +458,35 @@ pure subroutine kinetics(Mp,ph,en, &
     do i = 1, prm%sum_N_sl
       tau_pos(i) =       math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i)) - stt%chi(i,en)
       tau_neg(i) = merge(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)) - stt%chi(i,en), &
-                         0.0_pReal, prm%nonSchmidActive)
+                         0.0_pREAL, prm%nonSchmidActive)
     end do
 
     where(dNeq0(tau_pos))
-      dot_gamma_pos = prm%dot_gamma_0 * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) &           ! 1/2 if non-Schmid active
+      dot_gamma_pos = prm%dot_gamma_0 * merge(0.5_pREAL,1.0_pREAL, prm%nonSchmidActive) &           ! 1/2 if non-Schmid active
                     * sign(abs(tau_pos/stt%xi(:,en))**prm%n,  tau_pos)
     else where
-      dot_gamma_pos = 0.0_pReal
+      dot_gamma_pos = 0.0_pREAL
     end where
 
     where(dNeq0(tau_neg))
-      dot_gamma_neg = prm%dot_gamma_0 * 0.5_pReal &                                                 ! only used if non-Schmid active, always 1/2
+      dot_gamma_neg = prm%dot_gamma_0 * 0.5_pREAL &                                                 ! only used if non-Schmid active, always 1/2
                     * sign(abs(tau_neg/stt%xi(:,en))**prm%n,  tau_neg)
     else where
-      dot_gamma_neg = 0.0_pReal
+      dot_gamma_neg = 0.0_pREAL
     end where
 
     if (present(ddot_gamma_dtau_pos)) then
       where(dNeq0(dot_gamma_pos))
         ddot_gamma_dtau_pos = dot_gamma_pos*prm%n/tau_pos
       else where
-        ddot_gamma_dtau_pos = 0.0_pReal
+        ddot_gamma_dtau_pos = 0.0_pREAL
       end where
     end if
     if (present(ddot_gamma_dtau_neg)) then
       where(dNeq0(dot_gamma_neg))
         ddot_gamma_dtau_neg = dot_gamma_neg*prm%n/tau_neg
       else where
-        ddot_gamma_dtau_neg = 0.0_pReal
+        ddot_gamma_dtau_neg = 0.0_pREAL
       end where
     end if
 

src/phase_mechanical_plastic_phenopowerlaw.f90

@@ -7,30 +7,30 @@
 submodule(phase:plastic) phenopowerlaw
 
   type :: tParameters
-    real(pReal) :: &
-      dot_gamma_0_sl = 1.0_pReal, &                                                                 !< reference shear strain rate for slip
-      dot_gamma_0_tw = 1.0_pReal, &                                                                 !< reference shear strain rate for twin
-      n_sl           = 1.0_pReal, &                                                                 !< stress exponent for slip
-      n_tw           = 1.0_pReal, &                                                                 !< stress exponent for twin
-      f_sat_sl_tw    = 1.0_pReal, &                                                                 !< push-up factor for slip saturation due to twinning
-      c_1            = 1.0_pReal, &
-      c_2            = 1.0_pReal, &
-      c_3            = 1.0_pReal, &
-      c_4            = 1.0_pReal, &
-      h_0_sl_sl      = 1.0_pReal, &                                                                 !< reference hardening slip - slip
-      h_0_tw_sl      = 1.0_pReal, &                                                                 !< reference hardening twin - slip
-      h_0_tw_tw      = 1.0_pReal, &                                                                 !< reference hardening twin - twin
-      a_sl           = 1.0_pReal
-    real(pReal),               allocatable, dimension(:) :: &
+    real(pREAL) :: &
+      dot_gamma_0_sl = 1.0_pREAL, &                                                                 !< reference shear strain rate for slip
+      dot_gamma_0_tw = 1.0_pREAL, &                                                                 !< reference shear strain rate for twin
+      n_sl           = 1.0_pREAL, &                                                                 !< stress exponent for slip
+      n_tw           = 1.0_pREAL, &                                                                 !< stress exponent for twin
+      f_sat_sl_tw    = 1.0_pREAL, &                                                                 !< push-up factor for slip saturation due to twinning
+      c_1            = 1.0_pREAL, &
+      c_2            = 1.0_pREAL, &
+      c_3            = 1.0_pREAL, &
+      c_4            = 1.0_pREAL, &
+      h_0_sl_sl      = 1.0_pREAL, &                                                                 !< reference hardening slip - slip
+      h_0_tw_sl      = 1.0_pREAL, &                                                                 !< reference hardening twin - slip
+      h_0_tw_tw      = 1.0_pREAL, &                                                                 !< reference hardening twin - twin
+      a_sl           = 1.0_pREAL
+    real(pREAL),               allocatable, dimension(:) :: &
       xi_inf_sl, &                                                                                  !< maximum critical shear stress for slip
       h_int, &                                                                                      !< per family hardening activity (optional)
       gamma_char                                                                                    !< characteristic shear for twins
-    real(pReal),               allocatable, dimension(:,:) :: &
+    real(pREAL),               allocatable, dimension(:,:) :: &
       h_sl_sl, &                                                                                    !< slip resistance from slip activity
       h_sl_tw, &                                                                                    !< slip resistance from twin activity
       h_tw_sl, &                                                                                    !< twin resistance from slip activity
       h_tw_tw                                                                                       !< twin resistance from twin activity
-    real(pReal),               allocatable, dimension(:,:,:) :: &
+    real(pREAL),               allocatable, dimension(:,:,:) :: &
       P_sl, &
       P_tw, &
       P_nS_pos, &
@@ -56,7 +56,7 @@ submodule(phase:plastic) phenopowerlaw
   end type tIndexDotState
 
   type :: tPhenopowerlawState
-    real(pReal), pointer, dimension(:,:) :: &
+    real(pREAL), pointer, dimension(:,:) :: &
       xi_sl, &
       xi_tw, &
       gamma_sl, &
@@ -87,7 +87,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
   integer,     dimension(:), allocatable :: &
     N_sl, &                                                                                         !< number of slip-systems for a given slip family
     N_tw                                                                                            !< number of twin-systems for a given twin family
-  real(pReal), dimension(:), allocatable :: &
+  real(pREAL), dimension(:), allocatable :: &
     xi_0_sl, &                                                                                      !< initial critical shear stress for slip
     xi_0_tw, &                                                                                      !< initial critical shear stress for twin
     a                                                                                               !< non-Schmid coefficients
@@ -156,7 +156,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       xi_0_sl             = pl%get_as1dReal('xi_0_sl',   requiredSize=size(N_sl))
       prm%xi_inf_sl       = pl%get_as1dReal('xi_inf_sl', requiredSize=size(N_sl))
       prm%h_int           = pl%get_as1dReal('h_int',     requiredSize=size(N_sl), &
-                                            defaultVal=[(0.0_pReal,i=1,size(N_sl))])
+                                            defaultVal=[(0.0_pREAL,i=1,size(N_sl))])
 
       prm%dot_gamma_0_sl  = pl%get_asReal('dot_gamma_0_sl')
       prm%n_sl            = pl%get_asReal('n_sl')
@@ -169,11 +169,11 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       prm%h_int           = math_expand(prm%h_int,    N_sl)
 
       ! sanity checks
-      if (    prm%dot_gamma_0_sl  <= 0.0_pReal)      extmsg = trim(extmsg)//' dot_gamma_0_sl'
-      if (    prm%a_sl            <= 0.0_pReal)      extmsg = trim(extmsg)//' a_sl'
-      if (    prm%n_sl            <= 0.0_pReal)      extmsg = trim(extmsg)//' n_sl'
-      if (any(xi_0_sl             <= 0.0_pReal))     extmsg = trim(extmsg)//' xi_0_sl'
-      if (any(prm%xi_inf_sl       <= 0.0_pReal))     extmsg = trim(extmsg)//' xi_inf_sl'
+      if (    prm%dot_gamma_0_sl  <= 0.0_pREAL)      extmsg = trim(extmsg)//' dot_gamma_0_sl'
+      if (    prm%a_sl            <= 0.0_pREAL)      extmsg = trim(extmsg)//' a_sl'
+      if (    prm%n_sl            <= 0.0_pREAL)      extmsg = trim(extmsg)//' n_sl'
+      if (any(xi_0_sl             <= 0.0_pREAL))     extmsg = trim(extmsg)//' xi_0_sl'
+      if (any(prm%xi_inf_sl       <= 0.0_pREAL))     extmsg = trim(extmsg)//' xi_inf_sl'
 
     else slipActive
       xi_0_sl = emptyRealArray
@@ -193,10 +193,10 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
 
       xi_0_tw            = pl%get_as1dReal('xi_0_tw',requiredSize=size(N_tw))
 
-      prm%c_1            = pl%get_asReal('c_1',defaultVal=0.0_pReal)
-      prm%c_2            = pl%get_asReal('c_2',defaultVal=1.0_pReal)
-      prm%c_3            = pl%get_asReal('c_3',defaultVal=0.0_pReal)
-      prm%c_4            = pl%get_asReal('c_4',defaultVal=0.0_pReal)
+      prm%c_1            = pl%get_asReal('c_1',defaultVal=0.0_pREAL)
+      prm%c_2            = pl%get_asReal('c_2',defaultVal=1.0_pREAL)
+      prm%c_3            = pl%get_asReal('c_3',defaultVal=0.0_pREAL)
+      prm%c_4            = pl%get_asReal('c_4',defaultVal=0.0_pREAL)
       prm%dot_gamma_0_tw = pl%get_asReal('dot_gamma_0_tw')
       prm%n_tw           = pl%get_asReal('n_tw')
       prm%f_sat_sl_tw    = pl%get_asReal('f_sat_sl-tw')
@@ -206,8 +206,8 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       xi_0_tw       = math_expand(xi_0_tw,N_tw)
 
       ! sanity checks
-      if (prm%dot_gamma_0_tw <= 0.0_pReal)  extmsg = trim(extmsg)//' dot_gamma_0_tw'
-      if (prm%n_tw           <= 0.0_pReal)  extmsg = trim(extmsg)//' n_tw'
+      if (prm%dot_gamma_0_tw <= 0.0_pREAL)  extmsg = trim(extmsg)//' dot_gamma_0_tw'
+      if (prm%n_tw           <= 0.0_pREAL)  extmsg = trim(extmsg)//' n_tw'
 
     else twinActive
       xi_0_tw = emptyRealArray
@@ -226,7 +226,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
     else slipAndTwinActive
       allocate(prm%h_sl_tw(prm%sum_N_sl,prm%sum_N_tw))                                              ! at least one dimension is 0
       allocate(prm%h_tw_sl(prm%sum_N_tw,prm%sum_N_sl))                                              ! at least one dimension is 0
-      prm%h_0_tw_sl = 0.0_pReal
+      prm%h_0_tw_sl = 0.0_pREAL
     end if slipAndTwinActive
 
 !--------------------------------------------------------------------------------------------------
@@ -246,28 +246,28 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
     idx_dot%xi_sl = [startIndex,endIndex]
     stt%xi_sl => plasticState(ph)%state(startIndex:endIndex,:)
     stt%xi_sl =  spread(xi_0_sl, 2, Nmembers)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_xi'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_tw
     idx_dot%xi_tw = [startIndex,endIndex]
     stt%xi_tw => plasticState(ph)%state(startIndex:endIndex,:)
     stt%xi_tw =  spread(xi_0_tw, 2, Nmembers)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pReal)
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_sl
     idx_dot%gamma_sl = [startIndex,endIndex]
     stt%gamma_sl => plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pReal)
-    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_tw
     idx_dot%gamma_tw = [startIndex,endIndex]
     stt%gamma_tw => plasticState(ph)%state(startIndex:endIndex,:)
-    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pReal)
+    plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
 
     end associate
 
@@ -287,12 +287,12 @@ end function plastic_phenopowerlaw_init
 !--------------------------------------------------------------------------------------------------
 pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
-  real(pReal), dimension(3,3),     intent(out) :: &
+  real(pREAL), dimension(3,3),     intent(out) :: &
     Lp                                                                                              !< plastic velocity gradient
-  real(pReal), dimension(3,3,3,3), intent(out) :: &
+  real(pREAL), dimension(3,3,3,3), intent(out) :: &
     dLp_dMp                                                                                         !< derivative of Lp with respect to the Mandel stress
 
-  real(pReal), dimension(3,3), intent(in) :: &
+  real(pREAL), dimension(3,3), intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,               intent(in) :: &
     ph, &
@@ -300,14 +300,14 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
   integer :: &
     i,k,l,m,n
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_sl_pos,dot_gamma_sl_neg, &
     ddot_gamma_dtau_sl_pos,ddot_gamma_dtau_sl_neg
-  real(pReal), dimension(param(ph)%sum_N_tw) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw) :: &
     dot_gamma_tw,ddot_gamma_dtau_tw
 
-  Lp = 0.0_pReal
-  dLp_dMp = 0.0_pReal
+  Lp = 0.0_pREAL
+  dLp_dMp = 0.0_pREAL
 
   associate(prm => param(ph))
 
@@ -338,18 +338,18 @@ end subroutine phenopowerlaw_LpAndItsTangent
 !--------------------------------------------------------------------------------------------------
 module function phenopowerlaw_dotState(Mp,ph,en) result(dotState)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
-  real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+  real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
     dotState
 
-  real(pReal) :: &
+  real(pREAL) :: &
     xi_sl_sat_offset,&
     sumF
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_sl_pos,dot_gamma_sl_neg, &
     left_SlipSlip
 
@@ -365,10 +365,10 @@ module function phenopowerlaw_dotState(Mp,ph,en) result(dotState)
     sumF = sum(stt%gamma_tw(:,en)/prm%gamma_char)
 
     xi_sl_sat_offset = prm%f_sat_sl_tw*sqrt(sumF)
-    left_SlipSlip = sign(abs(1.0_pReal-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))**prm%a_sl, &
-                             1.0_pReal-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))
+    left_SlipSlip = sign(abs(1.0_pREAL-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))**prm%a_sl, &
+                             1.0_pREAL-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))
 
-    dot_xi_sl = prm%h_0_sl_sl * (1.0_pReal + prm%c_1 * sumF**prm%c_2) * (1.0_pReal + prm%h_int) &
+    dot_xi_sl = prm%h_0_sl_sl * (1.0_pREAL + prm%c_1 * sumF**prm%c_2) * (1.0_pREAL + prm%h_int) &
                 * left_SlipSlip * matmul(prm%h_sl_sl,dot_gamma_sl) &
               + matmul(prm%h_sl_tw,dot_gamma_tw)
 
@@ -431,20 +431,20 @@ end subroutine plastic_phenopowerlaw_result
 pure subroutine kinetics_sl(Mp,ph,en, &
                             dot_gamma_sl_pos,dot_gamma_sl_neg,ddot_gamma_dtau_sl_pos,ddot_gamma_dtau_sl_neg)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
 
-  real(pReal),                  intent(out), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL),                  intent(out), dimension(param(ph)%sum_N_sl) :: &
     dot_gamma_sl_pos, &
     dot_gamma_sl_neg
-  real(pReal),                  intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL),                  intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
     ddot_gamma_dtau_sl_pos, &
     ddot_gamma_dtau_sl_neg
 
-  real(pReal), dimension(param(ph)%sum_N_sl) :: &
+  real(pREAL), dimension(param(ph)%sum_N_sl) :: &
     tau_sl_pos, &
     tau_sl_neg
   integer :: i
@@ -454,35 +454,35 @@ pure subroutine kinetics_sl(Mp,ph,en, &
     do i = 1, prm%sum_N_sl
       tau_sl_pos(i) =       math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i))
       tau_sl_neg(i) = merge(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)), &
-                            0.0_pReal, prm%nonSchmidActive)
+                            0.0_pREAL, prm%nonSchmidActive)
     end do
 
     where(dNeq0(tau_sl_pos))
-      dot_gamma_sl_pos = prm%dot_gamma_0_sl * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) &     ! 1/2 if non-Schmid active
+      dot_gamma_sl_pos = prm%dot_gamma_0_sl * merge(0.5_pREAL,1.0_pREAL, prm%nonSchmidActive) &     ! 1/2 if non-Schmid active
                        * sign(abs(tau_sl_pos/stt%xi_sl(:,en))**prm%n_sl,  tau_sl_pos)
     else where
-      dot_gamma_sl_pos = 0.0_pReal
+      dot_gamma_sl_pos = 0.0_pREAL
     end where
 
     where(dNeq0(tau_sl_neg))
-      dot_gamma_sl_neg = prm%dot_gamma_0_sl * 0.5_pReal &                                           ! only used if non-Schmid active, always 1/2
+      dot_gamma_sl_neg = prm%dot_gamma_0_sl * 0.5_pREAL &                                           ! only used if non-Schmid active, always 1/2
                        * sign(abs(tau_sl_neg/stt%xi_sl(:,en))**prm%n_sl,  tau_sl_neg)
     else where
-      dot_gamma_sl_neg = 0.0_pReal
+      dot_gamma_sl_neg = 0.0_pREAL
     end where
 
     if (present(ddot_gamma_dtau_sl_pos)) then
       where(dNeq0(dot_gamma_sl_pos))
         ddot_gamma_dtau_sl_pos = dot_gamma_sl_pos*prm%n_sl/tau_sl_pos
       else where
-        ddot_gamma_dtau_sl_pos = 0.0_pReal
+        ddot_gamma_dtau_sl_pos = 0.0_pREAL
       end where
     end if
     if (present(ddot_gamma_dtau_sl_neg)) then
       where(dNeq0(dot_gamma_sl_neg))
         ddot_gamma_dtau_sl_neg = dot_gamma_sl_neg*prm%n_sl/tau_sl_neg
       else where
-        ddot_gamma_dtau_sl_neg = 0.0_pReal
+        ddot_gamma_dtau_sl_neg = 0.0_pREAL
       end where
     end if
 
@@ -501,18 +501,18 @@ end subroutine kinetics_sl
 pure subroutine kinetics_tw(Mp,ph,en,&
                             dot_gamma_tw,ddot_gamma_dtau_tw)
 
-  real(pReal), dimension(3,3),  intent(in) :: &
+  real(pREAL), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
   integer,                      intent(in) :: &
     ph, &
     en
 
-  real(pReal), dimension(param(ph)%sum_N_tw), intent(out) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw), intent(out) :: &
     dot_gamma_tw
-  real(pReal), dimension(param(ph)%sum_N_tw), intent(out), optional :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw), intent(out), optional :: &
     ddot_gamma_dtau_tw
 
-  real(pReal), dimension(param(ph)%sum_N_tw) :: &
+  real(pREAL), dimension(param(ph)%sum_N_tw) :: &
     tau_tw
   integer :: i
 
@@ -521,18 +521,18 @@ pure subroutine kinetics_tw(Mp,ph,en,&
 
     tau_tw = [(math_tensordot(Mp,prm%P_tw(1:3,1:3,i)),i=1,prm%sum_N_tw)]
 
-    where(tau_tw > 0.0_pReal)
-      dot_gamma_tw = (1.0_pReal-sum(stt%gamma_tw(:,en)/prm%gamma_char)) &                           ! only twin in untwinned volume fraction
+    where(tau_tw > 0.0_pREAL)
+      dot_gamma_tw = (1.0_pREAL-sum(stt%gamma_tw(:,en)/prm%gamma_char)) &                           ! only twin in untwinned volume fraction
                    * prm%dot_gamma_0_tw*(abs(tau_tw)/stt%xi_tw(:,en))**prm%n_tw
     else where
-      dot_gamma_tw = 0.0_pReal
+      dot_gamma_tw = 0.0_pREAL
     end where
 
     if (present(ddot_gamma_dtau_tw)) then
       where(dNeq0(dot_gamma_tw))
         ddot_gamma_dtau_tw = dot_gamma_tw*prm%n_tw/tau_tw
       else where
-        ddot_gamma_dtau_tw = 0.0_pReal
+        ddot_gamma_dtau_tw = 0.0_pREAL
       end where
     end if
 

src/phase_thermal.f90

@@ -4,8 +4,8 @@
 submodule(phase) thermal
 
   type :: tThermalParameters
-    real(pReal) :: C_p = 0.0_pReal                                                                  !< heat capacity
-    real(pReal), dimension(3,3) :: K = 0.0_pReal                                                    !< thermal conductivity
+    real(pREAL) :: C_p = 0.0_pREAL                                                                  !< heat capacity
+    real(pREAL), dimension(3,3) :: K = 0.0_pREAL                                                    !< thermal conductivity
     character(len=pSTRLEN), allocatable, dimension(:) :: output
   end type tThermalParameters
 
@@ -22,7 +22,7 @@ submodule(phase) thermal
   end enum
 
   type :: tDataContainer             ! ?? not very telling name. Better: "fieldQuantities" ??
-    real(pReal), dimension(:), allocatable :: T, dot_T
+    real(pREAL), dimension(:), allocatable :: T, dot_T
   end type tDataContainer
   integer(kind(THERMAL_UNDEFINED_ID)),  dimension(:,:), allocatable :: &
     thermal_source
@@ -57,14 +57,14 @@ submodule(phase) thermal
       integer, intent(in) :: &
         ph, &
         en
-      real(pReal) :: f_T
+      real(pREAL) :: f_T
     end function dissipation_f_T
 
     module function externalheat_f_T(ph,en)  result(f_T)
       integer, intent(in) :: &
         ph, &
         en
-      real(pReal) :: f_T
+      real(pREAL) :: f_T
     end function externalheat_f_T
 
  end interface
@@ -100,7 +100,7 @@ module subroutine thermal_init(phases)
   do ph = 1, phases%length
     Nmembers = count(material_ID_phase == ph)
     allocate(current(ph)%T(Nmembers),source=T_ROOM)
-    allocate(current(ph)%dot_T(Nmembers),source=0.0_pReal)
+    allocate(current(ph)%dot_T(Nmembers),source=0.0_pREAL)
     phase => phases%get_dict(ph)
     thermal => phase%get_dict('thermal',defaultVal=emptyDict)
 
@@ -156,13 +156,13 @@ end subroutine thermal_init
 module function phase_f_T(ph,en) result(f)
 
   integer, intent(in) :: ph, en
-  real(pReal) :: f
+  real(pREAL) :: f
 
 
   integer :: so
 
 
-  f = 0.0_pReal
+  f = 0.0_pREAL
 
   do so = 1, thermal_Nsources(ph)
    select case(thermal_source(so,ph))
@@ -211,7 +211,7 @@ end function phase_thermal_collectDotState
 module function phase_mu_T(co,ce) result(mu)
 
   integer, intent(in) :: co, ce
-  real(pReal) :: mu
+  real(pREAL) :: mu
 
 
   mu = phase_rho(material_ID_phase(co,ce)) &
@@ -226,7 +226,7 @@ end function phase_mu_T
 module function phase_K_T(co,ce) result(K)
 
   integer, intent(in) :: co, ce
-  real(pReal), dimension(3,3) :: K
+  real(pREAL), dimension(3,3) :: K
 
 
   K = crystallite_push33ToRef(co,ce,param(material_ID_phase(co,ce))%K)
@@ -236,7 +236,7 @@ end function phase_K_T
 
 module function phase_thermal_constitutive(Delta_t,ph,en) result(converged_)
 
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: ph, en
   logical :: converged_
 
@@ -251,7 +251,7 @@ end function phase_thermal_constitutive
 !--------------------------------------------------------------------------------------------------
 function integrateThermalState(Delta_t, ph,en) result(broken)
 
-  real(pReal), intent(in) :: Delta_t
+  real(pREAL), intent(in) :: Delta_t
   integer, intent(in) :: ph, en
   logical :: &
     broken
@@ -323,7 +323,7 @@ end subroutine thermal_forward
 pure module function thermal_T(ph,en) result(T)
 
   integer, intent(in) :: ph, en
-  real(pReal) :: T
+  real(pREAL) :: T
 
 
   T = current(ph)%T(en)
@@ -337,7 +337,7 @@ end function thermal_T
 module function thermal_dot_T(ph,en) result(dot_T)
 
   integer, intent(in) :: ph, en
-  real(pReal) :: dot_T
+  real(pREAL) :: dot_T
 
 
   dot_T = current(ph)%dot_T(en)
@@ -350,7 +350,7 @@ end function thermal_dot_T
 !----------------------------------------------------------------------------------------------
 module subroutine phase_thermal_setField(T,dot_T, co,ce)
 
-  real(pReal), intent(in) :: T, dot_T
+  real(pREAL), intent(in) :: T, dot_T
   integer, intent(in) :: ce, co
 
 

src/phase_thermal_dissipation.f90

@@ -8,7 +8,7 @@
 submodule(phase:thermal) dissipation
 
   type :: tParameters                                                                               !< container type for internal constitutive parameters
-    real(pReal) :: &
+    real(pREAL) :: &
       kappa                                                                                         !< TAYLOR-QUINNEY factor
   end type tParameters
 
@@ -80,9 +80,9 @@ end function dissipation_init
 module function dissipation_f_T(ph,en) result(f_T)
 
   integer, intent(in) :: ph, en
-  real(pReal) :: &
+  real(pREAL) :: &
     f_T
-  real(pReal), dimension(3,3) :: &
+  real(pREAL), dimension(3,3) :: &
     Mp                                                                                              !< Mandel stress work conjugate with Lp
 
   Mp = matmul(matmul(transpose(mechanical_F_i(ph,en)),mechanical_F_i(ph,en)),mechanical_S(ph,en))

src/phase_thermal_externalheat.f90

@@ -92,7 +92,7 @@ module subroutine externalheat_dotState(ph, en)
 
   so = source_thermal_externalheat_offset(ph)
 
-  thermalState(ph)%p(so)%dotState(1,en) = 1.0_pReal                                                 ! state is current time
+  thermalState(ph)%p(so)%dotState(1,en) = 1.0_pREAL                                                 ! state is current time
 
 end subroutine externalheat_dotState
 
@@ -105,7 +105,7 @@ module function externalheat_f_T(ph,en) result(f_T)
   integer, intent(in) :: &
     ph, &
     en
-  real(pReal) :: &
+  real(pREAL) :: &
     f_T
 
   integer :: &

src/polynomials.f90

@@ -12,8 +12,8 @@ module polynomials
   private
 
   type, public :: tPolynomial
-    real(pReal), dimension(:), allocatable :: coef
-    real(pReal) :: x_ref = huge(0.0_pReal)
+    real(pREAL), dimension(:), allocatable :: coef
+    real(pREAL) :: x_ref = huge(0.0_pREAL)
     contains
     procedure, public :: at => eval
   end type tPolynomial
@@ -47,8 +47,8 @@ end subroutine polynomials_init
 !--------------------------------------------------------------------------------------------------
 pure function polynomial_from_coef(coef,x_ref) result(p)
 
-  real(pReal), dimension(0:), intent(in) :: coef
-  real(pReal), intent(in) :: x_ref
+  real(pREAL), dimension(0:), intent(in) :: coef
+  real(pREAL), intent(in) :: x_ref
   type(tPolynomial) :: p
 
 
@@ -67,8 +67,8 @@ function polynomial_from_dict(dict,y,x) result(p)
   character(len=*), intent(in) :: y, x
   type(tPolynomial) :: p
 
-  real(pReal), dimension(:), allocatable :: coef
-  real(pReal) :: x_ref
+  real(pREAL), dimension(:), allocatable :: coef
+  real(pREAL) :: x_ref
   integer :: i, o
   character(len=1) :: o_s
 
@@ -83,7 +83,7 @@ function polynomial_from_dict(dict,y,x) result(p)
     write(o_s,'(I0.0)') o
     if (dict%contains(y//','//x//'^'//o_s)) then
       x_ref = dict%get_asReal(x//'_ref')
-      coef = [coef,[(0.0_pReal,i=size(coef),o-1)],dict%get_asReal(y//','//x//'^'//o_s)]
+      coef = [coef,[(0.0_pREAL,i=size(coef),o-1)],dict%get_asReal(y//','//x//'^'//o_s)]
     end if
   end do
 
@@ -99,8 +99,8 @@ end function polynomial_from_dict
 pure function eval(self,x) result(y)
 
   class(tPolynomial), intent(in) :: self
-  real(pReal), intent(in) :: x
-  real(pReal) :: y
+  real(pREAL), intent(in) :: x
+  real(pREAL) :: y
 
   integer :: o
 
@@ -123,9 +123,9 @@ end function eval
 subroutine selfTest()
 
   type(tPolynomial) :: p1, p2
-  real(pReal), dimension(5) :: coef
+  real(pREAL), dimension(5) :: coef
   integer :: i
-  real(pReal) :: x_ref, x, y
+  real(pREAL) :: x_ref, x, y
   type(tDict), pointer :: dict
   character(len=pSTRLEN), dimension(size(coef)) :: coef_s
   character(len=pSTRLEN) :: x_ref_s, x_s, YAML_s
@@ -135,9 +135,9 @@ subroutine selfTest()
   call random_number(x_ref)
   call random_number(x)
 
-  coef = coef*10_pReal -0.5_pReal
-  x_ref = x_ref*10_pReal -0.5_pReal
-  x = x*10_pReal -0.5_pReal
+  coef = coef*10_pREAL -0.5_pREAL
+  x_ref = x_ref*10_pREAL -0.5_pREAL
+  x = x*10_pREAL -0.5_pREAL
 
   p1 = polynomial([coef(1)],x_ref)
   if (dNeq(p1%at(x),coef(1)))      error stop 'polynomial: eval(constant)'
@@ -158,37 +158,37 @@ subroutine selfTest()
            'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL
   dict => YAML_parse_str_asDict(trim(YAML_s))
   p2 = polynomial(dict,'C','T')
-  if (dNeq(p1%at(x),p2%at(x),1.0e-6_pReal))                      error stop 'polynomials: init'
+  if (dNeq(p1%at(x),p2%at(x),1.0e-6_pREAL))                      error stop 'polynomials: init'
   y = coef(1)+coef(2)*(x-x_ref)+coef(3)*(x-x_ref)**2+coef(4)*(x-x_ref)**3+coef(5)*(x-x_ref)**4
-  if (dNeq(p1%at(x),y,1.0e-6_pReal))                             error stop 'polynomials: eval(full)'
+  if (dNeq(p1%at(x),y,1.0e-6_pREAL))                             error stop 'polynomials: eval(full)'
 
   YAML_s = 'C: 0.0'//IO_EOL//&
            'C,T: '//trim(adjustl(coef_s(2)))//IO_EOL//&
            'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL
   dict => YAML_parse_str_asDict(trim(YAML_s))
   p1 = polynomial(dict,'C','T')
-  if (dNeq(p1%at(x_ref+x),-p1%at(x_ref-x),1.0e-10_pReal))         error stop 'polynomials: eval(linear)'
+  if (dNeq(p1%at(x_ref+x),-p1%at(x_ref-x),1.0e-10_pREAL))         error stop 'polynomials: eval(linear)'
 
   YAML_s = 'C: 0.0'//IO_EOL//&
            'C,T^2: '//trim(adjustl(coef_s(3)))//IO_EOL//&
            'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL
   dict => YAML_parse_str_asDict(trim(YAML_s))
   p1 = polynomial(dict,'C','T')
-  if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1e-10_pReal))            error stop 'polynomials: eval(quadratic)'
+  if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1e-10_pREAL))            error stop 'polynomials: eval(quadratic)'
 
   YAML_s = 'Y: '//trim(adjustl(coef_s(1)))//IO_EOL//&
            'Y,X^3: '//trim(adjustl(coef_s(2)))//IO_EOL//&
            'X_ref: '//trim(adjustl(x_ref_s))//IO_EOL
   dict => YAML_parse_str_asDict(trim(YAML_s))
   p1 = polynomial(dict,'Y','X')
-  if (dNeq(p1%at(x_ref+x)-coef(1),-(p1%at(x_ref-x)-coef(1)),1.0e-8_pReal)) error stop 'polynomials: eval(cubic)'
+  if (dNeq(p1%at(x_ref+x)-coef(1),-(p1%at(x_ref-x)-coef(1)),1.0e-8_pREAL)) error stop 'polynomials: eval(cubic)'
 
   YAML_s = 'Y: '//trim(adjustl(coef_s(1)))//IO_EOL//&
            'Y,X^4: '//trim(adjustl(coef_s(2)))//IO_EOL//&
            'X_ref: '//trim(adjustl(x_ref_s))//IO_EOL
   dict => YAML_parse_str_asDict(trim(YAML_s))
   p1 = polynomial(dict,'Y','X')
-  if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1.0e-6_pReal))           error stop 'polynomials: eval(quartic)'
+  if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1.0e-6_pREAL))           error stop 'polynomials: eval(quartic)'
 
 
 end subroutine selfTest

src/prec.f90

@@ -19,26 +19,26 @@ module prec
   public
 
   ! https://stevelionel.com/drfortran/2017/03/27/doctor-fortran-in-it-takes-all-kinds
-  integer,     parameter :: pReal      = IEEE_selected_real_kind(15,307)                            !< number with 15 significant digits, up to 1e+-307 (typically 64 bit)
+  integer,     parameter :: pREAL      = IEEE_selected_real_kind(15,307)                            !< number with 15 significant digits, up to 1e+-307 (typically 64 bit)
   integer,     parameter :: pI32       = selected_int_kind(9)                                       !< number with at least up to +-1e9 (typically 32 bit)
   integer,     parameter :: pI64       = selected_int_kind(18)                                      !< number with at least up to +-1e18 (typically 64 bit)
 #ifdef PETSC
   PetscInt,    private   :: dummy_int
   integer,     parameter :: pPETSCINT  = kind(dummy_int)
   PetscScalar, private   :: dummy_scalar
-  real(pReal), parameter, private :: pPETSCSCALAR = kind(dummy_scalar)
+  real(pREAL), parameter, private :: pPETSCSCALAR = kind(dummy_scalar)
 #endif
   integer,     parameter :: pSTRLEN = 256                                                           !< default string length
   integer,     parameter :: pPATHLEN   = 4096                                                       !< maximum length of a path name on linux
 
-  real(pReal), parameter :: tol_math_check = 1.0e-8_pReal                                           !< tolerance for internal math self-checks (rotation)
+  real(pREAL), parameter :: tol_math_check = 1.0e-8_pREAL                                           !< tolerance for internal math self-checks (rotation)
 
 
-  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
+  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
 
   integer,                dimension(0), parameter :: emptyIntArray  = [integer::]
-  real(pReal),            dimension(0), parameter :: emptyRealArray = [real(pReal)::]
+  real(pREAL),            dimension(0), parameter :: emptyRealArray = [real(pREAL)::]
   character(len=pSTRLEN), dimension(0), parameter :: emptyStrArray  = [character(len=pSTRLEN)::]
 
 
@@ -54,11 +54,11 @@ subroutine prec_init()
 
   print'(/,a,i3)',    ' integer size / bit:  ',bit_size(0)
   print'(  a,i19)',   '   maximum value:     ',huge(0)
-  print'(/,a,i3)',    ' real size / bit:     ',storage_size(0.0_pReal)
-  print'(  a,e10.3)', '   maximum value:     ',huge(0.0_pReal)
+  print'(/,a,i3)',    ' real size / bit:     ',storage_size(0.0_pREAL)
+  print'(  a,e10.3)', '   maximum value:     ',huge(0.0_pREAL)
   print'(  a,e10.3)', '   minimum value:     ',PREAL_MIN
   print'(  a,e10.3)', '   epsilon value:     ',PREAL_EPSILON
-  print'(  a,i3)',    '   decimal precision: ',precision(0.0_pReal)
+  print'(  a,i3)',    '   decimal precision: ',precision(0.0_pREAL)
 
   call prec_selfTest()
 
@@ -74,8 +74,8 @@ end subroutine prec_init
 !--------------------------------------------------------------------------------------------------
 logical elemental pure function dEq(a,b,tol)
 
-  real(pReal), intent(in)           :: a,b
-  real(pReal), intent(in), optional :: tol
+  real(pREAL), intent(in)           :: a,b
+  real(pREAL), intent(in), optional :: tol
 
 
   if (present(tol)) then
@@ -95,8 +95,8 @@ end function dEq
 !--------------------------------------------------------------------------------------------------
 logical elemental pure function dNeq(a,b,tol)
 
-  real(pReal), intent(in)           :: a,b
-  real(pReal), intent(in), optional :: tol
+  real(pREAL), intent(in)           :: a,b
+  real(pREAL), intent(in), optional :: tol
 
 
   dNeq = .not. dEq(a,b,tol)
@@ -112,14 +112,14 @@ end function dNeq
 !--------------------------------------------------------------------------------------------------
 logical elemental pure function dEq0(a,tol)
 
-  real(pReal), intent(in)           :: a
-  real(pReal), intent(in), optional :: tol
+  real(pREAL), intent(in)           :: a
+  real(pREAL), intent(in), optional :: tol
 
 
   if (present(tol)) then
     dEq0 = abs(a) <= tol
   else
-    dEq0 = abs(a) <= PREAL_MIN * 10.0_pReal
+    dEq0 = abs(a) <= PREAL_MIN * 10.0_pREAL
   end if
 
 end function dEq0
@@ -133,8 +133,8 @@ end function dEq0
 !--------------------------------------------------------------------------------------------------
 logical elemental pure function dNeq0(a,tol)
 
-  real(pReal), intent(in)           :: a
-  real(pReal), intent(in), optional :: tol
+  real(pREAL), intent(in)           :: a
+  real(pREAL), intent(in), optional :: tol
 
 
   dNeq0 = .not. dEq0(a,tol)
@@ -151,8 +151,8 @@ end function dNeq0
 !--------------------------------------------------------------------------------------------------
 logical elemental pure function cEq(a,b,tol)
 
-  complex(pReal), intent(in)           :: a,b
-  real(pReal),    intent(in), optional :: tol
+  complex(pREAL), intent(in)           :: a,b
+  real(pREAL),    intent(in), optional :: tol
 
 
   if (present(tol)) then
@@ -173,8 +173,8 @@ end function cEq
 !--------------------------------------------------------------------------------------------------
 logical elemental pure function cNeq(a,b,tol)
 
-  complex(pReal), intent(in)           :: a,b
-  real(pReal),    intent(in), optional :: tol
+  complex(pREAL), intent(in)           :: a,b
+  real(pREAL),    intent(in), optional :: tol
 
 
   cNeq = .not. cEq(a,b,tol)
@@ -248,13 +248,13 @@ end function prec_bytesToC_INT64_T
 subroutine prec_selfTest()
 
   integer, allocatable, dimension(:) :: realloc_lhs_test
-  real(pReal),   dimension(1) :: f
+  real(pREAL),   dimension(1) :: f
   integer(pI64), dimension(1) :: i
-  real(pReal),   dimension(2) :: r
+  real(pREAL),   dimension(2) :: r
 
 
 #ifdef PETSC
-  if (pReal /= pPETSCSCALAR)                error stop 'PETSc and DAMASK scalar datatypes do not match'
+  if (pREAL /= pPETSCSCALAR)                error stop 'PETSc and DAMASK scalar datatypes do not match'
 #endif
   realloc_lhs_test = [1,2]
   if (any(realloc_lhs_test/=[1,2]))         error stop 'LHS allocation'
@@ -267,11 +267,11 @@ subroutine prec_selfTest()
 
   ! https://www.binaryconvert.com
   ! https://www.rapidtables.com/convert/number/binary-to-decimal.html
-  f = real(prec_bytesToC_FLOAT(int([-65,+11,-102,+75],C_SIGNED_CHAR)),pReal)
-  if (dNeq(f(1),20191102.0_pReal,0.0_pReal)) error stop 'prec_bytesToC_FLOAT'
+  f = real(prec_bytesToC_FLOAT(int([-65,+11,-102,+75],C_SIGNED_CHAR)),pREAL)
+  if (dNeq(f(1),20191102.0_pREAL,0.0_pREAL)) error stop 'prec_bytesToC_FLOAT'
 
-  f = real(prec_bytesToC_DOUBLE(int([0,0,0,-32,+119,+65,+115,65],C_SIGNED_CHAR)),pReal)
-  if (dNeq(f(1),20191102.0_pReal,0.0_pReal)) error stop 'prec_bytesToC_DOUBLE'
+  f = real(prec_bytesToC_DOUBLE(int([0,0,0,-32,+119,+65,+115,65],C_SIGNED_CHAR)),pREAL)
+  if (dNeq(f(1),20191102.0_pREAL,0.0_pREAL)) error stop 'prec_bytesToC_DOUBLE'
 
   i = int(prec_bytesToC_INT32_T(int([+126,+23,+52,+1],C_SIGNED_CHAR)),pI64)
   if (i(1) /= 20191102_pI64)                 error stop 'prec_bytesToC_INT32_T'

src/result.f90

@@ -141,7 +141,7 @@ end subroutine result_closeJobFile
 subroutine result_addIncrement(inc,time)
 
   integer,       intent(in) :: inc
-  real(pReal),   intent(in) :: time
+  real(pREAL),   intent(in) :: time
 
   character(len=pSTRLEN) :: incChar
 
@@ -251,7 +251,7 @@ end subroutine result_addAttribute_int
 subroutine result_addAttribute_real(attrLabel,attrValue,path)
 
   character(len=*), intent(in)           :: attrLabel
-  real(pReal),      intent(in)           :: attrValue
+  real(pREAL),      intent(in)           :: attrValue
   character(len=*), intent(in), optional :: path
 
 
@@ -296,7 +296,7 @@ end subroutine result_addAttribute_int_array
 subroutine result_addAttribute_real_array(attrLabel,attrValue,path)
 
   character(len=*), intent(in)               :: attrLabel
-  real(pReal),      intent(in), dimension(:) :: attrValue
+  real(pREAL),      intent(in), dimension(:) :: attrValue
   character(len=*), intent(in), optional     :: path
 
 
@@ -345,7 +345,7 @@ subroutine result_writeScalarDataset_real(dataset,group,label,description,SIunit
 
   character(len=*), intent(in)                  :: label,group,description
   character(len=*), intent(in),    optional     :: SIunit
-  real(pReal),      intent(in),    dimension(:) :: dataset
+  real(pREAL),      intent(in),    dimension(:) :: dataset
 
   integer(HID_T) :: groupHandle
 
@@ -366,7 +366,7 @@ subroutine result_writeVectorDataset_real(dataset,group,label,description,SIunit
   character(len=*), intent(in)                    :: label,group,description
   character(len=*), intent(in),    optional       :: SIunit
   character(len=*), intent(in),    dimension(:), optional :: systems
-  real(pReal),      intent(in),    dimension(:,:) :: dataset
+  real(pREAL),      intent(in),    dimension(:,:) :: dataset
 
   integer(HID_T) :: groupHandle
 
@@ -390,11 +390,11 @@ subroutine result_writeTensorDataset_real(dataset,group,label,description,SIunit
   character(len=*), intent(in)                   :: label,group,description
   character(len=*), intent(in), optional         :: SIunit
   logical,          intent(in), optional         :: transposed
-  real(pReal),      intent(in), dimension(:,:,:) :: dataset
+  real(pREAL),      intent(in), dimension(:,:,:) :: dataset
 
   integer :: i
   integer(HID_T) :: groupHandle
-  real(pReal), dimension(:,:,:), allocatable :: dataset_transposed
+  real(pREAL), dimension(:,:,:), allocatable :: dataset_transposed
 
 
   groupHandle = result_openGroup(group)

src/rotations.f90

@@ -53,10 +53,10 @@ module rotations
   implicit none(type,external)
   private
 
-  real(pReal), parameter :: P = -1.0_pReal                                                          !< parameter for orientation conversion.
+  real(pREAL), parameter :: P = -1.0_pREAL                                                          !< parameter for orientation conversion.
 
   type, public :: tRotation
-    real(pReal), dimension(4) :: q
+    real(pREAL), dimension(4) :: q
     contains
       procedure, public :: asQuaternion
       procedure, public :: asEulers
@@ -79,16 +79,16 @@ module rotations
       procedure, public  :: standardize
   end type tRotation
 
-  real(pReal), parameter :: &
-    PREF = sqrt(6.0_pReal/PI), &
-    A    = PI**(5.0_pReal/6.0_pReal)/6.0_pReal**(1.0_pReal/6.0_pReal), &
-    AP   = PI**(2.0_pReal/3.0_pReal), &
+  real(pREAL), parameter :: &
+    PREF = sqrt(6.0_pREAL/PI), &
+    A    = PI**(5.0_pREAL/6.0_pREAL)/6.0_pREAL**(1.0_pREAL/6.0_pREAL), &
+    AP   = PI**(2.0_pREAL/3.0_pREAL), &
     SC   = A/AP, &
-    BETA = A/2.0_pReal, &
-    R1   = (3.0_pReal*PI/4.0_pReal)**(1.0_pReal/3.0_pReal), &
-    R2   = sqrt(2.0_pReal), &
-    PI12 = PI/12.0_pReal, &
-    PREK = R1 * 2.0_pReal**(1.0_pReal/4.0_pReal)/BETA
+    BETA = A/2.0_pREAL, &
+    R1   = (3.0_pREAL*PI/4.0_pREAL)**(1.0_pREAL/3.0_pREAL), &
+    R2   = sqrt(2.0_pREAL), &
+    PI12 = PI/12.0_pREAL, &
+    PREK = R1 * 2.0_pREAL**(1.0_pREAL/4.0_pREAL)/BETA
 
   public :: &
     rotations_init, &
@@ -117,7 +117,7 @@ end subroutine rotations_init
 pure function asQuaternion(self)
 
   class(tRotation), intent(in) :: self
-  real(pReal), dimension(4)    :: asQuaternion
+  real(pREAL), dimension(4)    :: asQuaternion
 
 
   asQuaternion = self%q
@@ -127,7 +127,7 @@ end function asQuaternion
 pure function asEulers(self)
 
   class(tRotation), intent(in) :: self
-  real(pReal), dimension(3)    :: asEulers
+  real(pREAL), dimension(3)    :: asEulers
 
 
   asEulers = qu2eu(self%q)
@@ -137,7 +137,7 @@ end function asEulers
 pure function asAxisAngle(self)
 
   class(tRotation), intent(in) :: self
-  real(pReal), dimension(4)    :: asAxisAngle
+  real(pREAL), dimension(4)    :: asAxisAngle
 
 
   asAxisAngle = qu2ax(self%q)
@@ -147,7 +147,7 @@ end function asAxisAngle
 pure function asMatrix(self)
 
   class(tRotation), intent(in) :: self
-  real(pReal), dimension(3,3)  :: asMatrix
+  real(pREAL), dimension(3,3)  :: asMatrix
 
 
   asMatrix = qu2om(self%q)
@@ -160,10 +160,10 @@ end function asMatrix
 subroutine fromQuaternion(self,qu)
 
   class(tRotation), intent(out)         :: self
-  real(pReal), dimension(4), intent(in) :: qu
+  real(pREAL), dimension(4), intent(in) :: qu
 
 
-  if (dNeq(norm2(qu),1.0_pReal,1.0e-8_pReal)) call IO_error(402,ext_msg='fromQuaternion')
+  if (dNeq(norm2(qu),1.0_pREAL,1.0e-8_pREAL)) call IO_error(402,ext_msg='fromQuaternion')
 
   self%q = qu
 
@@ -172,15 +172,15 @@ end subroutine fromQuaternion
 subroutine fromEulers(self,eu,degrees)
 
   class(tRotation), intent(out)         :: self
-  real(pReal), dimension(3), intent(in) :: eu
+  real(pREAL), dimension(3), intent(in) :: eu
   logical, intent(in), optional         :: degrees
 
-  real(pReal), dimension(3)             :: Eulers
+  real(pREAL), dimension(3)             :: Eulers
 
 
   Eulers = merge(eu*INRAD,eu,misc_optional(degrees,.false.))
 
-  if (any(Eulers<0.0_pReal) .or. any(Eulers>TAU) .or. Eulers(2) > PI) &
+  if (any(Eulers<0.0_pREAL) .or. any(Eulers>TAU) .or. Eulers(2) > PI) &
     call IO_error(402,ext_msg='fromEulers')
 
   self%q = eu2qu(Eulers)
@@ -190,20 +190,20 @@ end subroutine fromEulers
 subroutine fromAxisAngle(self,ax,degrees,P)
 
   class(tRotation), intent(out)         :: self
-  real(pReal), dimension(4), intent(in) :: ax
+  real(pREAL), dimension(4), intent(in) :: ax
   logical, intent(in), optional         :: degrees
   integer, intent(in), optional         :: P
 
-  real(pReal)                           :: angle
-  real(pReal),dimension(3)              :: axis
+  real(pREAL)                           :: angle
+  real(pREAL),dimension(3)              :: axis
 
 
   angle = merge(ax(4)*INRAD,ax(4),misc_optional(degrees,.false.))
 
-  axis = ax(1:3) * merge(-1.0_pReal,1.0_pReal,misc_optional(P,-1) == 1)
+  axis = ax(1:3) * merge(-1.0_pREAL,1.0_pREAL,misc_optional(P,-1) == 1)
   if (abs(misc_optional(P,-1)) /= 1) call IO_error(402,ext_msg='fromAxisAngle (P)')
 
-  if (dNeq(norm2(axis),1.0_pReal) .or. angle < 0.0_pReal .or. angle > PI) &
+  if (dNeq(norm2(axis),1.0_pREAL) .or. angle < 0.0_pREAL .or. angle > PI) &
     call IO_error(402,ext_msg='fromAxisAngle')
 
   self%q = ax2qu([axis,angle])
@@ -213,10 +213,10 @@ end subroutine fromAxisAngle
 subroutine fromMatrix(self,om)
 
   class(tRotation), intent(out)           :: self
-  real(pReal), dimension(3,3), intent(in) :: om
+  real(pREAL), dimension(3,3), intent(in) :: om
 
 
-  if (dNeq(math_det33(om),1.0_pReal,tol=1.0e-5_pReal)) &
+  if (dNeq(math_det33(om),1.0_pREAL,tol=1.0e-5_pREAL)) &
     call IO_error(402,ext_msg='fromMatrix')
 
   self%q = om2qu(om)
@@ -248,7 +248,7 @@ pure elemental subroutine standardize(self)
   class(tRotation), intent(inout) :: self
 
 
-  if (sign(1.0_pReal,self%q(1)) < 0.0_pReal) self%q = - self%q
+  if (sign(1.0_pREAL,self%q(1)) < 0.0_pREAL) self%q = - self%q
 
 end subroutine standardize
 
@@ -259,18 +259,18 @@ end subroutine standardize
 !--------------------------------------------------------------------------------------------------
 pure function rotVector(self,v,active) result(vRot)
 
-  real(pReal),                 dimension(3) :: vRot
+  real(pREAL),                 dimension(3) :: vRot
   class(tRotation), intent(in)              :: self
-  real(pReal),     intent(in), dimension(3) :: v
+  real(pREAL),     intent(in), dimension(3) :: v
   logical,         intent(in), optional     :: active
 
-  real(pReal), dimension(4) :: v_normed, q
+  real(pREAL), dimension(4) :: v_normed, q
 
 
   if (dEq0(norm2(v))) then
     vRot = v
   else
-    v_normed = [0.0_pReal,v]/norm2(v)
+    v_normed = [0.0_pREAL,v]/norm2(v)
     q = merge(multiplyQuaternion(conjugateQuaternion(self%q), multiplyQuaternion(v_normed, self%q)), &
               multiplyQuaternion(self%q, multiplyQuaternion(v_normed, conjugateQuaternion(self%q))), &
               misc_optional(active,.false.))
@@ -287,9 +287,9 @@ end function rotVector
 !--------------------------------------------------------------------------------------------------
 pure function rotTensor2(self,T,active) result(tRot)
 
-  real(pReal),                 dimension(3,3) :: tRot
+  real(pREAL),                 dimension(3,3) :: tRot
   class(tRotation), intent(in)                :: self
-  real(pReal),     intent(in), dimension(3,3) :: T
+  real(pREAL),     intent(in), dimension(3,3) :: T
   logical,         intent(in), optional       :: active
 
 
@@ -307,17 +307,17 @@ end function rotTensor2
 !--------------------------------------------------------------------------------------------------
 pure function rotTensor4(self,T,active) result(tRot)
 
-  real(pReal),                 dimension(3,3,3,3) :: tRot
+  real(pREAL),                 dimension(3,3,3,3) :: tRot
   class(tRotation), intent(in)                    :: self
-  real(pReal),     intent(in), dimension(3,3,3,3) :: T
+  real(pREAL),     intent(in), dimension(3,3,3,3) :: T
   logical,         intent(in), optional           :: active
 
-  real(pReal), dimension(3,3) :: R
+  real(pREAL), dimension(3,3) :: R
   integer :: i,j,k,l,m,n,o,p
 
   R = merge(transpose(self%asMatrix()),self%asMatrix(),misc_optional(active,.false.))
 
-  tRot = 0.0_pReal
+  tRot = 0.0_pREAL
   do i = 1,3;do j = 1,3;do k = 1,3;do l = 1,3
   do m = 1,3;do n = 1,3;do o = 1,3;do p = 1,3
     tRot(i,j,k,l) = tRot(i,j,k,l) &
@@ -334,13 +334,13 @@ end function rotTensor4
 !--------------------------------------------------------------------------------------------------
 pure function rotStiffness(self,C,active) result(cRot)
 
-  real(pReal),                 dimension(6,6) :: cRot
+  real(pREAL),                 dimension(6,6) :: cRot
   class(tRotation), intent(in)                :: self
-  real(pReal),     intent(in), dimension(6,6) :: C
+  real(pREAL),     intent(in), dimension(6,6) :: C
   logical,         intent(in), optional       :: active
 
-  real(pReal), dimension(3,3) :: R
-  real(pReal), dimension(6,6) :: M
+  real(pREAL), dimension(3,3) :: R
+  real(pREAL), dimension(6,6) :: M
 
 
   R = merge(transpose(self%asMatrix()),self%asMatrix(),misc_optional(active,.false.))
@@ -351,11 +351,11 @@ pure function rotStiffness(self,C,active) result(cRot)
                R(2,2)*R(3,2),               R(1,2)*R(3,2),               R(1,2)*R(2,2), &
                R(1,3)**2,                   R(2,3)**2,                   R(3,3)**2, &
                R(2,3)*R(3,3),               R(1,3)*R(3,3),               R(1,3)*R(2,3), &
-               2.0_pReal*R(1,2)*R(1,3),     2.0_pReal*R(2,2)*R(2,3),     2.0_pReal*R(3,2)*R(3,3), &
+               2.0_pREAL*R(1,2)*R(1,3),     2.0_pREAL*R(2,2)*R(2,3),     2.0_pREAL*R(3,2)*R(3,3), &
                R(2,2)*R(3,3)+R(2,3)*R(3,2), R(1,2)*R(3,3)+R(1,3)*R(3,2), R(1,2)*R(2,3)+R(1,3)*R(2,2), &
-               2.0_pReal*R(1,3)*R(1,1),     2.0_pReal*R(2,3)*R(2,1),     2.0_pReal*R(3,3)*R(3,1), &
+               2.0_pREAL*R(1,3)*R(1,1),     2.0_pREAL*R(2,3)*R(2,1),     2.0_pREAL*R(3,3)*R(3,1), &
                R(2,3)*R(3,1)+R(2,1)*R(3,3), R(1,3)*R(3,1)+R(1,1)*R(3,3), R(1,3)*R(2,1)+R(1,1)*R(2,3), &
-               2.0_pReal*R(1,1)*R(1,2),     2.0_pReal*R(2,1)*R(2,2),     2.0_pReal*R(3,1)*R(3,2), &
+               2.0_pREAL*R(1,1)*R(1,2),     2.0_pREAL*R(2,1)*R(2,2),     2.0_pREAL*R(3,1)*R(3,2), &
                R(2,1)*R(3,2)+R(2,2)*R(3,1), R(1,1)*R(3,2)+R(1,2)*R(3,1), R(1,1)*R(2,2)+R(1,2)*R(2,1)],[6,6])
 
   cRot = matmul(M,matmul(C,transpose(M)))
@@ -383,27 +383,27 @@ end function misorientation
 !--------------------------------------------------------------------------------------------------
 pure function qu2om(qu) result(om)
 
-  real(pReal), intent(in), dimension(4)   :: qu
-  real(pReal),             dimension(3,3) :: om
+  real(pREAL), intent(in), dimension(4)   :: qu
+  real(pREAL),             dimension(3,3) :: om
 
-  real(pReal)                             :: qq
+  real(pREAL)                             :: qq
 
 
   qq = qu(1)**2-sum(qu(2:4)**2)
 
-  om(1,1) = qq+2.0_pReal*qu(2)**2
-  om(2,2) = qq+2.0_pReal*qu(3)**2
-  om(3,3) = qq+2.0_pReal*qu(4)**2
+  om(1,1) = qq+2.0_pREAL*qu(2)**2
+  om(2,2) = qq+2.0_pREAL*qu(3)**2
+  om(3,3) = qq+2.0_pREAL*qu(4)**2
 
-  om(1,2) = 2.0_pReal*(qu(2)*qu(3)-qu(1)*qu(4))
-  om(2,3) = 2.0_pReal*(qu(3)*qu(4)-qu(1)*qu(2))
-  om(3,1) = 2.0_pReal*(qu(4)*qu(2)-qu(1)*qu(3))
-  om(2,1) = 2.0_pReal*(qu(3)*qu(2)+qu(1)*qu(4))
-  om(3,2) = 2.0_pReal*(qu(4)*qu(3)+qu(1)*qu(2))
-  om(1,3) = 2.0_pReal*(qu(2)*qu(4)+qu(1)*qu(3))
+  om(1,2) = 2.0_pREAL*(qu(2)*qu(3)-qu(1)*qu(4))
+  om(2,3) = 2.0_pREAL*(qu(3)*qu(4)-qu(1)*qu(2))
+  om(3,1) = 2.0_pREAL*(qu(4)*qu(2)-qu(1)*qu(3))
+  om(2,1) = 2.0_pREAL*(qu(3)*qu(2)+qu(1)*qu(4))
+  om(3,2) = 2.0_pREAL*(qu(4)*qu(3)+qu(1)*qu(2))
+  om(1,3) = 2.0_pREAL*(qu(2)*qu(4)+qu(1)*qu(3))
 
-  if (sign(1.0_pReal,P) < 0.0_pReal) om = transpose(om)
-  om = om/math_det33(om)**(1.0_pReal/3.0_pReal)
+  if (sign(1.0_pREAL,P) < 0.0_pREAL) om = transpose(om)
+  om = om/math_det33(om)**(1.0_pREAL/3.0_pREAL)
 
 end function qu2om
 
@@ -414,10 +414,10 @@ end function qu2om
 !--------------------------------------------------------------------------------------------------
 pure function qu2eu(qu) result(eu)
 
-  real(pReal), intent(in), dimension(4) :: qu
-  real(pReal),             dimension(3) :: eu
+  real(pREAL), intent(in), dimension(4) :: qu
+  real(pREAL),             dimension(3) :: eu
 
-  real(pReal)                           :: q12, q03, chi
+  real(pREAL)                           :: q12, q03, chi
 
 
   q03 = qu(1)**2+qu(4)**2
@@ -425,15 +425,15 @@ pure function qu2eu(qu) result(eu)
   chi = sqrt(q03*q12)
 
   degenerated: if (dEq0(q12)) then
-    eu = [atan2(-P*2.0_pReal*qu(1)*qu(4),qu(1)**2-qu(4)**2), 0.0_pReal, 0.0_pReal]
+    eu = [atan2(-P*2.0_pREAL*qu(1)*qu(4),qu(1)**2-qu(4)**2), 0.0_pREAL, 0.0_pREAL]
   elseif          (dEq0(q03)) then
-    eu = [atan2(   2.0_pReal*qu(2)*qu(3),qu(2)**2-qu(3)**2), PI,        0.0_pReal]
+    eu = [atan2(   2.0_pREAL*qu(2)*qu(3),qu(2)**2-qu(3)**2), PI,        0.0_pREAL]
   else degenerated
     eu = [atan2((-P*qu(1)*qu(3)+qu(2)*qu(4))*chi, (-P*qu(1)*qu(2)-qu(3)*qu(4))*chi ), &
-          atan2( 2.0_pReal*chi, q03-q12 ), &
+          atan2( 2.0_pREAL*chi, q03-q12 ), &
           atan2(( P*qu(1)*qu(3)+qu(2)*qu(4))*chi, (-P*qu(1)*qu(2)+qu(3)*qu(4))*chi )]
   end if degenerated
-  where(sign(1.0_pReal,eu)<0.0_pReal) eu = mod(eu+TAU,[TAU,PI,TAU])
+  where(sign(1.0_pREAL,eu)<0.0_pREAL) eu = mod(eu+TAU,[TAU,PI,TAU])
 
 end function qu2eu
 
@@ -444,17 +444,17 @@ end function qu2eu
 !--------------------------------------------------------------------------------------------------
 pure function qu2ax(qu) result(ax)
 
-  real(pReal), intent(in), dimension(4) :: qu
-  real(pReal),             dimension(4) :: ax
+  real(pREAL), intent(in), dimension(4) :: qu
+  real(pREAL),             dimension(4) :: ax
 
-  real(pReal)                           :: omega, s
+  real(pREAL)                           :: omega, s
 
 
   if (dEq0(sum(qu(2:4)**2))) then
-    ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ]                                             ! axis = [001]
+    ax = [ 0.0_pREAL, 0.0_pREAL, 1.0_pREAL, 0.0_pREAL ]                                             ! axis = [001]
   elseif (dNeq0(qu(1))) then
-    s =  sign(1.0_pReal,qu(1))/norm2(qu(2:4))
-    omega = 2.0_pReal * acos(math_clip(qu(1),-1.0_pReal,1.0_pReal))
+    s =  sign(1.0_pREAL,qu(1))/norm2(qu(2:4))
+    omega = 2.0_pREAL * acos(math_clip(qu(1),-1.0_pREAL,1.0_pREAL))
     ax = [ qu(2)*s, qu(3)*s, qu(4)*s, omega ]
   else
     ax = [ qu(2),   qu(3),   qu(4),   PI ]
@@ -470,29 +470,29 @@ end function qu2ax
 !--------------------------------------------------------------------------------------------------
 pure function om2qu(om) result(qu)
 
-  real(pReal), intent(in), dimension(3,3) :: om
-  real(pReal),             dimension(4)   :: qu
+  real(pREAL), intent(in), dimension(3,3) :: om
+  real(pREAL),             dimension(4)   :: qu
 
-  real(pReal) :: trace,s
+  real(pREAL) :: trace,s
   trace = math_trace33(om)
 
 
-  if (trace > 0.0_pReal) then
-    s = 0.5_pReal / sqrt(trace+1.0_pReal)
-    qu = [0.25_pReal/s, (om(3,2)-om(2,3))*s,(om(1,3)-om(3,1))*s,(om(2,1)-om(1,2))*s]
+  if (trace > 0.0_pREAL) then
+    s = 0.5_pREAL / sqrt(trace+1.0_pREAL)
+    qu = [0.25_pREAL/s, (om(3,2)-om(2,3))*s,(om(1,3)-om(3,1))*s,(om(2,1)-om(1,2))*s]
   else
       if ( om(1,1) > om(2,2) .and. om(1,1) > om(3,3) ) then
-          s = 2.0_pReal * sqrt( 1.0_pReal + om(1,1) - om(2,2) - om(3,3))
-          qu = [ (om(3,2) - om(2,3)) /s,0.25_pReal * s,(om(1,2) + om(2,1)) / s,(om(1,3) + om(3,1)) / s]
+          s = 2.0_pREAL * sqrt( 1.0_pREAL + om(1,1) - om(2,2) - om(3,3))
+          qu = [ (om(3,2) - om(2,3)) /s,0.25_pREAL * s,(om(1,2) + om(2,1)) / s,(om(1,3) + om(3,1)) / s]
       elseif (om(2,2) > om(3,3)) then
-          s = 2.0_pReal * sqrt( 1.0_pReal + om(2,2) - om(1,1) - om(3,3))
-          qu = [ (om(1,3) - om(3,1)) /s,(om(1,2) + om(2,1)) / s,0.25_pReal * s,(om(2,3) + om(3,2)) / s]
+          s = 2.0_pREAL * sqrt( 1.0_pREAL + om(2,2) - om(1,1) - om(3,3))
+          qu = [ (om(1,3) - om(3,1)) /s,(om(1,2) + om(2,1)) / s,0.25_pREAL * s,(om(2,3) + om(3,2)) / s]
       else
-          s = 2.0_pReal * sqrt( 1.0_pReal + om(3,3) - om(1,1) - om(2,2) )
-          qu = [ (om(2,1) - om(1,2)) /s,(om(1,3) + om(3,1)) / s,(om(2,3) + om(3,2)) / s,0.25_pReal * s]
+          s = 2.0_pREAL * sqrt( 1.0_pREAL + om(3,3) - om(1,1) - om(2,2) )
+          qu = [ (om(2,1) - om(1,2)) /s,(om(1,3) + om(3,1)) / s,(om(2,3) + om(3,2)) / s,0.25_pREAL * s]
       end if
   end if
-  if (sign(1.0_pReal,qu(1))<0.0_pReal) qu =-1.0_pReal * qu
+  if (sign(1.0_pREAL,qu(1))<0.0_pREAL) qu =-1.0_pREAL * qu
   qu(2:4) = merge(qu(2:4),qu(2:4)*P,dEq0(qu(2:4)))
   qu = qu/norm2(qu)
 
@@ -506,21 +506,21 @@ end function om2qu
 !--------------------------------------------------------------------------------------------------
 pure function om2eu(om) result(eu)
 
-  real(pReal), intent(in), dimension(3,3) :: om
-  real(pReal),             dimension(3)   :: eu
-  real(pReal)                             :: zeta
+  real(pREAL), intent(in), dimension(3,3) :: om
+  real(pREAL),             dimension(3)   :: eu
+  real(pREAL)                             :: zeta
 
 
-  if    (dNeq(abs(om(3,3)),1.0_pReal,1.e-8_pReal)) then
-    zeta = 1.0_pReal/sqrt(math_clip(1.0_pReal-om(3,3)**2,1e-64_pReal,1.0_pReal))
+  if    (dNeq(abs(om(3,3)),1.0_pREAL,1.e-8_pREAL)) then
+    zeta = 1.0_pREAL/sqrt(math_clip(1.0_pREAL-om(3,3)**2,1e-64_pREAL,1.0_pREAL))
     eu = [atan2(om(3,1)*zeta,-om(3,2)*zeta), &
-          acos(math_clip(om(3,3),-1.0_pReal,1.0_pReal)), &
+          acos(math_clip(om(3,3),-1.0_pREAL,1.0_pREAL)), &
           atan2(om(1,3)*zeta, om(2,3)*zeta)]
   else
-    eu = [atan2(om(1,2),om(1,1)), 0.5_pReal*PI*(1.0_pReal-om(3,3)),0.0_pReal ]
+    eu = [atan2(om(1,2),om(1,1)), 0.5_pREAL*PI*(1.0_pREAL-om(3,3)),0.0_pREAL ]
   end if
-  where(abs(eu) < 1.e-8_pReal) eu = 0.0_pReal
-  where(sign(1.0_pReal,eu)<0.0_pReal) eu = mod(eu+TAU,[TAU,PI,TAU])
+  where(abs(eu) < 1.e-8_pREAL) eu = 0.0_pREAL
+  where(sign(1.0_pREAL,eu)<0.0_pREAL) eu = mod(eu+TAU,[TAU,PI,TAU])
 
 end function om2eu
 
@@ -531,28 +531,28 @@ end function om2eu
 !--------------------------------------------------------------------------------------------------
 function om2ax(om) result(ax)
 
-  real(pReal), intent(in), dimension(3,3) :: om
-  real(pReal),             dimension(4)   :: ax
+  real(pREAL), intent(in), dimension(3,3) :: om
+  real(pREAL),             dimension(4)   :: ax
 
-  real(pReal)                      :: t
-  real(pReal), dimension(3)        :: Wr, Wi
-  real(pReal), dimension((64+2)*3) :: work
-  real(pReal), dimension(3,3)      :: VR, devNull, om_
+  real(pREAL)                      :: t
+  real(pREAL), dimension(3)        :: Wr, Wi
+  real(pREAL), dimension((64+2)*3) :: work
+  real(pREAL), dimension(3,3)      :: VR, devNull, om_
   integer                          :: ierr, i
 
 
   om_ = om
 
   ! first get the rotation angle
-  t = 0.5_pReal * (math_trace33(om) - 1.0_pReal)
-  ax(4) = acos(math_clip(t,-1.0_pReal,1.0_pReal))
+  t = 0.5_pREAL * (math_trace33(om) - 1.0_pREAL)
+  ax(4) = acos(math_clip(t,-1.0_pREAL,1.0_pREAL))
 
   if (dEq0(ax(4))) then
-    ax(1:3) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal ]
+    ax(1:3) = [ 0.0_pREAL, 0.0_pREAL, 1.0_pREAL ]
   else
     call dgeev('N','V',3,om_,3,Wr,Wi,devNull,3,VR,3,work,size(work,1),ierr)
     if (ierr /= 0) error stop 'LAPACK error'
-    i = findloc(cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal),.true.,dim=1) !find eigenvalue (1,0)
+    i = findloc(cEq(cmplx(Wr,Wi,pREAL),cmplx(1.0_pREAL,0.0_pREAL,pREAL),tol=1.0e-14_pREAL),.true.,dim=1) !find eigenvalue (1,0)
     if (i == 0) error stop 'om2ax conversion failed'
     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)])) &
@@ -568,13 +568,13 @@ end function om2ax
 !--------------------------------------------------------------------------------------------------
 pure function eu2qu(eu) result(qu)
 
-  real(pReal), intent(in), dimension(3) :: eu
-  real(pReal),             dimension(4) :: qu
-  real(pReal),             dimension(3) :: ee
-  real(pReal)                           :: cPhi, sPhi
+  real(pREAL), intent(in), dimension(3) :: eu
+  real(pREAL),             dimension(4) :: qu
+  real(pREAL),             dimension(3) :: ee
+  real(pREAL)                           :: cPhi, sPhi
 
 
-  ee = 0.5_pReal*eu
+  ee = 0.5_pREAL*eu
 
   cPhi = cos(ee(2))
   sPhi = sin(ee(2))
@@ -583,7 +583,7 @@ pure function eu2qu(eu) result(qu)
         -P*sPhi*cos(ee(1)-ee(3)), &
         -P*sPhi*sin(ee(1)-ee(3)), &
         -P*cPhi*sin(ee(1)+ee(3))]
-  if (sign(1.0_pReal,qu(1)) < 0.0_pReal) qu = qu * (-1.0_pReal)
+  if (sign(1.0_pREAL,qu(1)) < 0.0_pREAL) qu = qu * (-1.0_pREAL)
 
 end function eu2qu
 
@@ -594,10 +594,10 @@ end function eu2qu
 !--------------------------------------------------------------------------------------------------
 pure function eu2om(eu) result(om)
 
-  real(pReal), intent(in), dimension(3)   :: eu
-  real(pReal),             dimension(3,3) :: om
+  real(pREAL), intent(in), dimension(3)   :: eu
+  real(pREAL),             dimension(3,3) :: om
 
-  real(pReal),             dimension(3)   :: c, s
+  real(pREAL),             dimension(3)   :: c, s
 
 
   c = cos(eu)
@@ -613,7 +613,7 @@ pure function eu2om(eu) result(om)
   om(2,3) =  c(3)*s(2)
   om(3,3) =  c(2)
 
-  where(abs(om)<1.0e-12_pReal) om = 0.0_pReal
+  where(abs(om)<1.0e-12_pREAL) om = 0.0_pREAL
 
 end function eu2om
 
@@ -624,25 +624,25 @@ end function eu2om
 !--------------------------------------------------------------------------------------------------
 pure function eu2ax(eu) result(ax)
 
-  real(pReal), intent(in), dimension(3) :: eu
-  real(pReal),             dimension(4) :: ax
+  real(pREAL), intent(in), dimension(3) :: eu
+  real(pREAL),             dimension(4) :: ax
 
-  real(pReal)                           :: t, delta, tau, alpha, sigma
+  real(pREAL)                           :: t, delta, tau, alpha, sigma
 
 
-  t     = tan(eu(2)*0.5_pReal)
-  sigma = 0.5_pReal*(eu(1)+eu(3))
-  delta = 0.5_pReal*(eu(1)-eu(3))
+  t     = tan(eu(2)*0.5_pREAL)
+  sigma = 0.5_pREAL*(eu(1)+eu(3))
+  delta = 0.5_pREAL*(eu(1)-eu(3))
   tau   = sqrt(t**2+sin(sigma)**2)
 
-  alpha = merge(PI, 2.0_pReal*atan(tau/cos(sigma)), dEq(sigma,PI*0.5_pReal,tol=1.0e-15_pReal))
+  alpha = merge(PI, 2.0_pREAL*atan(tau/cos(sigma)), dEq(sigma,PI*0.5_pREAL,tol=1.0e-15_pREAL))
 
   if (dEq0(alpha)) then                                                                             ! return a default identity axis-angle pair
-    ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ]
+    ax = [ 0.0_pREAL, 0.0_pREAL, 1.0_pREAL, 0.0_pREAL ]
   else
     ax(1:3) = -P/tau * [ t*cos(delta), t*sin(delta), sin(sigma) ]                                   ! passive axis-angle pair so a minus sign in front
     ax(4) = alpha
-    if (sign(1.0_pReal,alpha) < 0.0_pReal) ax = -ax                                                 ! ensure alpha is positive
+    if (sign(1.0_pREAL,alpha) < 0.0_pREAL) ax = -ax                                                 ! ensure alpha is positive
   end if
 
 end function eu2ax
@@ -654,17 +654,17 @@ end function eu2ax
 !--------------------------------------------------------------------------------------------------
 pure function ax2qu(ax) result(qu)
 
-  real(pReal), intent(in), dimension(4) :: ax
-  real(pReal),             dimension(4) :: qu
+  real(pREAL), intent(in), dimension(4) :: ax
+  real(pREAL),             dimension(4) :: qu
 
-  real(pReal)                           :: c, s
+  real(pREAL)                           :: c, s
 
 
   if (dEq0(ax(4))) then
-    qu = [ 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal ]
+    qu = [ 1.0_pREAL, 0.0_pREAL, 0.0_pREAL, 0.0_pREAL ]
   else
-    c = cos(ax(4)*0.5_pReal)
-    s = sin(ax(4)*0.5_pReal)
+    c = cos(ax(4)*0.5_pREAL)
+    s = sin(ax(4)*0.5_pREAL)
     qu = [ c, ax(1)*s, ax(2)*s, ax(3)*s ]
   end if
 
@@ -677,15 +677,15 @@ end function ax2qu
 !--------------------------------------------------------------------------------------------------
 pure function ax2om(ax) result(om)
 
-  real(pReal), intent(in), dimension(4)   :: ax
-  real(pReal),             dimension(3,3) :: om
+  real(pREAL), intent(in), dimension(4)   :: ax
+  real(pREAL),             dimension(3,3) :: om
 
-  real(pReal)                             :: q, c, s, omc
+  real(pREAL)                             :: q, c, s, omc
 
 
   c = cos(ax(4))
   s = sin(ax(4))
-  omc = 1.0_pReal-c
+  omc = 1.0_pREAL-c
 
   om(1,1) = ax(1)**2*omc + c
   om(2,2) = ax(2)**2*omc + c
@@ -703,7 +703,7 @@ pure function ax2om(ax) result(om)
   om(3,1) = q + s*ax(2)
   om(1,3) = q - s*ax(2)
 
-  if (P > 0.0_pReal) om = transpose(om)
+  if (P > 0.0_pREAL) om = transpose(om)
 
 end function ax2om
 
@@ -714,8 +714,8 @@ end function ax2om
 !--------------------------------------------------------------------------------------------------
 pure function ax2eu(ax) result(eu)
 
-  real(pReal), intent(in), dimension(4) :: ax
-  real(pReal),             dimension(3) :: eu
+  real(pREAL), intent(in), dimension(4) :: ax
+  real(pREAL),             dimension(3) :: eu
 
 
   eu = om2eu(ax2om(ax))
@@ -728,8 +728,8 @@ end function ax2eu
 !--------------------------------------------------------------------------------------------------
 pure function multiplyQuaternion(qu1,qu2)
 
-  real(pReal), dimension(4), intent(in) :: qu1, qu2
-  real(pReal), dimension(4) :: multiplyQuaternion
+  real(pREAL), dimension(4), intent(in) :: qu1, qu2
+  real(pREAL), dimension(4) :: multiplyQuaternion
 
 
   multiplyQuaternion(1) = qu1(1)*qu2(1) - qu1(2)*qu2(2) -      qu1(3)*qu2(3) - qu1(4)*qu2(4)
@@ -745,8 +745,8 @@ end function multiplyQuaternion
 !--------------------------------------------------------------------------------------------------
 pure function conjugateQuaternion(qu)
 
-  real(pReal), dimension(4), intent(in) :: qu
-  real(pReal), dimension(4) :: conjugateQuaternion
+  real(pREAL), dimension(4), intent(in) :: qu
+  real(pREAL), dimension(4) :: conjugateQuaternion
 
 
   conjugateQuaternion = [qu(1), -qu(2), -qu(3), -qu(4)]
@@ -760,36 +760,36 @@ end function conjugateQuaternion
 subroutine selfTest()
 
   type(tRotation)                 :: R
-  real(pReal), dimension(4)       :: qu
-  real(pReal), dimension(3)       :: x, eu, v3
-  real(pReal), dimension(3,3)     :: om, t33
-  real(pReal), dimension(3,3,3,3) :: t3333
-  real(pReal), dimension(6,6)     :: C
-  real(pReal) :: A,B
+  real(pREAL), dimension(4)       :: qu
+  real(pREAL), dimension(3)       :: x, eu, v3
+  real(pREAL), dimension(3,3)     :: om, t33
+  real(pREAL), dimension(3,3,3,3) :: t3333
+  real(pREAL), dimension(6,6)     :: C
+  real(pREAL) :: A,B
   integer :: i
 
 
   do i = 1, 20
 
     if (i==1) then
-      qu = [1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal]
+      qu = [1.0_pREAL, 0.0_pREAL, 0.0_pREAL, 0.0_pREAL]
     elseif (i==2) then
-      qu = [1.0_pReal,-0.0_pReal,-0.0_pReal,-0.0_pReal]
+      qu = [1.0_pREAL,-0.0_pREAL,-0.0_pREAL,-0.0_pREAL]
     elseif (i==3) then
-      qu = [0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal]
+      qu = [0.0_pREAL, 1.0_pREAL, 0.0_pREAL, 0.0_pREAL]
     elseif (i==4) then
-      qu = [0.0_pReal,0.0_pReal,1.0_pReal,0.0_pReal]
+      qu = [0.0_pREAL,0.0_pREAL,1.0_pREAL,0.0_pREAL]
     elseif (i==5) then
-      qu = [0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal]
+      qu = [0.0_pREAL, 0.0_pREAL, 0.0_pREAL, 1.0_pREAL]
     else
       call random_number(x)
       A = sqrt(x(3))
-      B = sqrt(1-0_pReal -x(3))
+      B = sqrt(1-0_pREAL -x(3))
       qu = [cos(TAU*x(1))*A,&
             sin(TAU*x(2))*B,&
             cos(TAU*x(2))*B,&
             sin(TAU*x(1))*A]
-      if (qu(1)<0.0_pReal) qu = qu * (-1.0_pReal)
+      if (qu(1)<0.0_pREAL) qu = qu * (-1.0_pREAL)
     end if
 
 
@@ -807,24 +807,24 @@ subroutine selfTest()
     call R%fromMatrix(om)
 
     call random_number(v3)
-    if (any(dNeq(R%rotVector(R%rotVector(v3),active=.true.),v3,1.0e-12_pReal))) &
+    if (any(dNeq(R%rotVector(R%rotVector(v3),active=.true.),v3,1.0e-12_pREAL))) &
       error stop 'rotVector'
 
     call random_number(t33)
-    if (any(dNeq(R%rotTensor2(R%rotTensor2(t33),active=.true.),t33,1.0e-12_pReal))) &
+    if (any(dNeq(R%rotTensor2(R%rotTensor2(t33),active=.true.),t33,1.0e-12_pREAL))) &
       error stop 'rotTensor2'
 
     call random_number(t3333)
-    if (any(dNeq(R%rotTensor4(R%rotTensor4(t3333),active=.true.),t3333,1.0e-12_pReal))) &
+    if (any(dNeq(R%rotTensor4(R%rotTensor4(t3333),active=.true.),t3333,1.0e-12_pREAL))) &
       error stop 'rotTensor4'
 
     call random_number(C)
     C = C+transpose(C)
     if (any(dNeq(R%rotStiffness(C), &
-                 math_3333toVoigt66_stiffness(R%rotate(math_Voigt66to3333_stiffness(C))),1.0e-12_pReal))) &
+                 math_3333toVoigt66_stiffness(R%rotate(math_Voigt66to3333_stiffness(C))),1.0e-12_pREAL))) &
       error stop 'rotStiffness'
 
-    call R%fromQuaternion(qu * (1.0_pReal + merge(+5.e-9_pReal,-5.e-9_pReal, mod(i,2) == 0)))       ! allow reasonable tolerance for ASCII/YAML
+    call R%fromQuaternion(qu * (1.0_pREAL + merge(+5.e-9_pREAL,-5.e-9_pREAL, mod(i,2) == 0)))       ! allow reasonable tolerance for ASCII/YAML
 
   end do
 
@@ -832,12 +832,12 @@ subroutine selfTest()
 
   pure recursive function quaternion_equal(qu1,qu2) result(ok)
 
-    real(pReal), intent(in), dimension(4) :: qu1,qu2
+    real(pREAL), intent(in), dimension(4) :: qu1,qu2
     logical :: ok
 
-    ok = all(dEq(qu1,qu2,1.0e-7_pReal))
-    if (dEq0(qu1(1),1.0e-12_pReal)) &
-      ok = ok .or. all(dEq(-1.0_pReal*qu1,qu2,1.0e-7_pReal))
+    ok = all(dEq(qu1,qu2,1.0e-7_pREAL))
+    if (dEq0(qu1(1),1.0e-12_pREAL)) &
+      ok = ok .or. all(dEq(-1.0_pREAL*qu1,qu2,1.0e-7_pREAL))
 
   end function quaternion_equal
 

src/tables.f90

@@ -13,7 +13,7 @@ module tables
   private
 
   type, public :: tTable
-    real(pReal), dimension(:), allocatable :: x,y
+    real(pREAL), dimension(:), allocatable :: x,y
     contains
     procedure, public :: at => eval
   end type tTable
@@ -47,7 +47,7 @@ end subroutine tables_init
 !--------------------------------------------------------------------------------------------------
 function table_from_values(x,y) result(t)
 
-  real(pReal), dimension(:), intent(in) :: x,y
+  real(pREAL), dimension(:), intent(in) :: x,y
   type(tTable) :: t
 
 
@@ -55,7 +55,7 @@ function table_from_values(x,y) result(t)
   if (size(y) < 1)         call IO_error(603,ext_msg='missing tabulated y data')
   if (size(x) /= size(y))  call IO_error(603,ext_msg='shape mismatch in tabulated data')
   if (size(x) /= 1) then
-    if (any(x(2:size(x))-x(1:size(x)-1) <= 0.0_pReal)) &
+    if (any(x(2:size(x))-x(1:size(x)-1) <= 0.0_pREAL)) &
                            call IO_error(603,ext_msg='ordinate data does not increase monotonically')
   end if
 
@@ -86,8 +86,8 @@ end function table_from_dict
 pure function eval(self,x) result(y)
 
   class(tTable), intent(in) :: self
-  real(pReal), intent(in) :: x
-  real(pReal) :: y
+  real(pREAL), intent(in) :: x
+  real(pREAL) :: y
 
   integer :: i
 
@@ -109,25 +109,25 @@ end function eval
 subroutine selfTest()
 
   type(tTable) :: t
-  real(pReal), dimension(*), parameter :: &
-    x = real([ 1., 2., 3., 4.],pReal), &
-    y = real([ 1., 3., 2.,-2.],pReal), &
-    x_eval = real([ 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0],pReal), &
-    y_true = real([-1.0, 0.0, 1.0, 2.0, 3.0, 2.5 ,2.0, 0.0,-2.0,-4.0,-6.0],pReal)
+  real(pREAL), dimension(*), parameter :: &
+    x = real([ 1., 2., 3., 4.],pREAL), &
+    y = real([ 1., 3., 2.,-2.],pREAL), &
+    x_eval = real([ 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0],pREAL), &
+    y_true = real([-1.0, 0.0, 1.0, 2.0, 3.0, 2.5 ,2.0, 0.0,-2.0,-4.0,-6.0],pREAL)
   integer :: i
   type(tDict), pointer :: dict
   type(tList), pointer :: l_x, l_y
-  real(pReal) :: r
+  real(pREAL) :: r
 
 
   call random_number(r)
-  t = table(real([0.],pReal),real([r],pReal))
-  if (dNeq(r,t%at(r),1.0e-9_pReal)) error stop 'table eval/mono'
+  t = table(real([0.],pREAL),real([r],pREAL))
+  if (dNeq(r,t%at(r),1.0e-9_pREAL)) error stop 'table eval/mono'
 
-  r = r-0.5_pReal
+  r = r-0.5_pREAL
   t = table(x+r,y)
   do i = 1, size(x_eval)
-    if (dNeq(y_true(i),t%at(x_eval(i)+r),1.0e-9_pReal)) error stop 'table eval/values'
+    if (dNeq(y_true(i),t%at(x_eval(i)+r),1.0e-9_pREAL)) error stop 'table eval/values'
   end do
 
   l_x => YAML_parse_str_asList('[1, 2, 3, 4]'//IO_EOL)

src/test/test_HDF5_utilities.f90

@@ -22,7 +22,7 @@ end subroutine HDF5_utilities_test
 subroutine test_read_write()
 
   integer(HID_T) :: f
-  real(pReal), dimension(3) :: d_in,d_out
+  real(pREAL), dimension(3) :: d_in,d_out
 
 
   call random_number(d_in)