diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0ff94f3d7..14a741b3b 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -96,14 +96,12 @@ end subroutine DAMASK_interface_init !> @brief solver job name (no extension) as combination of geometry and load case name !-------------------------------------------------------------------------------------------------- function getSolverJobName() - use prec, only: & - pReal, & - pInt + use prec implicit none character(1024) :: getSolverJobName, inputName character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash - integer(pInt) :: extPos + integer :: extPos getSolverJobName='' inputName='' @@ -133,9 +131,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, & strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, & jtype,lclass,ifr,ifu) - use prec, only: & - pReal, & - pInt + use prec use numerics, only: & !$ DAMASK_NumThreadsInt, & numerics_unitlength, & @@ -180,7 +176,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & implicit none !$ include "omp_lib.h" ! the openMP function library - integer(pInt), intent(in) :: & ! according to MSC.Marc 2012 Manual D + integer, intent(in) :: & ! according to MSC.Marc 2012 Manual D ngens, & !< size of stress-strain law nn, & !< integration point number ndi, & !< number of direct components @@ -193,7 +189,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & jtype, & !< element type ifr, & !< set to 1 if R has been calculated ifu !< set to 1 if stretch has been calculated - integer(pInt), dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D + integer, dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D m, & !< (1) user element number, (2) internal element number matus, & !< (1) user material identification number, (2) internal material identification number kcus, & !< (1) layer number, (2) internal layer number @@ -236,10 +232,10 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & logical :: cutBack real(pReal), dimension(6) :: stress real(pReal), dimension(6,6) :: ddsdde - integer(pInt) :: computationMode, i, cp_en, node, CPnodeID + integer :: computationMode, i, cp_en, node, CPnodeID !$ integer(4) :: defaultNumThreadsInt !< default value set by Marc - if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0_pInt) then + if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0) then write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn write(6,'(a,2(i1))') ' Jacobian: ', ngens,ngens write(6,'(a,i1)') ' Direct stress: ', ndi @@ -260,7 +256,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & !$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS - computationMode = 0_pInt ! save initialization value, since it does not result in any calculation + computationMode = 0 ! save initialization value, since it does not result in any calculation if (lovl == 4 ) then ! jacobian requested by marc if (timinc < theDelta .and. theInc == inc .and. lastLovl /= lovl) & ! first after cutback computationMode = CPFEM_RESTOREJACOBIAN @@ -307,7 +303,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & if (lastLovl /= lovl) then ! first after ping pong call debug_reset() ! resets debugging outdatedFFN1 = .false. - cycleCounter = cycleCounter + 1_pInt + cycleCounter = cycleCounter + 1 mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates call mesh_build_ipCoordinates() ! update ip coordinates endif @@ -324,7 +320,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & lastIncConverged = .false. ! reset flag endif do node = 1,theMesh%elem%nNodes - CPnodeID = mesh_element(4_pInt+node,cp_en) + CPnodeID = mesh_element(4+node,cp_en) mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node) enddo endif @@ -336,7 +332,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & call debug_info() ! first reports (meaningful) debugging call debug_reset() ! and resets debugging outdatedFFN1 = .false. - cycleCounter = cycleCounter + 1_pInt + cycleCounter = cycleCounter + 1 mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates call mesh_build_ipCoordinates() ! update ip coordinates endif @@ -376,22 +372,20 @@ end subroutine hypela2 !> @brief calculate internal heat generated due to inelastic energy dissipation !-------------------------------------------------------------------------------------------------- subroutine flux(f,ts,n,time) - use prec, only: & - pReal, & - pInt + use prec use thermal_conduction, only: & thermal_conduction_getSourceAndItsTangent use mesh, only: & mesh_FEasCP implicit none - real(pReal), dimension(6), intent(in) :: & + real(pReal), dimension(6), intent(in) :: & ts - integer(pInt), dimension(10), intent(in) :: & + integer, 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 call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEasCP('elem',n(1))) @@ -404,9 +398,7 @@ subroutine flux(f,ts,n,time) !> @details select a variable contour plotting (user subroutine). !-------------------------------------------------------------------------------------------------- subroutine uedinc(inc,incsub) - use prec, only: & - pReal, & - pInt + use prec use CPFEM, only: & CPFEM_results @@ -424,9 +416,7 @@ end subroutine uedinc !> @details select a variable contour plotting (user subroutine). !-------------------------------------------------------------------------------------------------- subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) - use prec, only: & - pReal, & - pInt + use prec use mesh, only: & mesh_FEasCP use IO, only: & @@ -436,7 +426,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) materialpoint_sizeResults implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & m, & !< element number nn, & !< integration point number layer, & !< layer number @@ -453,7 +443,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) real(pReal), intent(out) :: & v !< variable - if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd) ! complain about out of bounds error + if (jpltcd > materialpoint_sizeResults) call IO_error(700,jpltcd) ! complain about out of bounds error v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m)) end subroutine plotv diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index 8780d2712..be567decc 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -11,8 +11,8 @@ module FEsolving implicit none private - integer(pInt), public :: & - restartInc = 1_pInt !< needs description + integer, public :: & + restartInc = 1 !< needs description logical, public :: & symmetricSolver = .false., & !< use a symmetric FEM solver @@ -20,10 +20,10 @@ module FEsolving restartRead = .false., & !< restart information to continue calculation from saved state terminallyIll = .false. !< at least one material point is terminally ill - integer(pInt), dimension(:,:), allocatable, public :: & + integer, dimension(:,:), allocatable, public :: & FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP - integer(pInt), dimension(2), public :: & + integer, dimension(2), public :: & FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element character(len=1024), public :: & @@ -61,11 +61,11 @@ subroutine FE_init implicit none #if defined(Marc4DAMASK) || defined(Abaqus) - integer(pInt), parameter :: & - FILEUNIT = 222_pInt - integer(pInt) :: j + integer, parameter :: & + FILEUNIT = 222 + integer :: j character(len=65536) :: tag, line - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos #endif write(6,'(/,a)') ' <<<+- FEsolving init -+>>>' @@ -75,35 +75,35 @@ subroutine FE_init #if defined(Grid) || defined(FEM) restartInc = interface_RestartInc - if(restartInc < 0_pInt) then - call IO_warning(warning_ID=34_pInt) - restartInc = 0_pInt + if(restartInc < 0) then + call IO_warning(warning_ID=34) + restartInc = 0 endif - restartRead = restartInc > 0_pInt ! only read in if "true" restart requested + restartRead = restartInc > 0 ! only read in if "true" restart requested #else call IO_open_inputFile(FILEUNIT,modelName) rewind(FILEUNIT) do read (FILEUNIT,'(a1024)',END=100) line chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key select case(tag) case ('solver') read (FILEUNIT,'(a1024)',END=100) line ! next line chunkPos = IO_stringPos(line) - symmetricSolver = (IO_intValue(line,chunkPos,2_pInt) /= 1_pInt) + symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1) case ('restart') read (FILEUNIT,'(a1024)',END=100) line ! next line chunkPos = IO_stringPos(line) - restartWrite = iand(IO_intValue(line,chunkPos,1_pInt),1_pInt) > 0_pInt - restartRead = iand(IO_intValue(line,chunkPos,1_pInt),2_pInt) > 0_pInt + restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0 + restartRead = iand(IO_intValue(line,chunkPos,1),2) > 0 case ('*restart') - do j=2_pInt,chunkPos(1) + do j=2,chunkPos(1) restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead enddo if(restartWrite) then - do j=2_pInt,chunkPos(1) + do j=2,chunkPos(1) restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite enddo endif @@ -118,11 +118,11 @@ subroutine FE_init do read (FILEUNIT,'(a1024)',END=200) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'restart' & - .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'file' & - .and. IO_lc(IO_stringValue(line,chunkPos,3_pInt)) == 'job' & - .and. IO_lc(IO_stringValue(line,chunkPos,4_pInt)) == 'id' ) & - modelName = IO_StringValue(line,chunkPos,6_pInt) + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'restart' & + .and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'file' & + .and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job' & + .and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) & + modelName = IO_StringValue(line,chunkPos,6) enddo #else ! QUESTION: is this meaningful for the spectral/FEM case? call IO_open_inputFile(FILEUNIT,modelName) @@ -130,10 +130,10 @@ subroutine FE_init do read (FILEUNIT,'(a1024)',END=200) line chunkPos = IO_stringPos(line) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt))=='*heading') then + if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then read (FILEUNIT,'(a1024)',END=200) line chunkPos = IO_stringPos(line) - modelName = IO_StringValue(line,chunkPos,1_pInt) + modelName = IO_StringValue(line,chunkPos,1) endif enddo #endif @@ -141,7 +141,7 @@ subroutine FE_init endif #endif - if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0_pInt) then + if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then write(6,'(a21,l1)') ' restart writing: ', restartWrite write(6,'(a21,l1)') ' restart reading: ', restartRead if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName) diff --git a/src/IO.f90 b/src/IO.f90 index 074e2b0f4..86ff5fe57 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -6,9 +6,8 @@ !> @brief input/output functions, partly depending on chosen solver !-------------------------------------------------------------------------------------------------- module IO - use prec, only: & - pInt, & - pReal + use prec + use DAMASK_interface implicit none private @@ -75,8 +74,6 @@ end subroutine IO_init !> @brief reads a line from a text file. !-------------------------------------------------------------------------------------------------- function IO_read(fileUnit) result(line) - use prec, only: & - pStringLen implicit none integer, intent(in) :: fileUnit !< file unit @@ -93,8 +90,7 @@ function IO_read(fileUnit) result(line) !> @brief reads an entire ASCII file into an array !-------------------------------------------------------------------------------------------------- function IO_read_ASCII(fileName) result(fileContent) - use prec, only: & - pStringLen + implicit none character(len=*), intent(in) :: fileName @@ -181,8 +177,6 @@ end subroutine IO_open_file !> @details replaces an existing file when writing !-------------------------------------------------------------------------------------------------- integer function IO_open_jobFile_binary(extension,mode) - use DAMASK_interface, only: & - getSolverJobName implicit none character(len=*), intent(in) :: extension @@ -236,33 +230,31 @@ end function IO_open_binary !> @brief opens FEM input file for reading located in current working directory to given unit !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) - use DAMASK_interface, only: & - inputFileExtension implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name - integer(pInt) :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path #if defined(Abaqus) - integer(pInt) :: fileType + integer :: fileType - fileType = 1_pInt ! assume .pes + fileType = 1 ! assume .pes path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') - if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" - fileType = 2_pInt + if(myStat /= 0) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" + fileType = 2 path = trim(modelName)//inputFileExtension(fileType) open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') endif - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) path = trim(modelName)//inputFileExtension(fileType)//'_assembly' open(fileUnit,iostat=myStat,file=path) - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s - close(fileUnit+1_pInt) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) + if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1)) call IO_error(103) ! strip comments and concatenate any "include"s + close(fileUnit+1) contains @@ -273,20 +265,20 @@ subroutine IO_open_inputFile(fileUnit,modelName) recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) implicit none - integer(pInt), intent(in) :: unit1, & - unit2 + integer, intent(in) :: unit1, & + unit2 - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line,fname - logical :: createSuccess,fexist + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line,fname + logical :: createSuccess,fexist do read(unit2,'(A65536)',END=220) line chunkPos = IO_stringPos(line) - if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then + if (IO_lc(IO_StringValue(line,chunkPos,1))=='*include') then fname = trim(line(9+scan(line(9:),'='):)) inquire(file=fname, exist=fexist) if (.not.(fexist)) then @@ -298,7 +290,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) return endif open(unit2+1,err=200,status='old',file=fname) - if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then + if (abaqus_assembleInputFile(unit1,unit2+1)) then createSuccess=.true. close(unit2+1) else @@ -319,7 +311,7 @@ end function abaqus_assembleInputFile #elif defined(Marc4DAMASK) path = trim(modelName)//inputFileExtension open(fileUnit,status='old',iostat=myStat,file=path) - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) #endif end subroutine IO_open_inputFile @@ -330,19 +322,16 @@ end subroutine IO_open_inputFile !! name and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) - use DAMASK_interface, only: & - getSolverJobName, & - LogFileExtension implicit none - integer(pInt), intent(in) :: fileUnit !< file unit + integer, intent(in) :: fileUnit !< file unit - integer(pInt) :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path path = trim(getSolverJobName())//LogFileExtension open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) end subroutine IO_open_logFile #endif @@ -353,19 +342,17 @@ end subroutine IO_open_logFile !! given extension and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) - use DAMASK_interface, only: & - getSolverJobName implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file - integer(pInt) :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='replace',iostat=myStat,file=path) - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) end subroutine IO_write_jobFile @@ -413,7 +400,7 @@ pure function IO_getTag(string,openChar,closeChar) right = scan(string,closeChar) else left = scan(string,openChar) - right = left + merge(scan(string(left+1:),openChar),0_pInt,len(string) > left) + right = left + merge(scan(string(left+1:),openChar),0,len(string) > left) endif if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs @@ -431,13 +418,13 @@ end function IO_getTag pure function IO_stringPos(string) implicit none - integer(pInt), dimension(:), allocatable :: IO_stringPos - character(len=*), intent(in) :: string !< string in which chunk positions are searched for + integer, dimension(:), allocatable :: IO_stringPos + character(len=*), intent(in) :: string !< string in which chunk positions are searched for character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces integer :: left, right ! no pInt (verify and scan return default integer) - allocate(IO_stringPos(1), source=0_pInt) + allocate(IO_stringPos(1), source=0) right = 0 do while (verify(string(right+1:),SEP)>0) @@ -445,7 +432,7 @@ pure function IO_stringPos(string) right = left + scan(string(left:),SEP) - 2 if ( string(left:left) == '#' ) exit IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)] - IO_stringPos(1) = IO_stringPos(1)+1_pInt + IO_stringPos(1) = IO_stringPos(1)+1 endOfString: if (right < left) then IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string) exit @@ -461,15 +448,15 @@ end function IO_stringPos function IO_stringValue(string,chunkPos,myChunk,silent) implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - character(len=:), allocatable :: IO_stringValue + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer, intent(in) :: myChunk !< position number of desired chunk + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + character(len=:), allocatable :: IO_stringValue - logical, optional,intent(in) :: silent !< switch to trigger verbosity - character(len=16), parameter :: MYNAME = 'IO_stringValue: ' + logical, optional,intent(in) :: silent !< switch to trigger verbosity + character(len=16), parameter :: MYNAME = 'IO_stringValue: ' - logical :: warn + logical :: warn if (present(silent)) then warn = silent @@ -478,7 +465,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent) endif IO_stringValue = '' - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) else valuePresent IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) @@ -493,15 +480,15 @@ end function IO_stringValue real(pReal) function IO_floatValue (string,chunkPos,myChunk) implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=*), intent(in) :: string !< 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 + integer, intent(in) :: myChunk !< position number of desired chunk + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk character(len=15), parameter :: MYNAME = 'IO_floatValue: ' character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' IO_floatValue = 0.0_pReal - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) else valuePresent IO_floatValue = & @@ -515,18 +502,18 @@ end function IO_floatValue !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_intValue(string,chunkPos,myChunk) +integer function IO_intValue(string,chunkPos,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - character(len=13), parameter :: MYNAME = 'IO_intValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + character(len=13), parameter :: MYNAME = 'IO_intValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_intValue = 0_pInt + IO_intValue = 0 - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) else valuePresent IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& @@ -543,27 +530,27 @@ end function IO_intValue real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' - character(len=13), parameter :: VALIDBASE = '0123456789.+-' - character(len=12), parameter :: VALIDEXP = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known ends of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string + character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' + character(len=13), parameter :: VALIDBASE = '0123456789.+-' + character(len=12), parameter :: VALIDEXP = '0123456789+-' real(pReal) :: base - integer(pInt) :: expon + integer :: expon integer :: pos_exp pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.) hasExponent: if (pos_exp > 1) then - base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk)+pos_exp-1_pInt))),& + base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk)+pos_exp-1))),& VALIDBASE,MYNAME//'(base): ') - expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1_pInt)))),& + expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1)))),& VALIDEXP,MYNAME//'(exp): ') else hasExponent - base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& + base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& VALIDBASE,MYNAME//'(base): ') - expon = 0_pInt + expon = 0 endif hasExponent IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal) @@ -573,16 +560,16 @@ end function IO_fixedNoEFloatValue !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_fixedIntValue(string,ends,myChunk) +integer function IO_fixedIntValue(string,ends,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known ends of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string + character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& + IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& VALIDCHARACTERS,MYNAME) end function IO_fixedIntValue @@ -618,15 +605,15 @@ end function IO_lc pure function IO_intOut(intToPrint) implicit none - integer(pInt), intent(in) :: intToPrint - character(len=41) :: IO_intOut - integer(pInt) :: N_digits - character(len=19) :: width ! maximum digits for 64 bit integer - character(len=20) :: min_width ! longer for negative values + integer, intent(in) :: intToPrint + character(len=41) :: IO_intOut + integer :: N_digits + character(len=19) :: width ! maximum digits for 64 bit integer + character(len=20) :: min_width ! longer for negative values - N_digits = 1_pInt + int(log10(real(max(abs(intToPrint),1_pInt))),pInt) + N_digits = 1 + int(log10(real(max(abs(intToPrint),1))),pInt) write(width, '(I19.19)') N_digits - write(min_width, '(I20.20)') N_digits + merge(1_pInt,0_pInt,intToPrint < 0_pInt) + write(min_width, '(I20.20)') N_digits + merge(1,0,intToPrint < 0) IO_intOut = 'I'//trim(min_width)//'.'//trim(width) end function IO_intOut @@ -639,8 +626,8 @@ end function IO_intOut subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) implicit none - integer(pInt), intent(in) :: error_ID - integer(pInt), optional, intent(in) :: el,ip,g,instance + integer, intent(in) :: error_ID + integer, optional, intent(in) :: el,ip,g,instance character(len=*), optional, intent(in) :: ext_msg external :: quit @@ -651,218 +638,218 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) !-------------------------------------------------------------------------------------------------- ! internal errors - case (0_pInt) + case (0) msg = 'internal check failed:' !-------------------------------------------------------------------------------------------------- ! file handling errors - case (100_pInt) + case (100) msg = 'could not open file:' - case (101_pInt) + case (101) msg = 'write error for file:' - case (102_pInt) + case (102) msg = 'could not read file:' - case (103_pInt) + case (103) msg = 'could not assemble input files' - case (104_pInt) + case (104) msg = '{input} recursion limit reached' - case (105_pInt) + case (105) msg = 'unknown output:' - case (106_pInt) + case (106) msg = 'working directory does not exist:' - case (107_pInt) + case (107) msg = 'line length exceeds limit of 256' !-------------------------------------------------------------------------------------------------- ! lattice error messages - case (130_pInt) + case (130) msg = 'unknown lattice structure encountered' - case (131_pInt) + case (131) msg = 'hex lattice structure with invalid c/a ratio' - case (132_pInt) + case (132) msg = 'trans_lattice_structure not possible' - case (133_pInt) + case (133) msg = 'transformed hex lattice structure with invalid c/a ratio' - case (135_pInt) + case (135) msg = 'zero entry on stiffness diagonal' - case (136_pInt) + case (136) msg = 'zero entry on stiffness diagonal for transformed phase' - case (137_pInt) + case (137) msg = 'not defined for lattice structure' - case (138_pInt) + case (138) msg = 'not enough interaction parameters given' !-------------------------------------------------------------------------------------------------- ! errors related to the parsing of material.config - case (140_pInt) + case (140) msg = 'key not found' - case (141_pInt) + case (141) msg = 'number of chunks in string differs' - case (142_pInt) + case (142) msg = 'empty list' - case (143_pInt) + case (143) msg = 'no value found for key' - case (144_pInt) + case (144) msg = 'negative number systems requested' - case (145_pInt) + case (145) msg = 'too many systems requested' - case (146_pInt) + case (146) msg = 'number of values does not match' - case (147_pInt) + case (147) msg = 'not supported anymore' !-------------------------------------------------------------------------------------------------- ! material error messages and related messages in mesh - case (150_pInt) + case (150) msg = 'index out of bounds' - case (151_pInt) + case (151) msg = 'microstructure has no constituents' - case (153_pInt) + case (153) msg = 'sum of phase fractions differs from 1' - case (154_pInt) + case (154) msg = 'homogenization index out of bounds' - case (155_pInt) + case (155) msg = 'microstructure index out of bounds' - case (156_pInt) + case (156) msg = 'reading from ODF file' - case (157_pInt) + case (157) msg = 'illegal texture transformation specified' - case (160_pInt) + case (160) msg = 'no entries in config part' - case (161_pInt) + case (161) msg = 'config part found twice' - case (165_pInt) + case (165) msg = 'homogenization configuration' - case (170_pInt) + case (170) msg = 'no homogenization specified via State Variable 2' - case (180_pInt) + case (180) msg = 'no microstructure specified via State Variable 3' - case (190_pInt) + case (190) msg = 'unknown element type:' - case (191_pInt) + case (191) msg = 'mesh consists of more than one element type' !-------------------------------------------------------------------------------------------------- ! plasticity error messages - case (200_pInt) + case (200) msg = 'unknown elasticity specified:' - case (201_pInt) + case (201) msg = 'unknown plasticity specified:' - case (210_pInt) + case (210) msg = 'unknown material parameter:' - case (211_pInt) + case (211) msg = 'material parameter out of bounds:' !-------------------------------------------------------------------------------------------------- ! numerics error messages - case (300_pInt) + case (300) msg = 'unknown numerics parameter:' - case (301_pInt) + case (301) msg = 'numerics parameter out of bounds:' !-------------------------------------------------------------------------------------------------- ! math errors - case (400_pInt) + case (400) msg = 'matrix inversion error' - case (401_pInt) + case (401) msg = 'math_check failed' - case (405_pInt) + case (405) msg = 'I_TO_HALTON-error: an input base BASE is <= 1' - case (406_pInt) + case (406) msg = 'Prime-error: N must be between 0 and PRIME_MAX' - case (407_pInt) + case (407) msg = 'Polar decomposition error' - case (409_pInt) + case (409) msg = 'math_check: R*v == q*v failed' - case (410_pInt) + case (410) msg = 'eigenvalues computation error' !------------------------------------------------------------------------------------------------- ! homogenization errors - case (500_pInt) + case (500) msg = 'unknown homogenization specified' !-------------------------------------------------------------------------------------------------- ! user errors - case (600_pInt) + case (600) msg = 'Ping-Pong not possible when using non-DAMASK elements' - case (601_pInt) + case (601) msg = 'Ping-Pong needed when using non-local plasticity' - case (602_pInt) + case (602) msg = 'invalid selection for debug' !------------------------------------------------------------------------------------------------- ! DAMASK_marc errors - case (700_pInt) + case (700) msg = 'invalid materialpoint result requested' !------------------------------------------------------------------------------------------------- ! errors related to the grid solver - case (809_pInt) + case (809) msg = 'initializing FFTW' - case (810_pInt) + case (810) msg = 'FFTW plan creation' - case (831_pInt) + case (831) msg = 'mask consistency violated in spectral loadcase' - case (832_pInt) + case (832) msg = 'ill-defined L (line partly defined) in spectral loadcase' - case (834_pInt) + case (834) msg = 'negative time increment in spectral loadcase' - case (835_pInt) + case (835) msg = 'non-positive increments in spectral loadcase' - case (836_pInt) + case (836) msg = 'non-positive result frequency in spectral loadcase' - case (837_pInt) + case (837) msg = 'incomplete loadcase' - case (838_pInt) + case (838) msg = 'mixed boundary conditions allow rotation' - case (841_pInt) + case (841) msg = 'missing header length info in spectral mesh' - case (842_pInt) + case (842) msg = 'incomplete information in spectral mesh header' - case (843_pInt) + case (843) msg = 'microstructure count mismatch' - case (846_pInt) + case (846) msg = 'rotation for load case rotation ill-defined (R:RT != I)' - case (880_pInt) + case (880) msg = 'mismatch of microstructure count and a*b*c in geom file' - case (891_pInt) + case (891) msg = 'unknown solver type selected' - case (892_pInt) + case (892) msg = 'unknown filter type selected' - case (893_pInt) + case (893) msg = 'PETSc: SNES_DIVERGED_FNORM_NAN' - case (894_pInt) + case (894) msg = 'MPI error' !------------------------------------------------------------------------------------------------- ! error messages related to parsing of Abaqus input file - case (900_pInt) + case (900) msg = 'improper definition of nodes in input file (Nnodes < 2)' - case (901_pInt) + case (901) msg = 'no elements defined in input file (Nelems = 0)' - case (902_pInt) + case (902) msg = 'no element sets defined in input file (No *Elset exists)' - case (903_pInt) + case (903) msg = 'no materials defined in input file (Look into section assigments)' - case (904_pInt) + case (904) msg = 'no elements could be assigned for Elset: ' - case (905_pInt) + case (905) msg = 'error in mesh_abaqus_map_materials' - case (906_pInt) + case (906) msg = 'error in mesh_abaqus_count_cpElements' - case (907_pInt) + case (907) msg = 'size of mesh_mapFEtoCPelem in mesh_abaqus_map_elements' - case (908_pInt) + case (908) msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes' - case (909_pInt) + case (909) msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' !------------------------------------------------------------------------------------------------- ! general error messages - case (666_pInt) + case (666) msg = 'memory leak detected' case default msg = 'unknown error number...' @@ -893,7 +880,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) write(0,'(a,69x,a)') ' │', '│' write(0,'(a)') ' └'//IO_DIVIDER//'┘' flush(0) - call quit(9000_pInt+error_ID) + call quit(9000+error_ID) !$OMP END CRITICAL (write2out) end subroutine IO_error @@ -905,55 +892,55 @@ end subroutine IO_error subroutine IO_warning(warning_ID,el,ip,g,ext_msg) implicit none - integer(pInt), intent(in) :: warning_ID - integer(pInt), optional, intent(in) :: el,ip,g + integer, intent(in) :: warning_ID + integer, optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg character(len=1024) :: msg character(len=1024) :: formatString select case (warning_ID) - case (1_pInt) + case (1) msg = 'unknown key' - case (34_pInt) + case (34) msg = 'invalid restart increment given' - case (35_pInt) + case (35) msg = 'could not get $DAMASK_NUM_THREADS' - case (40_pInt) + case (40) msg = 'found spectral solver parameter' - case (42_pInt) + case (42) msg = 'parameter has no effect' - case (43_pInt) + case (43) msg = 'main diagonal of C66 close to zero' - case (47_pInt) + case (47) msg = 'no valid parameter for FFTW, using FFTW_PATIENT' - case (50_pInt) + case (50) msg = 'not all available slip system families are defined' - case (51_pInt) + case (51) msg = 'not all available twin system families are defined' - case (52_pInt) + case (52) msg = 'not all available parameters are defined' - case (53_pInt) + case (53) msg = 'not all available transformation system families are defined' - case (101_pInt) + case (101) msg = 'crystallite debugging off' - case (201_pInt) + case (201) msg = 'position not found when parsing line' - case (202_pInt) + case (202) msg = 'invalid character in string chunk' - case (203_pInt) + case (203) msg = 'interpretation of string chunk failed' - case (207_pInt) + case (207) msg = 'line truncated' - case (600_pInt) + case (600) msg = 'crystallite responds elastically' - case (601_pInt) + case (601) msg = 'stiffness close to zero' - case (650_pInt) + case (650) msg = 'polar decomposition failed' - case (700_pInt) + case (700) msg = 'unknown crystal symmetry' - case (850_pInt) + case (850) msg = 'max number of cut back exceeded, terminating' case default msg = 'unknown warning number' @@ -1013,27 +1000,27 @@ end function IO_extractValue !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countDataLines(fileUnit) +integer function IO_countDataLines(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer, intent(in) :: fileUnit !< file handle - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp - IO_countDataLines = 0_pInt + IO_countDataLines = 0 line = '' do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + tmp = IO_lc(IO_stringValue(line,chunkPos,1)) if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword exit else - if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt + if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1 endif enddo backspace(fileUnit) @@ -1046,25 +1033,25 @@ end function IO_countDataLines !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countNumericalDataLines(fileUnit) +integer function IO_countNumericalDataLines(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer, intent(in) :: fileUnit !< file handle - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp - IO_countNumericalDataLines = 0_pInt + IO_countNumericalDataLines = 0 line = '' do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + tmp = IO_lc(IO_stringValue(line,chunkPos,1)) if (verify(trim(tmp),'0123456789') == 0) then ! numerical values - IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt + IO_countNumericalDataLines = IO_countNumericalDataLines + 1 else exit endif @@ -1080,18 +1067,18 @@ end function IO_countNumericalDataLines subroutine IO_skipChunks(fileUnit,N) implicit none - integer(pInt), intent(in) :: fileUnit, & !< file handle - N !< minimum number of chunks to skip + integer, intent(in) :: fileUnit, & !< file handle + N !< minimum number of chunks to skip - integer(pInt) :: remainingChunks - character(len=65536) :: line + integer :: remainingChunks + character(len=65536) :: line line = '' remainingChunks = N do while (trim(line) /= IO_EOF .and. remainingChunks > 0) line = IO_read(fileUnit) - remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt + remainingChunks = remainingChunks - (size(IO_stringPos(line))-1)/2 enddo end subroutine IO_skipChunks #endif @@ -1102,52 +1089,52 @@ end subroutine IO_skipChunks !> @details Marc: ints concatenated by "c" as last char or range of values a "to" b !> Abaqus: triplet of start,stop,inc !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countContinuousIntValues(fileUnit) +integer function IO_countContinuousIntValues(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit #ifdef Abaqus - integer(pInt) :: l,c + integer :: l,c #endif - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line - IO_countContinuousIntValues = 0_pInt + IO_countContinuousIntValues = 0 line = '' #if defined(Marc4DAMASK) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line + if (chunkPos(1) < 1) then ! empty line exit - elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - - IO_intValue(line,chunkPos,1_pInt)) + elseif (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to' ) then ! found range indicator + IO_countContinuousIntValues = 1 + abs( IO_intValue(line,chunkPos,3) & + - IO_intValue(line,chunkPos,1)) exit ! only one single range indicator allowed else - IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' + IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1 ! add line's count when assuming 'c' if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt + IO_countContinuousIntValues = IO_countContinuousIntValues+1 exit ! data ended endif endif enddo #elif defined(Abaqus) c = IO_countDataLines(fileUnit) - do l = 1_pInt,c + do l = 1,c backspace(fileUnit) enddo - l = 1_pInt + l = 1 do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? - l = l + 1_pInt + l = l + 1 line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation - (IO_intValue(line,chunkPos,2_pInt)-IO_intValue(line,chunkPos,1_pInt))/& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) + IO_countContinuousIntValues = IO_countContinuousIntValues + 1 + & ! assuming range generation + (IO_intValue(line,chunkPos,2)-IO_intValue(line,chunkPos,1))/& + max(1,IO_intValue(line,chunkPos,3)) enddo #endif @@ -1163,54 +1150,53 @@ end function IO_countContinuousIntValues function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) implicit none - integer(pInt), intent(in) :: maxN - integer(pInt), dimension(1+maxN) :: IO_continuousIntValues + integer, intent(in) :: maxN + integer, dimension(1+maxN) :: IO_continuousIntValues - integer(pInt), intent(in) :: fileUnit, & + integer, intent(in) :: fileUnit, & lookupMaxN - integer(pInt), dimension(:,:), intent(in) :: lookupMap + integer, dimension(:,:), intent(in) :: lookupMap character(len=64), dimension(:), intent(in) :: lookupName - integer(pInt) :: i,first,last + integer :: i,first,last #ifdef Abaqus - integer(pInt) :: j,l,c + integer :: j,l,c #endif - - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=65536) line logical rangeGeneration - IO_continuousIntValues = 0_pInt + IO_continuousIntValues = 0 rangeGeneration = .false. #if defined(Marc4DAMASK) do read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line + if (chunkPos(1) < 1) then ! empty line exit - elseif (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name - do i = 1_pInt, lookupMaxN ! loop over known set names - if (IO_stringValue(line,chunkPos,1_pInt) == lookupName(i)) then ! found matching name + elseif (verify(IO_stringValue(line,chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set name + do i = 1, lookupMaxN ! loop over known set names + if (IO_stringValue(line,chunkPos,1) == lookupName(i)) then ! found matching name IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list exit endif enddo exit - else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - first = IO_intValue(line,chunkPos,1_pInt) - last = IO_intValue(line,chunkPos,3_pInt) - do i = first, last, sign(1_pInt,last-first) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + else if (chunkPos(1) > 2 .and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'to' ) then ! found range indicator + first = IO_intValue(line,chunkPos,1) + last = IO_intValue(line,chunkPos,3) + do i = first, last, sign(1,last-first) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo exit else - do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + do i = 1,chunkPos(1)-1 ! interpret up to second to last value + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) enddo if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1)) exit endif @@ -1218,7 +1204,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) enddo #elif defined(Abaqus) c = IO_countDataLines(fileUnit) - do l = 1_pInt,c + do l = 1,c backspace(fileUnit) enddo @@ -1227,34 +1213,34 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) backspace(fileUnit) read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) - do i = 1_pInt,chunkPos(1) + do i = 1,chunkPos(1) if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. enddo - do l = 1_pInt,c + do l = 1,c read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) - if (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line - do i = 1_pInt,chunkPos(1) ! loop over set names in line - do j = 1_pInt,lookupMaxN ! look through known set names + if (verify(IO_stringValue(line,chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line + do i = 1,chunkPos(1) ! loop over set names in line + do j = 1,lookupMaxN ! look through known set names if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name - first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data - last = first + lookupMap(1,j) - 1_pInt ! up to where to append data + first = 2 + IO_continuousIntValues(1) ! where to start appending data + last = first + lookupMap(1,j) - 1 ! up to where to append data IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them endif enddo enddo else if (rangeGeneration) then ! range generation - do i = IO_intValue(line,chunkPos,1_pInt),& - IO_intValue(line,chunkPos,2_pInt),& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + do i = IO_intValue(line,chunkPos,1),& + IO_intValue(line,chunkPos,2),& + max(1,IO_intValue(line,chunkPos,3)) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo else ! read individual elem nums - do i = 1_pInt,chunkPos(1) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + do i = 1,chunkPos(1) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) enddo endif @@ -1270,7 +1256,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) !-------------------------------------------------------------------------------------------------- !> @brief returns verified integer value in given string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_verifyIntValue (string,validChars,myName) +integer function IO_verifyIntValue (string,validChars,myName) implicit none character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 1c4928fac..ab8b1644a 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -9,13 +9,13 @@ module damage_local implicit none private - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & damage_local_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & damage_local_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & + integer, dimension(:), allocatable, target, public :: & damage_local_Noutput !< number of outputs per instance of this damage enum, bind(c) @@ -64,9 +64,9 @@ subroutine damage_local_init implicit none - integer(pInt) :: maxNinstance,homog,instance,o,i - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog, h + integer :: maxNinstance,homog,instance,o,i + integer :: sizeState + integer :: NofMyHomog, h integer(kind(undefined_ID)) :: & outputID character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -76,13 +76,13 @@ subroutine damage_local_init write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) - if (maxNinstance == 0_pInt) return + if (maxNinstance == 0) return - allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance)) damage_local_output = '' allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(damage_local_Noutput (maxNinstance), source=0_pInt) + allocate(damage_local_Noutput (maxNinstance), source=0) allocate(param(maxNinstance)) @@ -116,7 +116,7 @@ subroutine damage_local_init ! allocate state arrays - sizeState = 1_pInt + sizeState = 1 damageState(homog)%sizeState = sizeState damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance)) allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) @@ -148,14 +148,14 @@ function damage_local_updateState(subdt, ip, el) damageState implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & subdt - logical, dimension(2) :: & + logical, dimension(2) :: & damage_local_updateState - integer(pInt) :: & + integer :: & homog, & offset real(pReal) :: & @@ -202,12 +202,12 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el source_damage_anisoductile_getRateAndItsTangent implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & phi - integer(pInt) :: & + integer :: & phase, & grain, & source, & @@ -260,26 +260,26 @@ function damage_local_postResults(ip,el) damage implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point el !< element real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & damage_local_postResults - integer(pInt) :: & + integer :: & instance, homog, offset, o, c homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) associate(prm => param(instance)) - c = 0_pInt + c = 0 - outputsLoop: do o = 1_pInt,size(prm%outputID) + outputsLoop: do o = 1,size(prm%outputID) select case(prm%outputID(o)) case (damage_ID) - damage_local_postResults(c+1_pInt) = damage(homog)%p(offset) + damage_local_postResults(c+1) = damage(homog)%p(offset) c = c + 1 end select enddo outputsLoop diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 3a2080e84..dc1036b67 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -4,19 +4,17 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module damage_nonlocal - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & damage_nonlocal_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & damage_nonlocal_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & + integer, dimension(:), allocatable, target, public :: & damage_nonlocal_Noutput !< number of outputs per instance of this damage enum, bind(c) @@ -64,10 +62,10 @@ subroutine damage_nonlocal_init implicit none - integer(pInt) :: maxNinstance,homog,instance,o,i - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog, h - integer(kind(undefined_ID)) :: & + integer :: maxNinstance,homog,instance,o,i + integer :: sizeState + integer :: NofMyHomog, h + integer(kind(undefined_ID)) :: & outputID character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] character(len=65536), dimension(:), allocatable :: & @@ -75,13 +73,13 @@ subroutine damage_nonlocal_init write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) - if (maxNinstance == 0_pInt) return + maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID)) + if (maxNinstance == 0) return - allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) damage_nonlocal_output = '' - allocate(damage_nonlocal_Noutput (maxNinstance), source=0_pInt) + allocate(damage_nonlocal_Noutput (maxNinstance), source=0) allocate(param(maxNinstance)) @@ -114,7 +112,7 @@ subroutine damage_nonlocal_init ! allocate state arrays - sizeState = 1_pInt + sizeState = 1 damageState(homog)%sizeState = sizeState damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance)) allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) @@ -155,12 +153,12 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, source_damage_anisoductile_getRateAndItsTangent implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & phi - integer(pInt) :: & + integer :: & phase, & grain, & source, & @@ -218,12 +216,12 @@ function damage_nonlocal_getDiffusion33(ip,el) crystallite_push33ToRef implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), dimension(3,3) :: & damage_nonlocal_getDiffusion33 - integer(pInt) :: & + integer :: & homog, & grain @@ -235,7 +233,7 @@ function damage_nonlocal_getDiffusion33(ip,el) enddo damage_nonlocal_getDiffusion33 = & - charLength**2_pInt*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) + charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) end function damage_nonlocal_getDiffusion33 @@ -252,10 +250,10 @@ real(pReal) function damage_nonlocal_getMobility(ip,el) homogenization_Ngrains implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number - integer(pInt) :: & + integer :: & ipc damage_nonlocal_getMobility = 0.0_pReal @@ -279,12 +277,12 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) damage implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & phi - integer(pInt) :: & + integer :: & homog, & offset @@ -305,26 +303,26 @@ function damage_nonlocal_postResults(ip,el) damage implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point el !< element real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & damage_nonlocal_postResults - integer(pInt) :: & + integer :: & instance, homog, offset, o, c homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) associate(prm => param(instance)) - c = 0_pInt + c = 0 - outputsLoop: do o = 1_pInt,size(prm%outputID) + outputsLoop: do o = 1,size(prm%outputID) select case(prm%outputID(o)) case (damage_ID) - damage_nonlocal_postResults(c+1_pInt) = damage(homog)%p(offset) + damage_nonlocal_postResults(c+1) = damage(homog)%p(offset) c = c + 1 end select enddo outputsLoop diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 2adf72f89..d006fc5c2 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -9,69 +9,19 @@ program DAMASK_spectral #include use PETScsys - use prec, only: & - pInt, & - pLongInt, & - pReal, & - tol_math_check, & - dNeq - use DAMASK_interface, only: & - DAMASK_interface_init, & - loadCaseFile, & - geometryFile, & - getSolverJobName, & - interface_restartInc - use IO, only: & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_error, & - IO_lc, & - IO_intOut, & - IO_warning - use config, only: & - config_numerics - use debug, only: & - debug_level, & - debug_spectral, & - debug_levelBasic - use math ! need to include the whole module for FFTW - use mesh, only: & - grid, & - geomSize - use CPFEM2, only: & - CPFEM_initAll, & - CPFEM_results - use FEsolving, only: & - restartWrite, & - restartInc - use numerics, only: & - worldrank, & - worldsize, & - stagItMax, & - maxCutBack, & - continueCalculation - use homogenization, only: & - materialpoint_sizeResults, & - materialpoint_results, & - materialpoint_postResults - use material, only: & - thermal_type, & - damage_type, & - THERMAL_conduction_ID, & - DAMAGE_nonlocal_ID - use spectral_utilities, only: & - utilities_init, & - tSolutionState, & - tLoadCase, & - cutBack, & - nActiveFields, & - FIELD_UNDEFINED_ID, & - FIELD_MECH_ID, & - FIELD_THERMAL_ID, & - FIELD_DAMAGE_ID + use prec + use DAMASK_interface + use IO + use config + use debug + use math + use mesh + use CPFEM2 + use FEsolving + use numerics + use homogenization + use material + use spectral_utilities use grid_mech_spectral_basic use grid_mech_spectral_polarisation use grid_mech_FEM @@ -86,11 +36,11 @@ program DAMASK_spectral ! variables related to information from load case and geom file real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - N_t = 0_pInt, & !< # of time indicators found in load case file - N_n = 0_pInt, & !< # of increment specifiers found in load case file - N_def = 0_pInt !< # of rate of deformation specifiers found in load case file + integer, allocatable, dimension(:) :: chunkPos + integer :: & + N_t = 0, & !< # of time indicators found in load case file + N_n = 0, & !< # of increment specifiers found in load case file + N_def = 0 !< # of rate of deformation specifiers found in load case file character(len=65536) :: & line @@ -99,8 +49,8 @@ program DAMASK_spectral real(pReal), dimension(3,3), parameter :: & ones = 1.0_pReal, & zeros = 0.0_pReal - integer(pInt), parameter :: & - subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0 + 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 @@ -110,21 +60,21 @@ program DAMASK_spectral logical :: & guess, & !< guess along former trajectory stagIterate - integer(pInt) :: & + integer :: & i, j, k, l, field, & - errorID = 0_pInt, & - cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ - stepFraction = 0_pInt !< fraction of current time interval - integer(pInt) :: & - currentLoadcase = 0_pInt, & !< current load case + errorID = 0, & + cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ + stepFraction = 0 !< fraction of current time interval + integer :: & + currentLoadcase = 0, & !< current load case inc, & !< current increment in current load case - totalIncsCounter = 0_pInt, & !< total # of increments - convergedCounter = 0_pInt, & !< # of converged increments - notConvergedCounter = 0_pInt, & !< # of non-converged increments - fileUnit = 0_pInt, & !< file unit for reading load case and writing results + totalIncsCounter = 0, & !< total # of increments + convergedCounter = 0, & !< # of converged increments + notConvergedCounter = 0, & !< # of non-converged increments + fileUnit = 0, & !< file unit for reading load case and writing results myStat, & - statUnit = 0_pInt, & !< file unit for statistics output - lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written + statUnit = 0, & !< file unit for statistics output + lastRestartWritten = 0, & !< total increment # at which last restart information was written stagIter character(len=6) :: loadcase_string character(len=1024) :: & @@ -134,8 +84,8 @@ program DAMASK_spectral type(tSolutionState), allocatable, dimension(:) :: solres integer(MPI_OFFSET_KIND) :: fileOffset integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize - integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 - integer(pInt), parameter :: maxRealOut = maxByteOut/pReal + integer, parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 + integer, parameter :: maxRealOut = maxByteOut/pReal integer(pLongInt), dimension(2) :: outputIndex PetscErrorCode :: ierr procedure(grid_mech_spectral_basic_init), pointer :: & @@ -174,20 +124,20 @@ program DAMASK_spectral case ('polarisation') if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') + call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_spectral_polarisation_init mech_forward => grid_mech_spectral_polarisation_forward mech_solution => grid_mech_spectral_polarisation_solution case ('fem') if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') + call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_FEM_init mech_forward => grid_mech_FEM_forward mech_solution => grid_mech_FEM_solution case default - call IO_error(error_ID = 891_pInt, ext_msg = config_numerics%getString('spectral_solver')) + call IO_error(error_ID = 891, ext_msg = config_numerics%getString('spectral_solver')) end select @@ -195,27 +145,27 @@ program DAMASK_spectral ! reading information from load case file and to sanity checks allocate (loadCases(0)) ! array of load cases open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile)) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=trim(loadCaseFile)) do read(fileUnit, '(A)', iostat=myStat) line - if ( myStat /= 0_pInt) exit + if ( myStat /= 0) exit if (IO_isBlank(line)) cycle ! skip empty lines - currentLoadCase = currentLoadCase + 1_pInt + currentLoadCase = currentLoadCase + 1 chunkPos = IO_stringPos(line) - do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase + do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f') - N_def = N_def + 1_pInt + N_def = N_def + 1 case('t','time','delta') - N_t = N_t + 1_pInt + N_t = N_t + 1 case('n','incs','increments','steps','logincs','logincrements','logsteps') - N_n = N_n + 1_pInt + N_n = N_n + 1 end select enddo - if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check - call IO_error(error_ID=837_pInt,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase + if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1) & ! sanity check + call IO_error(error_ID=837,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase newLoadCase%stress%myType='stress' field = 1 @@ -229,7 +179,7 @@ program DAMASK_spectral newLoadCase%ID(field) = FIELD_DAMAGE_ID endif damageActive - readIn: do i = 1_pInt, chunkPos(1) + readIn: do i = 1, chunkPos(1) select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix temp_valueVector = 0.0_pReal @@ -241,7 +191,7 @@ program DAMASK_spectral else newLoadCase%deformation%myType = 'l' endif - do j = 1_pInt, 9_pInt + do j = 1, 9 temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a * if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo @@ -250,7 +200,7 @@ program DAMASK_spectral newLoadCase%deformation%values = math_9to33(temp_valueVector) ! values in 3x3 notation case('p','pk1','piolakirchhoff','stress', 's') temp_valueVector = 0.0_pReal - do j = 1_pInt, 9_pInt + do j = 1, 9 temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo @@ -258,54 +208,54 @@ program DAMASK_spectral newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical) newLoadCase%stress%values = math_9to33(temp_valueVector) case('t','time','delta') ! increment time - newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt) + newLoadCase%time = IO_floatValue(line,chunkPos,i+1) case('n','incs','increments','steps') ! number of increments - newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%incs = IO_intValue(line,chunkPos,i+1) case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) - newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) - newLoadCase%logscale = 1_pInt + newLoadCase%incs = IO_intValue(line,chunkPos,i+1) + newLoadCase%logscale = 1 case('freq','frequency','outputfreq') ! frequency of result writings - newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1) case('r','restart','restartwrite') ! frequency of writing restart information newLoadCase%restartfrequency = & - max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) + max(0,IO_intValue(line,chunkPos,i+1)) case('guessreset','dropguessing') newLoadCase%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory case('euler') ! rotation of load case given in euler angles temp_valueVector = 0.0_pReal - l = 1_pInt ! assuming values given in degrees - k = 1_pInt ! assuming keyword indicating degree/radians present - select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt))) + l = 1 ! assuming values given in degrees + k = 1 ! assuming keyword indicating degree/radians present + select case (IO_lc(IO_stringValue(line,chunkPos,i+1))) case('deg','degree') case('rad','radian') ! don't convert from degree to radian - l = 0_pInt + l = 0 case default - k = 0_pInt + k = 0 end select - do j = 1_pInt, 3_pInt + do j = 1, 3 temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j) enddo - if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad + if (l == 1) temp_valueVector(1:3) = temp_valueVector(1:3) * INRAD ! convert to rad newLoadCase%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix case('rotation','rot') ! assign values for the rotation matrix temp_valueVector = 0.0_pReal - do j = 1_pInt, 9_pInt + do j = 1, 9 temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) enddo newLoadCase%rotation = math_9to33(temp_valueVector) end select enddo readIn - newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt) ! by default, guess from previous load case + newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1) ! by default, guess from previous load case reportAndCheck: if (worldrank == 0) then write (loadcase_string, '(i6)' ) currentLoadCase write(6,'(/,1x,a,i6)') 'load case: ', currentLoadCase if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory' if (newLoadCase%deformation%myType == 'l') then - do j = 1_pInt, 3_pInt + do j = 1, 3 if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & - any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt ! each row should be either fully or not at all defined + any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832 ! each row should be either fully or not at all defined enddo write(6,'(2x,a)') 'velocity gradient:' else if (newLoadCase%deformation%myType == 'f') then @@ -313,7 +263,7 @@ program DAMASK_spectral else write(6,'(2x,a)') 'deformation gradient rate:' endif - do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt + do i = 1, 3; do j = 1, 3 if(newLoadCase%deformation%maskLogical(i,j)) then write(6,'(2x,f12.7)',advance='no') newLoadCase%deformation%values(i,j) else @@ -322,13 +272,13 @@ program DAMASK_spectral enddo; write(6,'(/)',advance='no') enddo if (any(newLoadCase%stress%maskLogical .eqv. & - newLoadCase%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only + newLoadCase%deformation%maskLogical)) errorID = 831 ! exclusive or masking only if (any(newLoadCase%stress%maskLogical .and. & transpose(newLoadCase%stress%maskLogical) .and. & reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & - errorID = 838_pInt ! no rotation is allowed by stress BC + errorID = 838 ! no rotation is allowed by stress BC write(6,'(2x,a)') 'stress / GPa:' - do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt + do i = 1, 3; do j = 1, 3 if(newLoadCase%stress%maskLogical(i,j)) then write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal else @@ -340,18 +290,18 @@ program DAMASK_spectral transpose(newLoadCase%rotation))-math_I3) > & reshape(spread(tol_math_check,1,9),[ 3,3]))& .or. abs(math_det33(newLoadCase%rotation)) > & - 1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain + 1.0_pReal + tol_math_check) errorID = 846 ! given rotation matrix contains strain if (any(dNeq(newLoadCase%rotation, math_I3))) & write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& transpose(newLoadCase%rotation) - if (newLoadCase%time < 0.0_pReal) errorID = 834_pInt ! negative time increment + if (newLoadCase%time < 0.0_pReal) errorID = 834 ! negative time increment write(6,'(2x,a,f12.6)') 'time: ', newLoadCase%time - if (newLoadCase%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count + if (newLoadCase%incs < 1) errorID = 835 ! non-positive incs count write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs - if (newLoadCase%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency + if (newLoadCase%outputfrequency < 1) errorID = 836 ! non-positive result frequency write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency write(6,'(2x,a,i5)') 'restart frequency: ', newLoadCase%restartfrequency - if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message + if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message endif reportAndCheck loadCases = [loadCases,newLoadCase] ! load case is ok, append it enddo @@ -383,7 +333,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! write header of output file if (worldrank == 0) then - writeHeader: if (interface_restartInc < 1_pInt) then + writeHeader: if (interface_restartInc < 1) then open(newunit=fileUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header @@ -417,59 +367,59 @@ program DAMASK_spectral allocate(outputSize(worldsize), source = 0_MPI_OFFSET_KIND) outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND) call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_allreduce') call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', & MPI_MODE_WRONLY + MPI_MODE_APPEND, & MPI_INFO_NULL, & fileUnit, & ierr) - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open') - call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_open') + call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_get_position') fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me) call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_seek') - writeUndeformed: if (interface_restartInc < 1_pInt) then + writeUndeformed: if (interface_restartInc < 1) then write(6,'(1/,a)') ' ... writing initial configuration to file ........................' - call CPFEM_results(0_pInt,0.0_pReal) + call CPFEM_results(0,0.0_pReal) do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output - outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? + outputIndex = int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), & MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position endif writeUndeformed - loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) + loadCaseLooping: do currentLoadCase = 1, size(loadCases) time0 = time ! load case start time guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc - incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs - totalIncsCounter = totalIncsCounter + 1_pInt + incLooping: do inc = 1, loadCases(currentLoadCase)%incs + totalIncsCounter = totalIncsCounter + 1 !-------------------------------------------------------------------------------------------------- ! forwarding time timeIncOld = timeinc ! last timeinc that brought former inc to an end - if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale + if (loadCases(currentLoadCase)%logscale == 0) then ! linear scale timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) else - if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale - if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale - timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd + if (currentLoadCase == 1) then ! 1st load case of logarithmic scale + if (inc == 1) then ! 1st inc of 1st load case of logarithmic scale + timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd else ! not-1st inc of 1st load case of logarithmic scale - timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal)) + timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal)) endif else ! not-1st load case of logarithmic scale timeinc = time0 * & ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/& real(loadCases(currentLoadCase)%incs ,pReal))& - -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt ,pReal)/& + -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1 ,pReal)/& real(loadCases(currentLoadCase)%incs ,pReal))) endif endif @@ -479,12 +429,12 @@ program DAMASK_spectral time = time + timeinc ! just advance time, skip already performed calculation guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference else skipping - stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel + stepFraction = 0 ! fraction scaled by stepFactor**cutLevel subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel) remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time time = time + timeinc ! forward target time - stepFraction = stepFraction + 1_pInt ! count step + stepFraction = stepFraction + 1 ! count step !-------------------------------------------------------------------------------------------------- ! report begin of new step @@ -524,7 +474,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! solve fields - stagIter = 0_pInt + stagIter = 0 stagIterate = .true. do while (stagIterate) do field = 1, nActiveFields @@ -546,7 +496,7 @@ program DAMASK_spectral if (.not. solres(field)%converged) exit ! no solution found enddo - stagIter = stagIter + 1_pInt + stagIter = stagIter + 1 stagIterate = stagIter < stagItMax & .and. all(solres(:)%converged) & .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration @@ -567,52 +517,52 @@ program DAMASK_spectral endif elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? cutBack = .true. - stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator - cutBackLevel = cutBackLevel + 1_pInt + stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator + cutBackLevel = cutBackLevel + 1 time = time - timeinc ! rewind time timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep write(6,'(/,a)') ' cutting back ' else ! no more options to continue - call IO_warning(850_pInt) + call IO_warning(850) call MPI_file_close(fileUnit,ierr) close(statUnit) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written + call quit(-1*(lastRestartWritten+1)) ! quit and provide information about last restart inc written endif enddo subStepLooping - cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc + cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc if (all(solres(:)%converged)) then - convergedCounter = convergedCounter + 1_pInt + convergedCounter = convergedCounter + 1 write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc ' increment ', totalIncsCounter, ' converged' else - notConvergedCounter = notConvergedCounter + 1_pInt + notConvergedCounter = notConvergedCounter + 1 write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc ' increment ', totalIncsCounter, ' NOT converged' endif; flush(6) - if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency write(6,'(1/,a)') ' ... writing results to file ......................................' flush(6) call materialpoint_postResults() call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) - if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') + if (ierr /= 0) call IO_error(894, ext_msg='MPI_file_seek') do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output - outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & + outputIndex=int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),& MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') + if(ierr /=0) call IO_error(894, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position call CPFEM_results(totalIncsCounter,time) endif - if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... - .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information + if ( loadCases(currentLoadCase)%restartFrequency > 0 & ! writing of restart info requested ... + .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! ... and at frequency of writing restart information restartWrite = .true. ! set restart parameter for FEsolving lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? endif @@ -636,7 +586,7 @@ program DAMASK_spectral call MPI_file_close(fileUnit,ierr) close(statUnit) - if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged - call quit(0_pInt) ! no complains ;) + if (notConvergedCounter > 0) call quit(2) ! error if some are not converged + call quit(0) ! no complains ;) end program DAMASK_spectral diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 379327981..2ce058c19 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -5,18 +5,16 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_cleavage_opening - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, private :: kinematics_cleavage_opening_instance + integer, dimension(:), allocatable, private :: kinematics_cleavage_opening_instance type, private :: tParameters !< container type for internal constitutive parameters - integer(pInt) :: & + integer :: & totalNcleavage - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & Ncleavage !< active number of cleavage systems per family real(pReal) :: & sdot0, & @@ -27,17 +25,17 @@ module kinematics_cleavage_opening end type ! Begin Deprecated - integer(pInt), dimension(:), allocatable, private :: & - kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems + integer, dimension(:), allocatable, private :: & + kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems - integer(pInt), dimension(:,:), allocatable, private :: & - kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family + integer, dimension(:,:), allocatable, private :: & + kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family - real(pReal), dimension(:), allocatable, private :: & + real(pReal), dimension(:), allocatable, private :: & kinematics_cleavage_opening_sdot_0, & kinematics_cleavage_opening_N - real(pReal), dimension(:,:), allocatable, private :: & + real(pReal), dimension(:,:), allocatable, private :: & kinematics_cleavage_opening_critDisp, & kinematics_cleavage_opening_critLoad ! End Deprecated @@ -71,32 +69,32 @@ subroutine kinematics_cleavage_opening_init() lattice_NcleavageSystem implicit none - integer(pInt), allocatable, dimension(:) :: tempInt + integer, allocatable, dimension(:) :: tempInt real(pReal), allocatable, dimension(:) :: tempFloat - integer(pInt) :: maxNinstance,p,instance,kinematics + integer :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) - if (maxNinstance == 0_pInt) return + maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID)) + if (maxNinstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0_pInt) - do p = 1_pInt, size(config_phase) + allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) + do p = 1, size(config_phase) kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct? enddo allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt) - allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0_pInt) + allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0) + allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0) allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) - do p = 1_pInt, size(config_phase) + do p = 1, size(config_phase) if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle instance = kinematics_cleavage_opening_instance(p) kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0') @@ -115,13 +113,13 @@ subroutine kinematics_cleavage_opening_init() kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') enddo end subroutine kinematics_cleavage_opening_init @@ -130,8 +128,6 @@ end subroutine kinematics_cleavage_opening_init !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - use prec, only: & - tol_math_check use math, only: & math_mul33xx33 use material, only: & @@ -145,7 +141,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i lattice_NcleavageSystem implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< grain number ip, & !< integration point number el !< element number @@ -155,7 +151,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) - integer(pInt) :: & + integer :: & instance, phase, & homog, damageOffset, & f, i, index_myFamily, k, l, m, n @@ -170,9 +166,9 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = 0.0_pReal dLd_dTstar = 0.0_pReal - do f = 1_pInt,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) @@ -186,7 +182,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase) dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_d) - traction_crit) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & lattice_Scleavage(m,n,1,index_myFamily+i,phase) @@ -200,7 +196,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase) dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_t) - traction_crit) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & lattice_Scleavage(m,n,2,index_myFamily+i,phase) @@ -214,7 +210,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase) dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_n) - traction_crit) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & lattice_Scleavage(m,n,3,index_myFamily+i,phase) diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 880df3dcc..7a0b2fe99 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -5,18 +5,16 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_slipplane_opening - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, private :: kinematics_slipplane_opening_instance + integer, dimension(:), allocatable, private :: kinematics_slipplane_opening_instance type, private :: tParameters !< container type for internal constitutive parameters - integer(pInt) :: & + integer :: & totalNslip - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & Nslip !< active number of slip systems per family real(pReal) :: & sdot0, & @@ -58,26 +56,25 @@ subroutine kinematics_slipplane_opening_init() KINEMATICS_slipplane_opening_ID use lattice - implicit none - integer(pInt) :: maxNinstance,p,instance,kinematics + integer :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID) if (maxNinstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0_pInt) - do p = 1_pInt, size(config_phase) + allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0) + do p = 1, size(config_phase) kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct? enddo allocate(param(maxNinstance)) - do p = 1_pInt, size(config_phase) + do p = 1, size(config_phase) if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle associate(prm => param(kinematics_slipplane_opening_instance(p)), & config => config_phase(p)) @@ -91,19 +88,19 @@ subroutine kinematics_slipplane_opening_init() prm%critLoad = math_expand(prm%critLoad, prm%Nslip) -prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& + prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& + prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& + prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) ! if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') + ! call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') ! if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) & - ! call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') + ! call IO_error(211,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') ! if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') + ! call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') end associate enddo @@ -114,8 +111,6 @@ end subroutine kinematics_slipplane_opening_init !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - use prec, only: & - tol_math_check use math, only: & math_mul33xx33, & math_outer @@ -125,7 +120,6 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, damage, & damageMapping - implicit none integer, intent(in) :: & ipc, & !< grain number ip, & !< integration point number @@ -173,7 +167,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, if (abs(udotd) > tol_math_check) then Ld = Ld + udotd*projection_d dudotd_dt = udotd*prm%n/traction_d - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*projection_d(k,l)*projection_d(m,n) endif @@ -185,7 +179,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, if (abs(udott) > tol_math_check) then Ld = Ld + udott*projection_t dudott_dt = udott*prm%n/traction_t - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*projection_t(k,l)*projection_t(m,n) endif @@ -197,7 +191,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, if (abs(udotn) > tol_math_check) then Ld = Ld + udotn*projection_n dudotn_dt = udotn*prm%n/traction_n - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*projection_n(k,l)*projection_n(m,n) endif diff --git a/src/material.f90 b/src/material.f90 index bb8d6dbff..fd8f52ba9 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -98,10 +98,10 @@ module material integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & homogenization_type !< type of each homogenization - integer(pInt), public, protected :: & + integer, public, protected :: & homogenization_maxNgrains !< max number of grains in any USED homogenization - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & phase_Nsources, & !< number of source mechanisms active in each phase phase_Nkinematics, & !< number of kinematic mechanisms active in each phase phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase @@ -132,7 +132,7 @@ module material ! END NEW MAPPINGS ! DEPRECATED: use material_phaseAt - integer(pInt), dimension(:,:,:), allocatable, public :: & + integer, dimension(:,:,:), allocatable, public :: & material_phase !< phase (index) of each grain,IP,element type(tPlasticState), allocatable, dimension(:), public :: & @@ -144,7 +144,7 @@ module material thermalState, & damageState - integer(pInt), dimension(:,:,:), allocatable, public, protected :: & + integer, dimension(:,:,:), allocatable, public, protected :: & material_texture !< texture (index) of each grain,IP,element real(pReal), dimension(:,:,:,:), allocatable, public, protected :: & @@ -155,15 +155,15 @@ module material microstructure_elemhomo, & !< flag to indicate homogeneous microstructure distribution over element's IPs phase_localPlasticity !< flags phases with local constitutive law - integer(pInt), private :: & + integer, private :: & microstructure_maxNconstituents, & !< max number of constituents in any phase texture_maxNgauss !< max number of Gauss components in any texture - integer(pInt), dimension(:), allocatable, private :: & + integer, dimension(:), allocatable, private :: & microstructure_Nconstituents, & !< number of constituents in each microstructure texture_Ngauss !< number of Gauss components per texture - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & microstructure_phase, & !< phase IDs of each microstructure microstructure_texture !< texture IDs of each microstructure @@ -178,11 +178,11 @@ module material homogenization_active ! BEGIN DEPRECATED - integer(pInt), dimension(:,:,:), allocatable, public :: phaseAt !< phase ID of every material point (ipc,ip,el) - integer(pInt), dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el) + integer, dimension(:,:,:), allocatable, public :: phaseAt !< phase ID of every material point (ipc,ip,el) + integer, dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el) - integer(pInt), dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field - integer(pInt), dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field + integer, dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field + integer, dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field ! END DEPRECATED type(tHomogMapping), allocatable, dimension(:), public :: & @@ -256,13 +256,13 @@ subroutine material_init use mesh, only: & theMesh - integer(pInt), parameter :: FILEUNIT = 210_pInt - integer(pInt) :: m,c,h, myDebug, myPhase, myHomog - integer(pInt) :: & + integer, parameter :: FILEUNIT = 210 + integer :: m,c,h, myDebug, myPhase, myHomog + integer :: & g, & !< grain number i, & !< integration point number e !< element number - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & CounterPhase, & CounterHomogenization @@ -271,19 +271,19 @@ subroutine material_init write(6,'(/,a)') ' <<<+- material init -+>>>' call material_parsePhase() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6) call material_parseMicrostructure() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6) call material_parseCrystallite() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6) call material_parseHomogenization() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6) call material_parseTexture() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6) allocate(plasticState (size(config_phase))) allocate(sourceState (size(config_phase))) @@ -303,34 +303,34 @@ subroutine material_init allocate(temperatureRate (size(config_homogenization))) - do m = 1_pInt,size(config_microstructure) - if(microstructure_crystallite(m) < 1_pInt .or. & + do m = 1,size(config_microstructure) + if(microstructure_crystallite(m) < 1 .or. & microstructure_crystallite(m) > size(config_crystallite)) & - call IO_error(150_pInt,m,ext_msg='crystallite') - if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & + call IO_error(150,m,ext_msg='crystallite') + if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1 .or. & maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) & - call IO_error(150_pInt,m,ext_msg='phase') - if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & + call IO_error(150,m,ext_msg='phase') + if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1 .or. & maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(config_texture)) & - call IO_error(150_pInt,m,ext_msg='texture') - if(microstructure_Nconstituents(m) < 1_pInt) & - call IO_error(151_pInt,m) + call IO_error(150,m,ext_msg='texture') + if(microstructure_Nconstituents(m) < 1) & + call IO_error(151,m) enddo - debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then + debugOut: if (iand(myDebug,debug_levelExtensive) /= 0) then write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' - do h = 1_pInt,size(config_homogenization) + do h = 1,size(config_homogenization) write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h) enddo write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous' - do m = 1_pInt,size(config_microstructure) + do m = 1,size(config_microstructure) write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), & microstructure_crystallite(m), & microstructure_Nconstituents(m), & microstructure_elemhomo(m) - if (microstructure_Nconstituents(m) > 0_pInt) then - do c = 1_pInt,microstructure_Nconstituents(m) + if (microstructure_Nconstituents(m) > 0) then + do c = 1,microstructure_Nconstituents(m) write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),& texture_name(microstructure_texture(c,m)),& microstructure_fraction(c,m) @@ -383,23 +383,23 @@ subroutine material_init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BEGIN DEPRECATED - allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) - allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) - allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) - allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt) + allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0) + allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0) + allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0) + allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1) CounterHomogenization=0 CounterPhase =0 - do e = 1_pInt,theMesh%Nelems + do e = 1,theMesh%Nelems myHomog = theMesh%homogenizationAt(e) - do i = 1_pInt, theMesh%elem%nIPs - CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt + do i = 1, theMesh%elem%nIPs + CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1 mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)] - do g = 1_pInt,homogenization_Ngrains(myHomog) + do g = 1,homogenization_Ngrains(myHomog) myPhase = material_phase(g,i,e) - CounterPhase(myPhase) = CounterPhase(myPhase)+1_pInt ! not distinguishing between instances of same phase + CounterPhase(myPhase) = CounterPhase(myPhase)+1 ! not distinguishing between instances of same phase phaseAt(g,i,e) = myPhase phasememberAt(g,i,e) = CounterPhase(myPhase) enddo @@ -429,33 +429,33 @@ subroutine material_parseHomogenization use IO, only: & IO_error - integer(pInt) :: h + integer :: h character(len=65536) :: tag allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID) allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID) allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID) - allocate(homogenization_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(thermal_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(damage_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(homogenization_Ngrains(size(config_homogenization)), source=0_pInt) - allocate(homogenization_Noutput(size(config_homogenization)), source=0_pInt) + allocate(homogenization_typeInstance(size(config_homogenization)), source=0) + allocate(thermal_typeInstance(size(config_homogenization)), source=0) + allocate(damage_typeInstance(size(config_homogenization)), source=0) + allocate(homogenization_Ngrains(size(config_homogenization)), source=0) + allocate(homogenization_Noutput(size(config_homogenization)), source=0) allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!! allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal) allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) - forall (h = 1_pInt:size(config_homogenization)) & + forall (h = 1:size(config_homogenization)) & homogenization_active(h) = any(theMesh%homogenizationAt == h) - do h=1_pInt, size(config_homogenization) + do h=1, size(config_homogenization) homogenization_Noutput(h) = config_homogenization(h)%countKeys('(output)') tag = config_homogenization(h)%getString('mech') select case (trim(tag)) case(HOMOGENIZATION_NONE_label) homogenization_type(h) = HOMOGENIZATION_NONE_ID - homogenization_Ngrains(h) = 1_pInt + homogenization_Ngrains(h) = 1 case(HOMOGENIZATION_ISOSTRAIN_label) homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') @@ -463,7 +463,7 @@ subroutine material_parseHomogenization homogenization_type(h) = HOMOGENIZATION_RGC_ID homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') case default - call IO_error(500_pInt,ext_msg=trim(tag)) + call IO_error(500,ext_msg=trim(tag)) end select homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) @@ -480,7 +480,7 @@ subroutine material_parseHomogenization case(THERMAL_conduction_label) thermal_type(h) = THERMAL_conduction_ID case default - call IO_error(500_pInt,ext_msg=trim(tag)) + call IO_error(500,ext_msg=trim(tag)) end select endif @@ -497,14 +497,14 @@ subroutine material_parseHomogenization case(DAMAGE_NONLOCAL_label) damage_type(h) = DAMAGE_nonlocal_ID case default - call IO_error(500_pInt,ext_msg=trim(tag)) + call IO_error(500,ext_msg=trim(tag)) end select endif enddo - do h=1_pInt, size(config_homogenization) + do h=1, size(config_homogenization) homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) @@ -530,58 +530,58 @@ subroutine material_parseMicrostructure character(len=65536), dimension(:), allocatable :: & strings - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: e, m, c, i + integer, allocatable, dimension(:) :: chunkPos + integer :: e, m, c, i character(len=65536) :: & tag - allocate(microstructure_crystallite(size(config_microstructure)), source=0_pInt) - allocate(microstructure_Nconstituents(size(config_microstructure)), source=0_pInt) + allocate(microstructure_crystallite(size(config_microstructure)), source=0) + allocate(microstructure_Nconstituents(size(config_microstructure)), source=0) allocate(microstructure_active(size(config_microstructure)), source=.false.) allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.) if(any(theMesh%microstructureAt > size(config_microstructure))) & - call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') + call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config') - forall (e = 1_pInt:theMesh%Nelems) & + forall (e = 1:theMesh%Nelems) & microstructure_active(theMesh%microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements - do m=1_pInt, size(config_microstructure) + do m=1, size(config_microstructure) microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite') microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/') enddo microstructure_maxNconstituents = maxval(microstructure_Nconstituents) - allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) - allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) + allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0) + allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0) allocate(microstructure_fraction(microstructure_maxNconstituents,size(config_microstructure)),source=0.0_pReal) allocate(strings(1)) ! Intel 16.0 Bug - do m=1_pInt, size(config_microstructure) + do m=1, size(config_microstructure) strings = config_microstructure(m)%getStrings('(constituent)',raw=.true.) - do c = 1_pInt, size(strings) + do c = 1, size(strings) chunkPos = IO_stringPos(strings(c)) - do i = 1_pInt,5_pInt,2_pInt + do i = 1,5,2 tag = IO_stringValue(strings(c),chunkPos,i) select case (tag) case('phase') - microstructure_phase(c,m) = IO_intValue(strings(c),chunkPos,i+1_pInt) + microstructure_phase(c,m) = IO_intValue(strings(c),chunkPos,i+1) case('texture') - microstructure_texture(c,m) = IO_intValue(strings(c),chunkPos,i+1_pInt) + microstructure_texture(c,m) = IO_intValue(strings(c),chunkPos,i+1) case('fraction') - microstructure_fraction(c,m) = IO_floatValue(strings(c),chunkPos,i+1_pInt) + microstructure_fraction(c,m) = IO_floatValue(strings(c),chunkPos,i+1) end select enddo enddo enddo - do m = 1_pInt, size(config_microstructure) + do m = 1, size(config_microstructure) if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & - call IO_error(153_pInt,ext_msg=microstructure_name(m)) + call IO_error(153,ext_msg=microstructure_name(m)) enddo end subroutine material_parseMicrostructure @@ -592,10 +592,10 @@ end subroutine material_parseMicrostructure !-------------------------------------------------------------------------------------------------- subroutine material_parseCrystallite - integer(pInt) :: c + integer :: c - allocate(crystallite_Noutput(size(config_crystallite)),source=0_pInt) - do c=1_pInt, size(config_crystallite) + allocate(crystallite_Noutput(size(config_crystallite)),source=0) + do c=1, size(config_crystallite) crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)') enddo @@ -611,19 +611,19 @@ subroutine material_parsePhase IO_getTag, & IO_stringValue - integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p + integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536), dimension(:), allocatable :: str allocate(phase_elasticity(size(config_phase)),source=ELASTICITY_undefined_ID) allocate(phase_plasticity(size(config_phase)),source=PLASTICITY_undefined_ID) - allocate(phase_Nsources(size(config_phase)), source=0_pInt) - allocate(phase_Nkinematics(size(config_phase)), source=0_pInt) - allocate(phase_NstiffnessDegradations(size(config_phase)),source=0_pInt) - allocate(phase_Noutput(size(config_phase)), source=0_pInt) + allocate(phase_Nsources(size(config_phase)), source=0) + allocate(phase_Nkinematics(size(config_phase)), source=0) + allocate(phase_NstiffnessDegradations(size(config_phase)),source=0) + allocate(phase_Noutput(size(config_phase)), source=0) allocate(phase_localPlasticity(size(config_phase)), source=.false.) - do p=1_pInt, size(config_phase) + do p=1, size(config_phase) phase_Noutput(p) = config_phase(p)%countKeys('(output)') phase_Nsources(p) = config_phase(p)%countKeys('(source)') phase_Nkinematics(p) = config_phase(p)%countKeys('(kinematics)') @@ -634,7 +634,7 @@ subroutine material_parsePhase case (ELASTICITY_HOOKE_label) phase_elasticity(p) = ELASTICITY_HOOKE_ID case default - call IO_error(200_pInt,ext_msg=trim(config_phase(p)%getString('elasticity'))) + call IO_error(200,ext_msg=trim(config_phase(p)%getString('elasticity'))) end select select case (config_phase(p)%getString('plasticity')) @@ -653,7 +653,7 @@ subroutine material_parsePhase case (PLASTICITY_NONLOCAL_label) phase_plasticity(p) = PLASTICITY_NONLOCAL_ID case default - call IO_error(201_pInt,ext_msg=trim(config_phase(p)%getString('plasticity'))) + call IO_error(201,ext_msg=trim(config_phase(p)%getString('plasticity'))) end select enddo @@ -662,7 +662,7 @@ subroutine material_parsePhase allocate(phase_kinematics(maxval(phase_Nkinematics),size(config_phase)), source=KINEMATICS_undefined_ID) allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), & source=STIFFNESS_DEGRADATION_undefined_ID) - do p=1_pInt, size(config_phase) + do p=1, size(config_phase) #if defined(__GFORTRAN__) || defined(__PGI) str = ['GfortranBug86277'] str = config_phase(p)%getStrings('(source)',defaultVal=str) @@ -670,7 +670,7 @@ subroutine material_parsePhase #else str = config_phase(p)%getStrings('(source)',defaultVal=[character(len=65536)::]) #endif - do sourceCtr = 1_pInt, size(str) + do sourceCtr = 1, size(str) select case (trim(str(sourceCtr))) case (SOURCE_thermal_dissipation_label) phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID @@ -694,7 +694,7 @@ subroutine material_parsePhase #else str = config_phase(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::]) #endif - do kinematicsCtr = 1_pInt, size(str) + do kinematicsCtr = 1, size(str) select case (trim(str(kinematicsCtr))) case (KINEMATICS_cleavage_opening_label) phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID @@ -711,7 +711,7 @@ subroutine material_parsePhase #else str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::]) #endif - do stiffDegradationCtr = 1_pInt, size(str) + do stiffDegradationCtr = 1, size(str) select case (trim(str(stiffDegradationCtr))) case (STIFFNESS_DEGRADATION_damage_label) phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID @@ -719,10 +719,10 @@ subroutine material_parsePhase enddo enddo - allocate(phase_plasticityInstance(size(config_phase)), source=0_pInt) - allocate(phase_elasticityInstance(size(config_phase)), source=0_pInt) + allocate(phase_plasticityInstance(size(config_phase)), source=0) + allocate(phase_elasticityInstance(size(config_phase)), source=0) - do p=1_pInt, size(config_phase) + do p=1, size(config_phase) phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo @@ -739,13 +739,13 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue - integer(pInt) :: section, gauss, j, t, i + integer :: section, gauss, j, t, i character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config - integer(pInt), dimension(:), allocatable :: chunkPos + integer, dimension(:), allocatable :: chunkPos - allocate(texture_Ngauss(size(config_texture)), source=0_pInt) + allocate(texture_Ngauss(size(config_texture)), source=0) - do t=1_pInt, size(config_texture) + do t=1, size(config_texture) texture_Ngauss(t) = config_texture(t)%countKeys('(gauss)') if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry') if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)') @@ -757,13 +757,13 @@ subroutine material_parseTexture allocate(texture_transformation(3,3,size(config_texture)), source=0.0_pReal) texture_transformation = spread(math_I3,3,size(config_texture)) - do t=1_pInt, size(config_texture) + do t=1, size(config_texture) section = t - gauss = 0_pInt + gauss = 0 if (config_texture(t)%keyExists('axes')) then strings = config_texture(t)%getStrings('axes') - do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries + do j = 1, 3 ! look for "x", "y", and "z" entries select case (strings(j)) case('x', '+x') texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis @@ -778,25 +778,25 @@ subroutine material_parseTexture case('-z') texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis case default - call IO_error(157_pInt,t) + call IO_error(157,t) end select enddo - if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t) + if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157,t) endif if (config_texture(t)%keyExists('(gauss)')) then - gauss = gauss + 1_pInt + gauss = gauss + 1 strings = config_texture(t)%getStrings('(gauss)',raw= .true.) - do i = 1_pInt , size(strings) + do i = 1 , size(strings) chunkPos = IO_stringPos(strings(i)) - do j = 1_pInt,9_pInt,2_pInt + do j = 1,9,2 select case (IO_stringValue(strings(i),chunkPos,j)) case('phi1') - texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad case('phi') - texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad case('phi2') - texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad end select enddo enddo @@ -817,7 +817,7 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& use numerics, only: & numerics_integrator - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & NofMyPhase, & sizeState, & @@ -842,13 +842,13 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 1_pInt) then + if (numerics_integrator == 1) then allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) endif - if (numerics_integrator == 4_pInt) & + if (numerics_integrator == 4) & allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 5_pInt) & + if (numerics_integrator == 5) & allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) @@ -864,7 +864,7 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,& use numerics, only: & numerics_integrator - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & of, & NofMyPhase, & @@ -882,13 +882,13 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,& allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 1_pInt) then + if (numerics_integrator == 1) then allocate(sourceState(phase)%p(of)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) endif - if (numerics_integrator == 4_pInt) & + if (numerics_integrator == 4) & allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 5_pInt) & + if (numerics_integrator == 5) & allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) @@ -905,10 +905,10 @@ subroutine material_populateGrains use mesh, only: & theMesh - integer(pInt) :: e,i,c,homog,micro + integer :: e,i,c,homog,micro - allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) - allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0) + allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0) allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal) do e = 1, theMesh%Nelems diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 0467d09aa..5168d4d4b 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -11,7 +11,7 @@ module mesh implicit none private - integer(pInt), public, protected :: & + integer, public, protected :: & mesh_NcpElems, & !< total number of CP elements in local mesh mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) mesh_Nnodes, & !< total number of nodes in mesh @@ -20,17 +20,17 @@ module mesh mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! - integer(pInt), public, protected :: & + integer, public, protected :: & mesh_maxNips, & !< max number of IPs in any CP element mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! - integer(pInt), dimension(:,:), allocatable, public, protected :: & + integer, dimension(:,:), allocatable, public, protected :: & mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) - integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + integer, dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] real(pReal), public, protected :: & @@ -55,20 +55,20 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - integer(pInt), private :: & + integer, private :: & mesh_maxNelemInSet, & mesh_Nmaterials - integer(pInt), dimension(2), private :: & - mesh_maxValStateVar = 0_pInt + integer, dimension(2), private :: & + mesh_maxValStateVar = 0 -integer(pInt), dimension(:,:), allocatable, private :: & +integer, dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID - integer(pInt),dimension(:,:,:), allocatable, private :: & + integer,dimension(:,:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell - integer(pInt), dimension(:,:,:), allocatable, private :: & + integer, dimension(:,:,:), allocatable, private :: & FE_nodesAtIP, & !< map IP index to node indices in a specific type of element FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry @@ -77,28 +77,28 @@ integer(pInt), dimension(:,:), allocatable, private :: & real(pReal), dimension(:,:,:), allocatable, private :: & FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - integer(pInt), dimension(:,:,:,:), allocatable, private :: & + integer, dimension(:,:,:,:), allocatable, private :: & FE_subNodeOnIPFace ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" - integer(pInt), parameter, public :: & - FE_Nelemtypes = 13_pInt, & - FE_Ngeomtypes = 10_pInt, & - FE_Ncelltypes = 4_pInt, & - FE_maxNnodes = 20_pInt, & - FE_maxNips = 27_pInt, & - FE_maxNipNeighbors = 6_pInt, & - FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP - FE_maxNmatchingNodesPerFace = 4_pInt, & - FE_maxNfaces = 6_pInt, & - FE_maxNcellnodes = 64_pInt, & - FE_maxNcellnodesPerCell = 8_pInt, & - FE_maxNcellfaces = 6_pInt, & - FE_maxNcellnodesPerCellface = 4_pInt + integer, parameter, public :: & + FE_Nelemtypes = 13, & + FE_Ngeomtypes = 10, & + FE_Ncelltypes = 4, & + FE_maxNnodes = 20, & + FE_maxNips = 27, & + FE_maxNipNeighbors = 6, & + FE_maxmaxNnodesAtIP = 8, & !< max number of (equivalent) nodes attached to an IP + FE_maxNmatchingNodesPerFace = 4, & + FE_maxNfaces = 6, & + FE_maxNcellnodes = 64, & + FE_maxNcellnodesPerCell = 8, & + FE_maxNcellfaces = 6, & + FE_maxNcellnodesPerCellface = 4 - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + integer, dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type int([ & 1, & ! element 6 (2D 3node 1ip) 2, & ! element 125 (2D 6node 3ip) @@ -115,7 +115,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 10 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type int([ & 1, & ! element 6 (2D 3node 1ip) 2, & ! element 125 (2D 6node 3ip) @@ -129,7 +129,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type int([ & 2, & ! element 6 (2D 3node 1ip) 2, & ! element 125 (2D 6node 3ip) @@ -143,7 +143,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 3 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + integer, dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element int([ & 3, & ! element 6 (2D 3node 1ip) 6, & ! element 125 (2D 6node 3ip) @@ -160,7 +160,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 20 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -174,7 +174,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -188,8 +188,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & - FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry + integer, dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry reshape(int([ & 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) @@ -203,7 +202,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) - integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & + integer, dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry reshape(int([& 1,2,0,0 , & ! element 6 (2D 3node 1ip) @@ -268,7 +267,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8,7,6,5 & ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type int([ & 3, & ! element 6 (2D 3node 1ip) 7, & ! element 125 (2D 6node 3ip) @@ -282,7 +281,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 64 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type int([ & 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -290,7 +289,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type int([& 2, & ! (2D 3node) 2, & ! (2D 4node) @@ -298,7 +297,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element int([ & 1, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -312,7 +311,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 27 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([& 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -320,7 +319,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element int([ & 3, & ! element 6 (2D 3node 1ip) 1, & ! element 125 (2D 6node 3ip) @@ -334,7 +333,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), private :: & + integer, private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets @@ -342,9 +341,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_nameElemSet, & !< names of elementSet mesh_nameMaterial, & !< names of material in solid section mesh_mapMaterial !< name of elementSet for material - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target, private :: & + integer, dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information @@ -381,7 +380,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & type, public, extends(tMesh) :: tMesh_abaqus - integer(pInt):: & + integer:: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets, & @@ -391,7 +390,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_nameElemSet, & !< names of elementSet mesh_nameMaterial, & !< names of material in solid section mesh_mapMaterial !< name of elementSet for material - integer(pInt), dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information @@ -409,7 +408,7 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) implicit none class(tMesh_abaqus) :: self real(pReal), dimension(:,:), intent(in) :: nodes - integer(pInt), intent(in) :: elemType + integer, intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) @@ -440,16 +439,16 @@ subroutine mesh_init(ip,el) FEsolving_execIP implicit none - integer(pInt), parameter :: FILEUNIT = 222_pInt - integer(pInt), intent(in), optional :: el, ip - integer(pInt) :: j + integer, parameter :: FILEUNIT = 222 + integer, intent(in), optional :: el, ip + integer :: j logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh - myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) @@ -502,14 +501,14 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & - call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + call IO_error(600) ! ping-pong must be disabled when having non-DAMASK elements if (debug_e < 1 .or. debug_e > mesh_NcpElems) & - call IO_error(602_pInt,ext_msg='element') ! selected element does not exist - if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & - call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements - allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... - forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + call IO_error(602,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2,debug_e)))) & + call IO_error(602,ext_msg='IP') ! selected element does not have requested IP + FEsolving_execElem = [ 1,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2,mesh_NcpElems), source=1) ! parallel loop bounds set to comprise from first IP... + forall (j = 1:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" @@ -532,9 +531,9 @@ logical function hasNoPart(fileUnit) IO_lc implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=65536) :: line hasNoPart = .true. @@ -543,7 +542,7 @@ logical function hasNoPart(fileUnit) do read(fileUnit,'(a65536)',END=620) line chunkPos = IO_stringPos(line) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then + if (IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) then hasNoPart = .false. exit endif @@ -573,15 +572,15 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt + mesh_Nnodes = 0 + mesh_Nelems = 0 inPart = .false. myStat = 0 @@ -589,25 +588,25 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) + select case ( IO_lc(IO_stringValue(line,chunkPos,1))) case('*node') if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' & ) & mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) case('*element') if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' & ) then mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) endif @@ -615,8 +614,8 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) endif enddo - if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) - if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) + if (mesh_Nnodes < 2) call IO_error(error_ID=900) + if (mesh_Nelems == 0) call IO_error(error_ID=901) end subroutine mesh_abaqus_count_nodesAndElements @@ -633,14 +632,14 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - mesh_NelemSets = 0_pInt + mesh_NelemSets = 0 mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons inPart = .false. @@ -649,15 +648,15 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & - mesh_NelemSets = mesh_NelemSets + 1_pInt + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1)) == '*elset' ) & + mesh_NelemSets = mesh_NelemSets + 1 enddo - if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) + if (mesh_NelemSets == 0) call IO_error(error_ID=902) end subroutine mesh_abaqus_count_elementSets @@ -675,14 +674,14 @@ subroutine mesh_abaqus_count_materials(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - mesh_Nmaterials = 0_pInt + mesh_Nmaterials = 0 inPart = .false. myStat = 0 @@ -690,17 +689,17 @@ subroutine mesh_abaqus_count_materials(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & - mesh_Nmaterials = mesh_Nmaterials + 1_pInt + IO_lc(IO_StringValue(line,chunkPos,1)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2)) == 'section' ) & + mesh_Nmaterials = mesh_Nmaterials + 1 enddo - if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + if (mesh_Nmaterials == 0) call IO_error(error_ID=903) end subroutine mesh_abaqus_count_materials @@ -720,39 +719,39 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: elemSet,i + integer :: elemSet,i allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + allocate (mesh_mapElemSet(1+mesh_maxNelemInSet,mesh_NelemSets),source=0) - elemSet = 0_pInt + elemSet = 0 inPart = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then - elemSet = elemSet + 1_pInt - mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1)) == '*elset' ) then + elemSet = elemSet + 1 + mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'elset')) mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& - mesh_mapElemSet,elemSet-1_pInt) + mesh_mapElemSet,elemSet-1) endif enddo - do i = 1_pInt,elemSet - if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) + do i = 1,elemSet + if (mesh_mapElemSet(1,i) == 0) call IO_error(error_ID=904,ext_msg=mesh_nameElemSet(i)) enddo end subroutine mesh_abaqus_map_elementSets @@ -772,37 +771,37 @@ subroutine mesh_abaqus_map_materials(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,c + integer :: i,c character(len=64) :: elemSetName,materialName allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - c = 0_pInt + c = 0 inPart = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then + IO_lc(IO_StringValue(line,chunkPos,1)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2)) == 'section' ) then elemSetName = '' materialName = '' - do i = 3_pInt,chunkPos(1_pInt) + do i = 3,chunkPos(1) if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & @@ -810,16 +809,16 @@ subroutine mesh_abaqus_map_materials(fileUnit) enddo if (elemSetName /= '' .and. materialName /= '') then - c = c + 1_pInt + c = c + 1 mesh_nameMaterial(c) = materialName ! name of material used for this section mesh_mapMaterial(c) = elemSetName ! mapped to respective element set endif endif enddo - if (c==0_pInt) call IO_error(error_ID=905_pInt) - do i=1_pInt,c - if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) + if (c==0) call IO_error(error_ID=905) + do i=1,c + if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905) enddo end subroutine mesh_abaqus_map_materials @@ -837,32 +836,32 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) IO_extractValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: materialFound - integer(pInt) :: i,k + integer :: i,k character(len=64) ::materialName,elemSetName - mesh_NcpElems = 0_pInt + mesh_NcpElems = 0 materialFound = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + select case ( IO_lc(IO_stringValue(line,chunkPos,1)) ) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (IO_lc(IO_StringValue(line,chunkPos,2)) == 'material' .and. materialFound) then + do i = 1,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + do k = 1,mesh_NelemSets ! look thru all elemSet definitions if (elemSetName == mesh_nameElemSet(k)) & ! matched? mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count enddo @@ -873,7 +872,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) endselect enddo - if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + if (mesh_NcpElems == 0) call IO_error(error_ID=906) end subroutine mesh_abaqus_count_cpElements @@ -892,38 +891,38 @@ subroutine mesh_abaqus_map_elements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: materialFound - integer(pInt) ::i,j,k,cpElem + integer ::i,j,k,cpElem character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0) - cpElem = 0_pInt + cpElem = 0 materialFound = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + select case ( IO_lc(IO_stringValue(line,chunkPos,1)) ) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'material' .and. materialFound) then + do i = 1,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + do k = 1,mesh_NelemSets ! look thru all elemSet definitions if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - cpElem = cpElem + 1_pInt - mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id + do j = 1,mesh_mapElemSet(1,k) + cpElem = cpElem + 1 + mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1+j,k) ! store FE id mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id enddo endif @@ -935,9 +934,9 @@ subroutine mesh_abaqus_map_elements(fileUnit) endselect enddo - call math_sort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + call math_sort(mesh_mapFEtoCPelem,1,int(size(mesh_mapFEtoCPelem,2),pInt)) ! should be mesh_NcpElems - if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) + if (int(size(mesh_mapFEtoCPelem),pInt) < 2) call IO_error(error_ID=907) end subroutine mesh_abaqus_map_elements @@ -957,51 +956,51 @@ subroutine mesh_abaqus_map_nodes(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,c,cpNode + integer :: i,c,cpNode - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) + allocate (mesh_mapFEtoCPnode(2,mesh_Nnodes), source=0) - cpNode = 0_pInt + cpNode = 0 inPart = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then c = IO_countDataLines(fileUnit) - do i = 1_pInt,c + do i = 1,c backspace(fileUnit) enddo - do i = 1_pInt,c + do i = 1,c read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) - cpNode = cpNode + 1_pInt - mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) - mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode + cpNode = cpNode + 1 + mesh_mapFEtoCPnode(1,cpNode) = IO_intValue(line,chunkPos,1) + mesh_mapFEtoCPnode(2,cpNode) = cpNode enddo endif enddo - call math_sort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + call math_sort(mesh_mapFEtoCPnode,1,int(size(mesh_mapFEtoCPnode,2),pInt)) - if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) + if (int(size(mesh_mapFEtoCPnode),pInt) == 0) call IO_error(error_ID=908) end subroutine mesh_abaqus_map_nodes @@ -1021,13 +1020,13 @@ subroutine mesh_abaqus_build_nodes(fileUnit) IO_intValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,j,m,c + integer :: i,j,m,c allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) @@ -1038,33 +1037,33 @@ subroutine mesh_abaqus_build_nodes(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then c = IO_countDataLines(fileUnit) ! how many nodes are defined here? - do i = 1_pInt,c + do i = 1,c backspace(fileUnit) ! rewind to first entry enddo - do i = 1_pInt,c + do i = 1,c read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) - m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) - do j=1_pInt, 3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) + m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1)) + do j=1, 3 + mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1) enddo enddo endif enddo - if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + if (int(size(mesh_node0,2),pInt) /= mesh_Nnodes) call IO_error(error_ID=909) mesh_node = mesh_node0 end subroutine mesh_abaqus_build_nodes @@ -1086,18 +1085,18 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) IO_intValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,c,t,g + integer :: i,c,t,g - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt + mesh_maxNnodes = 0 + mesh_maxNips = 0 + mesh_maxNipNeighbors = 0 + mesh_maxNcellnodes = 0 inPart = .false. @@ -1106,17 +1105,17 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'type')) ! remember elem type g = FE_geomtype(t) c = FE_celltype(g) mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) @@ -1145,17 +1144,17 @@ subroutine mesh_abaqus_build_elements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart, materialFound - integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead + integer :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead character (len=64) :: materialName,elemSetName - allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt + allocate(mesh_element (4+mesh_maxNnodes,mesh_NcpElems), source=0) + mesh_elemType = -1 inPart = .false. myStat = 0 @@ -1163,41 +1162,41 @@ subroutine mesh_abaqus_build_elements(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'type')) ! remember elem type c = IO_countDataLines(fileUnit) - do i = 1_pInt,c + do i = 1,c backspace(fileUnit) enddo - do i = 1_pInt,c + do i = 1,c read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) ! limit to 64 nodes max - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1)) + if (e /= 0) then ! disregard non CP elems + mesh_element(1,e) = -1 ! DEPRECATED + if (mesh_elemType /= t .and. mesh_elemType /= -1) & call IO_error(191,el=t,ip=mesh_elemType) mesh_elemType = t mesh_element(2,e) = t ! elem type - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-1_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: + nNodesAlreadyRead = 0 + do j = 1,chunkPos(1)-1 + mesh_element(4+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1+j)) ! put CP ids of nodes to position 5: enddo - nNodesAlreadyRead = chunkPos(1) - 1_pInt + nNodesAlreadyRead = chunkPos(1) - 1 do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + do j = 1,chunkPos(1) + mesh_element(4+nNodesAlreadyRead+j,e) & = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes enddo nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) @@ -1216,23 +1215,23 @@ subroutine mesh_abaqus_build_elements(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) + select case ( IO_lc(IO_StringValue(line,chunkPos,1))) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & + if ( IO_lc(IO_StringValue(line,chunkPos,2)) == 'material' .and. & materialFound ) then read (fileUnit,'(a300)') line ! read homogenization and microstructure chunkPos = IO_stringPos(line) - homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) - micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) - do i = 1_pInt,mesh_Nmaterials ! look thru material names + homog = nint(IO_floatValue(line,chunkPos,1),pInt) + micro = nint(IO_floatValue(line,chunkPos,2),pInt) + do i = 1,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + do k = 1,mesh_NelemSets ! look thru all elemSet definitions if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) + do j = 1,mesh_mapElemSet(1,k) e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) mesh_element(3,e) = homog ! store homogenization mesh_element(4,e) = micro ! store microstructure @@ -1262,12 +1261,12 @@ use IO, only: & IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - integer(pInt) :: chunk, Nchunks + integer :: chunk, Nchunks character(len=300) :: v logical, dimension(3) :: periodic_surface @@ -1279,10 +1278,10 @@ use IO, only: & read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '**damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + if (IO_lc(IO_stringValue(line,chunkPos,1)) == '**damask' .and. Nchunks > 1) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2))) case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + do chunk = 3,Nchunks ! loop through chunks (skipping the keyword) v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' @@ -1305,49 +1304,49 @@ end subroutine mesh_get_damaskOptions subroutine mesh_build_cellconnectivity implicit none - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & + integer, dimension(mesh_maxNcellnodes) :: & localCellnode2globalCellnode - integer(pInt) :: & + integer :: & e,t,g,c,n,i, & matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0) + allocate(cellnodeParent(2,mesh_maxNcellnodes*mesh_NcpElems), source=0) !-------------------------------------------------------------------------------------------------- ! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + mesh_Ncellnodes = 0 + mesh_Ncells = 0 + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt + localCellnode2globalCellnode = 0 mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do n = 1,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell localCellnodeID = FE_cell(n,i,g) if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node - matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) - if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNodeID = mesh_element(4+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) else ! this cell node is no matching node - if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + if (localCellnode2globalCellnode(localCellnodeID) == 0) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) endif @@ -1355,9 +1354,9 @@ subroutine mesh_build_cellconnectivity enddo enddo - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) + allocate(mesh_cellnodeParent(2,mesh_Ncellnodes)) + allocate(mesh_cellnode(3,mesh_Ncellnodes)) + forall(n = 1:mesh_Ncellnodes) mesh_cellnodeParent(1,n) = cellnodeParent(1,n) mesh_cellnodeParent(2,n) = cellnodeParent(2,n) endforall @@ -1373,11 +1372,11 @@ end subroutine mesh_build_cellconnectivity function mesh_build_cellnodes(nodes,Ncellnodes) implicit none - integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + integer, intent(in) :: Ncellnodes !< requested number of cellnodes real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes - integer(pInt) :: & + integer :: & e,t,n,m, & localCellnodeID real(pReal), dimension(3) :: & @@ -1385,13 +1384,13 @@ function mesh_build_cellnodes(nodes,Ncellnodes) mesh_build_cellnodes = 0.0_pReal !$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes + do n = 1,Ncellnodes ! loop over cell nodes e = mesh_cellnodeParent(1,n) localCellnodeID = mesh_cellnodeParent(2,n) t = mesh_element(2,e) ! get element type myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + do m = 1,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4+m,e)) & * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) enddo mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) @@ -1416,26 +1415,26 @@ subroutine mesh_build_ipVolumes math_areaTriangle implicit none - integer(pInt) :: e,t,g,c,i,m,f,n + integer :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type select case (c) - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + case (1) ! 2D 3node + forall (i = 1:FE_Nips(g)) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) - case (2_pInt) ! 2D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + case (2) ! 2D 4node + forall (i = 1:FE_Nips(g)) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) & @@ -1443,18 +1442,18 @@ subroutine mesh_build_ipVolumes mesh_cellnode(1:3,mesh_cell(4,i,e)), & mesh_cellnode(1:3,mesh_cell(1,i,e))) - case (3_pInt) ! 3D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + case (3) ! 3D 4node + forall (i = 1:FE_Nips(g)) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e)), & mesh_cellnode(1:3,mesh_cell(4,i,e))) - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1,FE_Nips(g) ! loop over ips=cells in this element subvolume = 0.0_pReal - forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(f = 1:FE_NipNeighbors(c), n = 1:FE_NcellnodesPerCellface(c)) & subvolume(n,f) = math_volTetrahedron(& mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & @@ -1485,20 +1484,20 @@ end subroutine mesh_build_ipVolumes subroutine mesh_build_ipCoordinates implicit none - integer(pInt) :: e,t,g,c,i,n + integer :: e,t,g,c,i,n real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1,FE_Nips(g) ! loop over ips=cells in this element myCoords = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) enddo mesh_ipCoordinates(1:3,i,e) = myCoords / real(FE_NcellnodesPerCell(c),pReal) @@ -1515,16 +1514,16 @@ end subroutine mesh_build_ipCoordinates pure function mesh_cellCenterCoordinates(ip,el) implicit none - integer(pInt), intent(in) :: el, & !< element number + integer, intent(in) :: el, & !< element number ip !< integration point number real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell - integer(pInt) :: t,g,c,n + integer :: t,g,c,n - t = mesh_element(2_pInt,el) ! get element type + t = mesh_element(2,el) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type mesh_cellCenterCoordinates = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) enddo mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) @@ -1544,24 +1543,24 @@ subroutine mesh_build_ipAreas math_cross implicit none - integer(pInt) :: e,t,g,c,i,f,n,m + integer :: e,t,g,c,i,f,n,m real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type select case (c) - case (1_pInt,2_pInt) ! 2D 3 or 4 node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (1,2) ! 2D 3 or 4 node + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector @@ -1571,10 +1570,10 @@ subroutine mesh_build_ipAreas enddo enddo - case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (3) ! 3D 4node + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal = math_cross(nodePos(1:3,2) - nodePos(1:3,1), & nodePos(1:3,3) - nodePos(1:3,1)) @@ -1583,17 +1582,17 @@ subroutine mesh_build_ipAreas enddo enddo - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node ! for this cell type we get the normal of the quadrilateral face as an average of ! four normals of triangular subfaces; since the face consists only of two triangles, ! the sum has to be divided by two; this whole prcedure tries to compensate for ! probable non-planar cell surfaces m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(n = 1:FE_NcellnodesPerCellface(c)) & normals(1:3,n) = 0.5_pReal & * math_cross(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) @@ -1616,41 +1615,41 @@ end subroutine mesh_build_ipAreas subroutine mesh_build_nodeTwins implicit none - integer(pInt) dir, & ! direction of periodicity + integer dir, & ! direction of periodicity node, & minimumNode, & maximumNode, & n1, & n2 - integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes + integer, dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension tolerance ! tolerance below which positions are assumed identical real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates logical, dimension(mesh_Nnodes) :: unpaired allocate(mesh_nodeTwins(3,mesh_Nnodes)) - mesh_nodeTwins = 0_pInt + mesh_nodeTwins = 0 tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal - do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z + do dir = 1,3 ! check periodicity in directions of x,y,z if (mesh_periodicSurface(dir)) then ! only if periodicity is requested !*** find out which nodes sit on the surface !*** and have a minimum or maximum position in this dimension - minimumNodes = 0_pInt - maximumNodes = 0_pInt + minimumNodes = 0 + maximumNodes = 0 minCoord = minval(mesh_node0(dir,:)) maxCoord = maxval(mesh_node0(dir,:)) - do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes + do node = 1,mesh_Nnodes ! loop through all nodes and find surface nodes if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then - minimumNodes(1) = minimumNodes(1) + 1_pInt - minimumNodes(minimumNodes(1)+1_pInt) = node + minimumNodes(1) = minimumNodes(1) + 1 + minimumNodes(minimumNodes(1)+1) = node elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then - maximumNodes(1) = maximumNodes(1) + 1_pInt - maximumNodes(maximumNodes(1)+1_pInt) = node + maximumNodes(1) = maximumNodes(1) + 1 + maximumNodes(maximumNodes(1)+1) = node endif enddo @@ -1658,11 +1657,11 @@ subroutine mesh_build_nodeTwins !*** find the corresponding node on the other side with the same position in this dimension unpaired = .true. - do n1 = 1_pInt,minimumNodes(1) - minimumNode = minimumNodes(n1+1_pInt) + do n1 = 1,minimumNodes(1) + minimumNode = minimumNodes(n1+1) if (unpaired(minimumNode)) then - do n2 = 1_pInt,maximumNodes(1) - maximumNode = maximumNodes(n2+1_pInt) + do n2 = 1,maximumNodes(1) + maximumNode = maximumNodes(n2+1) distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) mesh_nodeTwins(dir,minimumNode) = maximumNode @@ -1693,24 +1692,24 @@ subroutine mesh_build_sharedElems n, & ! node index per element myDim, & ! dimension index nodeTwin ! node twin in the specified dimension - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt), dimension(:), allocatable :: node_seen + integer, dimension (mesh_Nnodes) :: node_count + integer, dimension(:), allocatable :: node_seen allocate(node_seen(maxval(FE_NmatchingNodes))) - node_count = 0_pInt + node_count = 0 - do e = 1_pInt,mesh_NcpElems + do e = 1,mesh_NcpElems g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - node_seen = 0_pInt ! reset node duplicates - do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element + node_seen = 0 ! reset node duplicates + do n = 1,FE_NmatchingNodes(g) ! check each node of element node = mesh_element(4+n,e) if (all(node_seen /= node)) then - node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it - do myDim = 1_pInt,3_pInt ! check in each dimension... + node_count(node) = node_count(node) + 1 ! if FE node not yet encountered -> count it + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) & ! if I am a twin of some node... - node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node + if (nodeTwin > 0) & ! if I am a twin of some node... + node_count(nodeTwin) = node_count(nodeTwin) + 1 ! -> count me again for the twin node enddo endif node_seen(n) = node ! remember this node to be counted already @@ -1719,20 +1718,20 @@ subroutine mesh_build_sharedElems mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node - allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0) - do e = 1_pInt,mesh_NcpElems + do e = 1,mesh_NcpElems g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - node_seen = 0_pInt - do n = 1_pInt,FE_NmatchingNodes(g) - node = mesh_element(4_pInt+n,e) + node_seen = 0 + do n = 1,FE_NmatchingNodes(g) + node = mesh_element(4+n,e) if (all(node_seen /= node)) then - mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements - mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id - do myDim = 1_pInt,3_pInt ! check in each dimension... + mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1 ! count for each node the connected elements + mesh_sharedElem(mesh_sharedElem(1,node)+1,node) = e ! store the respective element id + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) then ! if i am a twin of some node... - mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin + if (nodeTwin > 0) then ! if i am a twin of some node... + mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1 ! ...count me again for the twin mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id endif enddo @@ -1752,7 +1751,7 @@ subroutine mesh_build_ipNeighborhood math_mul3x3 implicit none - integer(pInt) :: myElem, & ! my CP element index + integer :: myElem, & ! my CP element index myIP, & myType, & ! my element type myFace, & @@ -1770,26 +1769,26 @@ subroutine mesh_build_ipNeighborhood neighboringIP, & neighboringElem, & pointingToMe - integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & - linkedNodes = 0_pInt, & + integer, dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0, & matchingNodes logical checkTwins allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) - mesh_ipNeighborhood = 0_pInt + mesh_ipNeighborhood = 0 - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + do myElem = 1,mesh_NcpElems ! loop over cpElems myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + do myIP = 1,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + do neighbor = 1,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) !*** if the key is positive, the neighbor is inside the element !*** that means, we have already found our neighboring IP - if (neighboringIPkey > 0_pInt) then + if (neighboringIPkey > 0) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey @@ -1797,33 +1796,33 @@ subroutine mesh_build_ipNeighborhood !*** if the key is negative, the neighbor resides in a neighboring element !*** that means, we have to look through the face indicated by the key and see which element is behind that face - elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP + elseif (neighboringIPkey < 0) then ! neighboring element's IP myFace = -neighboringIPkey call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match - if (matchingElem > 0_pInt) then ! found match? + if (matchingElem > 0) then ! found match? neighboringType = FE_geomtype(mesh_element(2,matchingElem)) !*** trivial solution if neighbor has only one IP - if (FE_Nips(neighboringType) == 1_pInt) then + if (FE_Nips(neighboringType) == 1) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1 cycle endif !*** find those nodes which build the link to the neighbor - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face + NlinkedNodes = 0 + linkedNodes = 0 + do a = 1,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face anchor = FE_nodesAtIP(a,myIP,myType) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? - NlinkedNodes = NlinkedNodes + 1_pInt - linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node + NlinkedNodes = NlinkedNodes + 1 + linkedNodes(NlinkedNodes) = mesh_element(4+anchor,myElem) ! CP id of anchor node else ! something went wrong with the linkage, since not all anchors sit on my face - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt + NlinkedNodes = 0 + linkedNodes = 0 exit endif endif @@ -1833,18 +1832,18 @@ subroutine mesh_build_ipNeighborhood !*** and try to find an ip with matching nodes !*** also try to match with node twins - checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip + checkCandidateIP: do candidateIP = 1,FE_Nips(neighboringType) + NmatchingNodes = 0 + matchingNodes = 0 + do a = 1,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip anchor = FE_nodesAtIP(a,candidateIP,neighboringType) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? - NmatchingNodes = NmatchingNodes + 1_pInt + NmatchingNodes = NmatchingNodes + 1 matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node else ! no matching, because not all nodes sit on the matching face - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt + NmatchingNodes = 0 + matchingNodes = 0 exit endif endif @@ -1856,7 +1855,7 @@ subroutine mesh_build_ipNeighborhood !*** check "normal" nodes whether they match or not checkTwins = .false. - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode checkTwins = .true. exit ! no need to search further @@ -1867,9 +1866,9 @@ subroutine mesh_build_ipNeighborhood if(checkTwins) then dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) - if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... + if (twin_of_linkedNode == 0 .or. & ! twin of linkedNode does not exist... all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode cycle checkCandidateIP ! ... then check next candidateIP endif @@ -1887,15 +1886,15 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + do myElem = 1,mesh_NcpElems ! loop over cpElems myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + do myIP = 1,FE_Nips(myType) ! loop over IPs of elem + do neighbor = 1,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) - if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... + if (neighboringElem > 0 .and. neighboringIP > 0) then ! if neighbor exists ... neighboringType = FE_geomtype(mesh_element(2,neighboringElem)) - do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself + do pointingToMe = 1,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& @@ -1917,34 +1916,34 @@ subroutine mesh_build_ipNeighborhood subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) implicit none -integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID +integer, intent(out) :: matchingElem, & ! matching CP element ID matchingFace ! matching face ID -integer(pInt), intent(in) :: face, & ! face ID +integer, intent(in) :: face, & ! face ID elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & +integer, dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & myFaceNodes ! global node ids on my face -integer(pInt) :: myType, & +integer :: myType, & candidateType, & candidateElem, & candidateFace, & candidateFaceNode, & minNsharedElems, & NsharedElems, & - lonelyNode = 0_pInt, & + lonelyNode = 0, & i, & n, & dir ! periodicity direction -integer(pInt), dimension(:), allocatable :: element_seen +integer, dimension(:), allocatable :: element_seen logical checkTwins -matchingElem = 0_pInt -matchingFace = 0_pInt -minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case -myType = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType +matchingElem = 0 +matchingFace = 0 +minNsharedElems = mesh_maxNsharedElems + 1 ! init to worst case +myType = FE_geomtype(mesh_element(2,elem)) ! figure elemGeomType -do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face - myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node - NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node +do n = 1,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face + myFaceNodes(n) = mesh_element(4+FE_face(n,face,myType),elem) ! CP id of face node + NsharedElems = mesh_sharedElem(1,myFaceNodes(n)) ! figure # shared elements for this node if (NsharedElems < minNsharedElems) then minNsharedElems = NsharedElems ! remember min # shared elems lonelyNode = n ! remember most lonely node @@ -1952,33 +1951,33 @@ do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) enddo allocate(element_seen(minNsharedElems)) -element_seen = 0_pInt +element_seen = 0 -checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements - candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem +checkCandidate: do i = 1,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1+i,myFaceNodes(lonelyNode)) ! present candidate elem if (all(element_seen /= candidateElem)) then ! element seen for the first time? element_seen(i) = candidateElem - candidateType = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate -checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate + candidateType = FE_geomtype(mesh_element(2,candidateElem)) ! figure elemGeomType of candidate +checkCandidateFace: do candidateFace = 1,FE_maxNipNeighbors ! check each face of candidate if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face cycle checkCandidateFace endif checkTwins = .false. - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face - candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes checkTwins = .true. ! perhaps the twin nodes do match exit endif enddo if(checkTwins) then -checkCandidateFaceTwins: do dir = 1_pInt,3_pInt - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face +checkCandidateFaceTwins: do dir = 1,3 + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either - if (dir == 3_pInt) then + if (dir == 3) then cycle checkCandidateFace else cycle checkCandidateFaceTwins ! try twins in next dimension @@ -2003,7 +2002,7 @@ end subroutine mesh_build_ipNeighborhood !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation !-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) +integer function FE_mapElemtype(what) use IO, only: IO_lc, IO_error implicit none @@ -2012,30 +2011,30 @@ integer(pInt) function FE_mapElemtype(what) select case (IO_lc(what)) case ( 'cpe4', & 'cpe4t') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + FE_mapElemtype = 3 ! Arbitrary Quadrilateral Plane-strain case ( 'cpe8', & 'cpe8t') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + FE_mapElemtype = 4 ! Plane Strain, Eight-node Distorted Quadrilateral case ( 'c3d4', & 'c3d4t') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + FE_mapElemtype = 6 ! Three-dimensional Four-node Tetrahedron case ( 'c3d6', & 'c3d6t') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + FE_mapElemtype = 9 ! Three-dimensional Arbitrarily Distorted Pentahedral case ( 'c3d8r', & 'c3d8rt') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + FE_mapElemtype = 10 ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration case ( 'c3d8', & 'c3d8t') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + FE_mapElemtype = 11 ! Three-dimensional Arbitrarily Distorted Brick case ( 'c3d20r', & 'c3d20rt') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + FE_mapElemtype = 12 ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration case ( 'c3d20', & 'c3d20t') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + FE_mapElemtype = 13 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + call IO_error(error_ID=190,ext_msg=IO_lc(what)) end select end function FE_mapElemtype @@ -2051,25 +2050,25 @@ end function FE_mapElemtype subroutine mesh_build_FEdata implicit none - integer(pInt) :: me - allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + integer :: me + allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0) + allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0) + allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0) allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) - allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0) !*** fill FE_nodesAtIP with data *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) reshape(int([& 1,2,3 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) reshape(int([& 1, & @@ -2077,7 +2076,7 @@ subroutine mesh_build_FEdata 3 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) reshape(int([& 1, & @@ -2086,7 +2085,7 @@ subroutine mesh_build_FEdata 3 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) reshape(int([& 1,0, & @@ -2100,13 +2099,13 @@ subroutine mesh_build_FEdata 3,0 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) reshape(int([& 1,2,3,4 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) reshape(int([& 1, & @@ -2115,7 +2114,7 @@ subroutine mesh_build_FEdata 4 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) reshape(int([& 1, & @@ -2126,13 +2125,13 @@ subroutine mesh_build_FEdata 6 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) reshape(int([& 1,2,3,4,5,6,7,8 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) reshape(int([& 1, & @@ -2145,7 +2144,7 @@ subroutine mesh_build_FEdata 7 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) reshape(int([& 1,0, 0,0, & @@ -2183,15 +2182,15 @@ subroutine mesh_build_FEdata ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. ! Positive integers denote an intra-FE IP identifier. ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) reshape(int([& -2,-3,-1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) reshape(int([& 2,-3, 3,-1, & @@ -2199,7 +2198,7 @@ subroutine mesh_build_FEdata 2,-3,-2, 1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) reshape(int([& 2,-4, 3,-1, & @@ -2208,7 +2207,7 @@ subroutine mesh_build_FEdata -2, 3,-3, 2 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) reshape(int([& 2,-4, 4,-1, & @@ -2222,13 +2221,13 @@ subroutine mesh_build_FEdata -2, 8,-3, 6 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) reshape(int([& -1,-2,-3,-4 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) reshape(int([& 2,-4, 3,-2, 4,-1, & @@ -2237,7 +2236,7 @@ subroutine mesh_build_FEdata 2,-4, 3,-2,-3, 1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) reshape(int([& 2,-4, 3,-2, 4,-1, & @@ -2248,13 +2247,13 @@ subroutine mesh_build_FEdata 5,-4,-3, 4,-5, 3 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) reshape(int([& -3,-5,-4,-2,-6,-1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) reshape(int([& 2,-5, 3,-2, 5,-1, & @@ -2267,7 +2266,7 @@ subroutine mesh_build_FEdata -3, 7,-4, 6,-6, 4 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) reshape(int([& 2,-5, 4,-2,10,-1, & @@ -2301,15 +2300,15 @@ subroutine mesh_build_FEdata ! *** FE_cell *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) reshape(int([& 1,2,3 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) reshape(int([& 1, 4, 7, 6, & @@ -2317,7 +2316,7 @@ subroutine mesh_build_FEdata 3, 6, 7, 5 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) reshape(int([& 1, 5, 9, 8, & @@ -2326,7 +2325,7 @@ subroutine mesh_build_FEdata 9, 6, 3, 7 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) reshape(int([& 1, 5,13,12, & @@ -2340,13 +2339,13 @@ subroutine mesh_build_FEdata 15, 8, 3, 9 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) reshape(int([& 1, 2, 3, 4 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) reshape(int([& 1, 5,11, 7, 8,12,15,14, & @@ -2355,7 +2354,7 @@ subroutine mesh_build_FEdata 8,12,15, 4, 4, 9,13,10 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) reshape(int([& 1, 7,16, 9,10,17,21,19, & @@ -2366,13 +2365,13 @@ subroutine mesh_build_FEdata 19,21,18,12,15,20,14, 6 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) reshape(int([& 1, 2, 3, 4, 5, 6, 7, 8 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) reshape(int([& 1, 9,21,12,13,22,27,25, & @@ -2385,7 +2384,7 @@ subroutine mesh_build_FEdata 27,23,15,24,26,18, 7,19 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) reshape(int([& 1, 9,33,16,17,37,57,44, & @@ -2424,9 +2423,9 @@ subroutine mesh_build_FEdata ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, ! e.g., an 8 node element, would be encoded: ! 1, 1, 0, 0, 1, 1, 0, 0 - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) reshape(real([& 1, 0, 0, & @@ -2434,7 +2433,7 @@ subroutine mesh_build_FEdata 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) reshape(real([& 1, 0, 0, 0, 0, 0, & @@ -2446,7 +2445,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 2, 2, 2 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) reshape(real([& 1, 0, 0, 0, & @@ -2460,7 +2459,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & @@ -2481,7 +2480,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 4, 2, 2, 8, 8 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & @@ -2495,7 +2494,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1, 2, 2, 2, 2 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) reshape(real([& 1, 0, 0, 0, & @@ -2504,7 +2503,7 @@ subroutine mesh_build_FEdata 0, 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) reshape(real([& 1, 0, 0, 0, 0, & @@ -2524,7 +2523,7 @@ subroutine mesh_build_FEdata 0, 0, 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & @@ -2544,7 +2543,7 @@ subroutine mesh_build_FEdata 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) reshape(real([& 1, 0, 0, 0, 0, 0, & @@ -2570,7 +2569,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1, 1, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & @@ -2583,7 +2582,7 @@ subroutine mesh_build_FEdata 0, 0, 0, 0, 0, 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & ! @@ -2615,7 +2614,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1, 1, 1, 1, 1 & ! ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! @@ -2647,7 +2646,7 @@ subroutine mesh_build_FEdata 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! @@ -2719,9 +2718,9 @@ subroutine mesh_build_FEdata ! *** FE_cellface *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) reshape(int([& 2,3, & @@ -2729,7 +2728,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) reshape(int([& 2,3, & @@ -2738,7 +2737,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) reshape(int([& 1,3,2, & @@ -2747,7 +2746,7 @@ subroutine mesh_build_FEdata 1,4,3 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) reshape(int([& 2,3,7,6, & @@ -2766,18 +2765,18 @@ end subroutine mesh_build_FEdata !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) +integer function mesh_FEasCP(what,myID) use IO, only: & IO_lc implicit none character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID + integer, intent(in) :: myID - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center + integer, dimension(:,:), pointer :: lookupMap + integer :: lower,upper,center - mesh_FEasCP = 0_pInt + mesh_FEasCP = 0 select case(IO_lc(what(1:4))) case('elem') lookupMap => mesh_mapFEtoCPelem @@ -2787,24 +2786,24 @@ integer(pInt) function mesh_FEasCP(what,myID) return endselect - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) + lower = 1 + upper = int(size(lookupMap,2),pInt) - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) + if (lookupMap(1,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2,lower) return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) + elseif (lookupMap(1,upper) == myID) then + mesh_FEasCP = lookupMap(2,upper) return endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then + binarySearch: do while (upper-lower > 1) + center = (lower+upper)/2 + if (lookupMap(1,center) < myID) then lower = center - elseif (lookupMap(1_pInt,center) > myID) then + elseif (lookupMap(1,center) > myID) then upper = center else - mesh_FEasCP = lookupMap(2_pInt,center) + mesh_FEasCP = lookupMap(2,center) exit endif enddo binarySearch diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 79718c37f..7338c88f3 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -11,19 +11,19 @@ module mesh implicit none private - integer(pInt), public, protected :: & + integer, public, protected :: & mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh mesh_maxNsharedElems !< max number of CP elements sharing a node - integer(pInt), dimension(:,:), allocatable, public, protected :: & + integer, dimension(:,:), allocatable, public, protected :: & mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) - integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + integer, dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] real(pReal), public, protected :: & @@ -49,34 +49,34 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -integer(pInt), dimension(:,:), allocatable, private :: & +integer, dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID - integer(pInt),dimension(:,:,:), allocatable, private :: & + integer,dimension(:,:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell - integer(pInt), dimension(:,:,:), allocatable, private :: & + integer, dimension(:,:,:), allocatable, private :: & FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" - integer(pInt), parameter, public :: & - FE_Nelemtypes = 13_pInt, & - FE_Ngeomtypes = 10_pInt, & - FE_Ncelltypes = 4_pInt, & - FE_maxNipNeighbors = 6_pInt, & - FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP - FE_maxNmatchingNodesPerFace = 4_pInt, & - FE_maxNfaces = 6_pInt, & - FE_maxNcellnodes = 64_pInt, & - FE_maxNcellnodesPerCell = 8_pInt, & - FE_maxNcellfaces = 6_pInt, & - FE_maxNcellnodesPerCellface = 4_pInt + integer, parameter, public :: & + FE_Nelemtypes = 13, & + FE_Ngeomtypes = 10, & + FE_Ncelltypes = 4, & + FE_maxNipNeighbors = 6, & + FE_maxmaxNnodesAtIP = 8, & !< max number of (equivalent) nodes attached to an IP + FE_maxNmatchingNodesPerFace = 4, & + FE_maxNfaces = 6, & + FE_maxNcellnodes = 64, & + FE_maxNcellnodesPerCell = 8, & + FE_maxNcellfaces = 6, & + FE_maxNcellnodesPerCellface = 4 - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Nfaces = & !< number of faces of a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_Nfaces = & !< number of faces of a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -90,7 +90,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -104,7 +104,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & + integer, dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry reshape(int([ & 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) @@ -119,7 +119,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) - integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & + integer, dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry reshape(int([& 1,2,0,0 , & ! element 6 (2D 3node 1ip) @@ -185,7 +185,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type int([& 2, & ! (2D 3node) 2, & ! (2D 4node) @@ -193,7 +193,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([& 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -202,24 +202,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],pInt) - integer(pInt), private :: & + integer, private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_NelemSets character(len=64), dimension(:), allocatable, private :: & mesh_nameElemSet - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target, private :: & + integer, dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] - integer(pInt), private :: & + integer, private :: & MarcVersion, & !< Version of input file format (Marc only) hypoelasticTableStyle, & !< Table style (Marc only) initialcondTableStyle !< Table style (Marc only) - integer(pInt), dimension(:), allocatable, private :: & + integer, dimension(:), allocatable, private :: & Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) public :: & @@ -268,7 +268,7 @@ subroutine tMesh_marc_init(self,elemType,nodes) implicit none class(tMesh_marc) :: self real(pReal), dimension(:,:), intent(in) :: nodes - integer(pInt), intent(in) :: elemType + integer, intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) @@ -300,11 +300,11 @@ subroutine mesh_init(ip,el) FEsolving_execIP implicit none - integer(pInt), intent(in) :: el, ip + integer, intent(in) :: el, ip - integer(pInt), parameter :: FILEUNIT = 222_pInt - integer(pInt) :: j, fileFormatVersion, elemType - integer(pInt) :: & + integer, parameter :: FILEUNIT = 222 + integer :: j, fileFormatVersion, elemType + integer :: & mesh_maxNelemInSet, & mesh_NcpElems logical :: myDebug @@ -313,7 +313,7 @@ subroutine mesh_init(ip,el) mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh - myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) @@ -337,18 +337,18 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) allocate(mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = 'n/a' - allocate(mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + allocate(mesh_mapElemSet(1+mesh_maxNelemInSet,mesh_NelemSets),source=0) call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) mesh_NcpElems = mesh_nElems if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0) call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,mesh_NcpElems,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + allocate (mesh_mapFEtoCPnode(2,mesh_Nnodes),source=0) call mesh_marc_map_nodes(mesh_Nnodes,FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) @@ -390,14 +390,14 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) if (usePingPong .and. (mesh_Nelems /= theMesh%nElems)) & - call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + call IO_error(600) ! ping-pong must be disabled when having non-DAMASK elements if (debug_e < 1 .or. debug_e > theMesh%nElems) & - call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + call IO_error(602,ext_msg='element') ! selected element does not exist if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) & - call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + call IO_error(602,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements - allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + FEsolving_execElem = [ 1,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2,theMesh%nElems), source=1) ! parallel loop bounds set to comprise from first IP... FEsolving_execIP(2,:) = theMesh%elem%nIPs allocate(calcMode(theMesh%elem%nIPs,theMesh%nElems)) @@ -413,7 +413,7 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- !> @brief Figures out version of Marc input file format !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_marc_get_fileFormat(fileUnit) +integer function mesh_marc_get_fileFormat(fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -421,9 +421,9 @@ integer(pInt) function mesh_marc_get_fileFormat(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line @@ -432,8 +432,8 @@ integer(pInt) function mesh_marc_get_fileFormat(fileUnit) read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2_pInt) + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'version') then + mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2) exit endif enddo @@ -452,23 +452,23 @@ subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) IO_stringPos implicit none - integer(pInt), intent(out) :: initialcond, hypoelastic - integer(pInt), intent(in) :: fileUnit + integer, intent(out) :: initialcond, hypoelastic + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - initialcond = 0_pInt - hypoelastic = 0_pInt + initialcond = 0 + hypoelastic = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcond = IO_intValue(line,chunkPos,4_pInt) - hypoelastic = IO_intValue(line,chunkPos,5_pInt) + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'table' .and. chunkPos(1) > 5) then + initialcond = IO_intValue(line,chunkPos,4) + hypoelastic = IO_intValue(line,chunkPos,5) exit endif enddo @@ -487,33 +487,33 @@ function mesh_marc_get_matNumber(fileUnit,tableStyle) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit, tableStyle - integer(pInt), dimension(:), allocatable :: mesh_marc_get_matNumber + integer, intent(in) :: fileUnit, tableStyle + integer, dimension(:), allocatable :: mesh_marc_get_matNumber - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks + integer, allocatable, dimension(:) :: chunkPos + integer :: i, j, data_blocks character(len=300) line rewind(fileUnit) - data_blocks = 1_pInt + data_blocks = 1 do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'hypoelastic') then read (fileUnit,'(A300)',END=620) line - if (len(trim(line))/=0_pInt) then + if (len(trim(line))/=0) then chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) + data_blocks = IO_intValue(line,chunkPos,1) endif - allocate(mesh_marc_get_matNumber(data_blocks), source = 0_pInt) - do i=1_pInt,data_blocks ! read all data blocks + allocate(mesh_marc_get_matNumber(data_blocks), source = 0) + do i=1,data_blocks ! read all data blocks read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - mesh_marc_get_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + tableStyle ! read 2 or 3 remaining lines of data block + mesh_marc_get_matNumber(i) = IO_intValue(line,chunkPos,1) + do j=1_pint,2 + tableStyle ! read 2 or 3 remaining lines of data block read (fileUnit,'(A300)') line enddo enddo @@ -535,26 +535,26 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) IO_IntValue implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), intent(out) :: nNodes, nElems + integer, intent(in) :: fileUnit + integer, intent(out) :: nNodes, nElems - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - nNodes = 0_pInt - nElems = 0_pInt + nNodes = 0 + nElems = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - nElems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + if ( IO_lc(IO_StringValue(line,chunkPos,1)) == 'sizing') & + nElems = IO_IntValue (line,chunkPos,3) + if ( IO_lc(IO_StringValue(line,chunkPos,1)) == 'coordinates') then read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) - nNodes = IO_IntValue (line,chunkPos,2_pInt) + nNodes = IO_IntValue (line,chunkPos,2) exit ! assumes that "coordinates" comes later in file endif enddo @@ -573,23 +573,23 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) IO_countContinuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), intent(out) :: nElemSets, maxNelemInSet + integer, intent(in) :: fileUnit + integer, intent(out) :: nElemSets, maxNelemInSet - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - nElemSets = 0_pInt - maxNelemInSet = 0_pInt + nElemSets = 0 + maxNelemInSet = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - nElemSets = nElemSets + 1_pInt + if ( IO_lc(IO_StringValue(line,chunkPos,1)) == 'define' .and. & + IO_lc(IO_StringValue(line,chunkPos,2)) == 'element' ) then + nElemSets = nElemSets + 1 maxNelemInSet = max(maxNelemInSet, IO_countContinuousIntValues(fileUnit)) endif enddo @@ -608,26 +608,26 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit character(len=64), dimension(:), intent(out) :: & nameElemSet - integer(pInt), dimension(:,:), intent(out) :: & + integer, dimension(:,:), intent(out) :: & mapElemSet - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: elemSet + integer :: elemSet - elemSet = 0_pInt + elemSet = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=640) line chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then - elemSet = elemSet+1_pInt - nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + if( (IO_lc(IO_stringValue(line,chunkPos,1)) == 'define' ) .and. & + (IO_lc(IO_stringValue(line,chunkPos,2)) == 'element' ) ) then + elemSet = elemSet+1 + nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4)) mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet)) endif enddo @@ -648,27 +648,27 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileU IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,tableStyle,nElems + integer, intent(in) :: fileUnit,tableStyle,nElems character(len=64), intent(in), dimension(:) :: nameElemSet - integer(pInt), dimension(:,:), intent(in) :: & + integer, dimension(:,:), intent(in) :: & mapElemSet - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line, & tmp - integer(pInt), dimension (1_pInt+nElems) :: contInts - integer(pInt) :: i,cpElem + integer, dimension (1+nElems) :: contInts + integer :: i,cpElem - cpElem = 0_pInt - contInts = 0_pInt + cpElem = 0 + contInts = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) if (MarcVersion < 13) then ! Marc 2016 or earlier - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+TableStyle ! skip three (or four if new table style!) lines + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'hypoelastic' ) then + do i=1,3+TableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo contInts = IO_continuousIntValues(fileUnit,nElems,nameElemSet,& @@ -676,18 +676,18 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileU exit endif else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'connectivity') then read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6))) then do read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + tmp = IO_lc(IO_stringValue(line,chunkPos,1)) if (verify(trim(tmp),"0123456789")/=0) then ! found keyword exit else - contInts(1) = contInts(1) + 1_pInt + contInts(1) = contInts(1) + 1 read (tmp,*) contInts(contInts(1)+1) endif enddo @@ -695,13 +695,13 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileU endif endif enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) +660 do i = 1,contInts(1) + cpElem = cpElem+1 + mesh_mapFEtoCPelem(1,cpElem) = contInts(1+i) mesh_mapFEtoCPelem(2,cpElem) = cpElem enddo -call math_sort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems +call math_sort(mesh_mapFEtoCPelem,1,int(size(mesh_mapFEtoCPelem,2),pInt)) ! should be mesh_NcpElems end subroutine mesh_marc_map_elements @@ -718,32 +718,32 @@ subroutine mesh_marc_map_nodes(nNodes,fileUnit) IO_fixedIntValue implicit none - integer(pInt), intent(in) :: fileUnit, nNodes + integer, intent(in) :: fileUnit, nNodes - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension (nNodes) :: node_count - integer(pInt) :: i + integer, dimension (nNodes) :: node_count + integer :: i - node_count = 0_pInt + node_count = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=650) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'coordinates' ) then read (fileUnit,'(A300)') line ! skip crap line - do i = 1_pInt,nNodes + do i = 1,nNodes read (fileUnit,'(A300)') line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i + mesh_mapFEtoCPnode(1,i) = IO_fixedIntValue (line,[0,10],1) + mesh_mapFEtoCPnode(2,i) = i enddo exit endif enddo -650 call math_sort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) +650 call math_sort(mesh_mapFEtoCPnode,1,int(size(mesh_mapFEtoCPnode,2),pInt)) end subroutine mesh_marc_map_nodes @@ -761,12 +761,12 @@ subroutine mesh_marc_build_nodes(fileUnit) IO_fixedNoEFloatValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,j,m + integer :: i,j,m allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) @@ -774,13 +774,13 @@ subroutine mesh_marc_build_nodes(fileUnit) do read (fileUnit,'(A300)',END=670) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'coordinates' ) then read (fileUnit,'(A300)') line ! skip crap line - do i=1_pInt,mesh_Nnodes + do i=1,mesh_Nnodes read (fileUnit,'(A300)') line - m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) - do j = 1_pInt,3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) + m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1)) + do j = 1,3 + mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1) enddo enddo exit @@ -797,7 +797,7 @@ end subroutine mesh_marc_build_nodes !! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_marc_count_cpSizes(fileUnit) +integer function mesh_marc_count_cpSizes(fileUnit) use IO, only: IO_lc, & IO_error, & @@ -808,32 +808,32 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) use element implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit type(tElement) :: tempEl - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,t,g,e,c + integer :: i,t,g,e,c - t = -1_pInt + t = -1 rewind(fileUnit) do read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'connectivity' ) then read (fileUnit,'(A300)') line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements + do i=1,mesh_Nelems ! read all elements read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) ! limit to id and type - if (t == -1_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t == -1) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2)) call tempEl%init(t) mesh_marc_count_cpSizes = t else - if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2))) call IO_error(0) !ToDo: error message endif - call IO_skipChunks(fileUnit,tempEl%nNodes-(chunkPos(1_pInt)-2_pInt)) + call IO_skipChunks(fileUnit,tempEl%nNodes-(chunkPos(1)-2)) enddo exit endif @@ -858,45 +858,45 @@ subroutine mesh_marc_build_elements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension(1_pInt+theMesh%nElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + integer, dimension(1+theMesh%nElems) :: contInts + integer :: i,j,t,sv,myVal,e,nNodesAlreadyRead - allocate(mesh_element(4_pInt+theMesh%elem%nNodes,theMesh%nElems), source=0_pInt) - mesh_elemType = -1_pInt + allocate(mesh_element(4+theMesh%elem%nNodes,theMesh%nElems), source=0) + mesh_elemType = -1 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'connectivity' ) then read (fileUnit,'(A300)',END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems + do i = 1,mesh_Nelems read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1)) + if (e /= 0) then ! disregard non CP elems + mesh_element(1,e) = -1 ! DEPRECATED + t = FE_mapElemtype(IO_StringValue(line,chunkPos,2)) ! elem type + if (mesh_elemType /= t .and. mesh_elemType /= -1) & call IO_error(191,el=t,ip=mesh_elemType) mesh_elemType = t mesh_element(2,e) = t - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-2_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes + nNodesAlreadyRead = 0 + do j = 1,chunkPos(1)-2 + mesh_element(4+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2)) ! CP ids of nodes enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt + nNodesAlreadyRead = chunkPos(1) - 2 do while(nNodesAlreadyRead < theMesh%elem%nNodes) ! read on if not all nodes in one line read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + do j = 1,chunkPos(1) + mesh_element(4+nNodesAlreadyRead+j,e) & = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes enddo nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) @@ -911,28 +911,28 @@ subroutine mesh_marc_build_elements(fileUnit) read (fileUnit,'(A300)',END=630) line do chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=630) line ! read extra line for new style + if( (IO_lc(IO_stringValue(line,chunkPos,1)) == 'initial') .and. & + (IO_lc(IO_stringValue(line,chunkPos,2)) == 'state') ) then + if (initialcondTableStyle == 2) read (fileUnit,'(A300)',END=630) line ! read extra line for new style read (fileUnit,'(A300)',END=630) line ! read line with index of state var chunkPos = IO_stringPos(line) - sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index - if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest + sv = IO_IntValue(line,chunkPos,1) ! figure state variable index + if( (sv == 2).or.(sv == 3) ) then ! only state vars 2 and 3 of interest read (fileUnit,'(A300)',END=630) line ! read line with value of state var chunkPos = IO_stringPos(line) - do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? - myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value - if (initialcondTableStyle == 2_pInt) then + do while (scan(IO_stringValue(line,chunkPos,1),'+-',back=.true.)>1) ! is noEfloat value? + myVal = nint(IO_fixedNoEFloatValue(line,[0,20],1),pInt) ! state var's value + if (initialcondTableStyle == 2) then read (fileUnit,'(A300)',END=630) line ! read extra line read (fileUnit,'(A300)',END=630) line ! read extra line endif contInts = IO_continuousIntValues& ! get affected elements (fileUnit,theMesh%nElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - do i = 1_pInt,contInts(1) - e = mesh_FEasCP('elem',contInts(1_pInt+i)) - mesh_element(1_pInt+sv,e) = myVal + do i = 1,contInts(1) + e = mesh_FEasCP('elem',contInts(1+i)) + mesh_element(1+sv,e) = myVal enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=630) line ! ignore IP range for old table style + if (initialcondTableStyle == 0) read (fileUnit,'(A300)',END=630) line ! ignore IP range for old table style read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo @@ -956,12 +956,12 @@ use IO, only: & IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - integer(pInt) :: chunk, Nchunks + integer :: chunk, Nchunks character(len=300) :: v logical, dimension(3) :: periodic_surface @@ -973,10 +973,10 @@ use IO, only: & read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '$damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + if (IO_lc(IO_stringValue(line,chunkPos,1)) == '$damask' .and. Nchunks > 1) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2))) case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + do chunk = 3,Nchunks ! loop through chunks (skipping the keyword) v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' @@ -998,46 +998,46 @@ end subroutine mesh_get_damaskOptions subroutine mesh_build_cellconnectivity implicit none - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & cellnodeParent - integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & + integer, dimension(theMesh%elem%Ncellnodes) :: & localCellnode2globalCellnode - integer(pInt) :: & + integer :: & e,n,i, & matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0_pInt) - allocate(matchingNode2cellnode(theMesh%nNodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,theMesh%elem%Ncellnodes*theMesh%nElems), source=0_pInt) + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0) + allocate(matchingNode2cellnode(theMesh%nNodes), source=0) + allocate(cellnodeParent(2,theMesh%elem%Ncellnodes*theMesh%nElems), source=0) mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs !-------------------------------------------------------------------------------------------------- ! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt + mesh_Ncellnodes = 0 - do e = 1_pInt,theMesh%nElems - localCellnode2globalCellnode = 0_pInt - do i = 1_pInt,theMesh%elem%nIPs - do n = 1_pInt,theMesh%elem%NcellnodesPerCell + do e = 1,theMesh%nElems + localCellnode2globalCellnode = 0 + do i = 1,theMesh%elem%nIPs + do n = 1,theMesh%elem%NcellnodesPerCell localCellnodeID = theMesh%elem%cell(n,i) if (localCellnodeID <= FE_NmatchingNodes(theMesh%elem%geomType)) then ! this cell node is a matching node - matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) - if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNodeID = mesh_element(4+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) else ! this cell node is no matching node - if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + if (localCellnode2globalCellnode(localCellnodeID) == 0) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) endif @@ -1045,10 +1045,10 @@ subroutine mesh_build_cellconnectivity enddo enddo - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnodeParent(2,mesh_Ncellnodes)) + allocate(mesh_cellnode(3,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) + forall(n = 1:mesh_Ncellnodes) mesh_cellnodeParent(1,n) = cellnodeParent(1,n) mesh_cellnodeParent(2,n) = cellnodeParent(2,n) endforall @@ -1064,11 +1064,11 @@ end subroutine mesh_build_cellconnectivity function mesh_build_cellnodes(nodes,Ncellnodes) implicit none - integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + integer, intent(in) :: Ncellnodes !< requested number of cellnodes real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes - integer(pInt) :: & + integer :: & e,n,m, & localCellnodeID real(pReal), dimension(3) :: & @@ -1076,12 +1076,12 @@ function mesh_build_cellnodes(nodes,Ncellnodes) mesh_build_cellnodes = 0.0_pReal !$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes + do n = 1,Ncellnodes ! loop over cell nodes e = mesh_cellnodeParent(1,n) localCellnodeID = mesh_cellnodeParent(2,n) myCoords = 0.0_pReal - do m = 1_pInt,theMesh%elem%nNodes - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + do m = 1,theMesh%elem%nNodes + myCoords = myCoords + nodes(1:3,mesh_element(4+m,e)) & * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) enddo mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) @@ -1106,26 +1106,26 @@ subroutine mesh_build_ipVolumes math_areaTriangle implicit none - integer(pInt) :: e,t,g,c,i,m,f,n + integer :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume allocate(mesh_ipVolume(theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,theMesh%nElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,theMesh%nElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType select case (c) - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + case (1) ! 2D 3node + forall (i = 1:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) - case (2_pInt) ! 2D 4node - forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + case (2) ! 2D 4node + forall (i = 1:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) & @@ -1133,18 +1133,18 @@ subroutine mesh_build_ipVolumes mesh_cellnode(1:3,mesh_cell(4,i,e)), & mesh_cellnode(1:3,mesh_cell(1,i,e))) - case (3_pInt) ! 3D 4node - forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + case (3) ! 3D 4node + forall (i = 1:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e)), & mesh_cellnode(1:3,mesh_cell(4,i,e))) - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + do i = 1,theMesh%elem%nIPs ! loop over ips=cells in this element subvolume = 0.0_pReal - forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(f = 1:FE_NipNeighbors(c), n = 1:FE_NcellnodesPerCellface(c)) & subvolume(n,f) = math_volTetrahedron(& mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & @@ -1175,20 +1175,20 @@ end subroutine mesh_build_ipVolumes subroutine mesh_build_ipCoordinates implicit none - integer(pInt) :: e,t,g,c,i,n + integer :: e,t,g,c,i,n real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,theMesh%nElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,theMesh%nElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType - do i = 1_pInt,theMesh%elem%nIPs + do i = 1,theMesh%elem%nIPs myCoords = 0.0_pReal - do n = 1_pInt,theMesh%elem%nCellnodesPerCell + do n = 1,theMesh%elem%nCellnodesPerCell myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) enddo mesh_ipCoordinates(1:3,i,e) = myCoords / real(theMesh%elem%nCellnodesPerCell,pReal) @@ -1205,16 +1205,16 @@ end subroutine mesh_build_ipCoordinates pure function mesh_cellCenterCoordinates(ip,el) implicit none - integer(pInt), intent(in) :: el, & !< element number + integer, intent(in) :: el, & !< element number ip !< integration point number real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell - integer(pInt) :: t,g,c,n + integer :: t,g,c,n - t = mesh_element(2_pInt,el) ! get element type + t = mesh_element(2,el) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType mesh_cellCenterCoordinates = 0.0_pReal - do n = 1_pInt,theMesh%elem%nCellnodesPerCell + do n = 1,theMesh%elem%nCellnodesPerCell mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) enddo mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(theMesh%elem%nCellnodesPerCell,pReal) @@ -1233,24 +1233,24 @@ subroutine mesh_build_ipAreas math_cross implicit none - integer(pInt) :: e,t,g,c,i,f,n,m + integer :: e,t,g,c,i,f,n,m real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal allocate(mesh_ipArea(theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,theMesh%nElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,theMesh%nElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType select case (c) - case (1_pInt,2_pInt) ! 2D 3 or 4 node - do i = 1_pInt,theMesh%elem%nIPs - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (1,2) ! 2D 3 or 4 node + do i = 1,theMesh%elem%nIPs + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector @@ -1260,10 +1260,10 @@ subroutine mesh_build_ipAreas enddo enddo - case (3_pInt) ! 3D 4node - do i = 1_pInt,theMesh%elem%nIPs - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (3) ! 3D 4node + do i = 1,theMesh%elem%nIPs + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal = math_cross(nodePos(1:3,2) - nodePos(1:3,1), & nodePos(1:3,3) - nodePos(1:3,1)) @@ -1272,17 +1272,17 @@ subroutine mesh_build_ipAreas enddo enddo - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node ! for this cell type we get the normal of the quadrilateral face as an average of ! four normals of triangular subfaces; since the face consists only of two triangles, ! the sum has to be divided by two; this whole prcedure tries to compensate for ! probable non-planar cell surfaces m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,theMesh%elem%nIPs - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + do i = 1,theMesh%elem%nIPs + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(n = 1:FE_NcellnodesPerCellface(c)) & normals(1:3,n) = 0.5_pReal & * math_cross(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) @@ -1305,41 +1305,41 @@ end subroutine mesh_build_ipAreas subroutine mesh_build_nodeTwins implicit none - integer(pInt) dir, & ! direction of periodicity + integer dir, & ! direction of periodicity node, & minimumNode, & maximumNode, & n1, & n2 - integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes + integer, dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension tolerance ! tolerance below which positions are assumed identical real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates logical, dimension(mesh_Nnodes) :: unpaired allocate(mesh_nodeTwins(3,mesh_Nnodes)) - mesh_nodeTwins = 0_pInt + mesh_nodeTwins = 0 tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal - do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z + do dir = 1,3 ! check periodicity in directions of x,y,z if (mesh_periodicSurface(dir)) then ! only if periodicity is requested !*** find out which nodes sit on the surface !*** and have a minimum or maximum position in this dimension - minimumNodes = 0_pInt - maximumNodes = 0_pInt + minimumNodes = 0 + maximumNodes = 0 minCoord = minval(mesh_node0(dir,:)) maxCoord = maxval(mesh_node0(dir,:)) - do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes + do node = 1,mesh_Nnodes ! loop through all nodes and find surface nodes if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then - minimumNodes(1) = minimumNodes(1) + 1_pInt - minimumNodes(minimumNodes(1)+1_pInt) = node + minimumNodes(1) = minimumNodes(1) + 1 + minimumNodes(minimumNodes(1)+1) = node elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then - maximumNodes(1) = maximumNodes(1) + 1_pInt - maximumNodes(maximumNodes(1)+1_pInt) = node + maximumNodes(1) = maximumNodes(1) + 1 + maximumNodes(maximumNodes(1)+1) = node endif enddo @@ -1347,11 +1347,11 @@ subroutine mesh_build_nodeTwins !*** find the corresponding node on the other side with the same position in this dimension unpaired = .true. - do n1 = 1_pInt,minimumNodes(1) - minimumNode = minimumNodes(n1+1_pInt) + do n1 = 1,minimumNodes(1) + minimumNode = minimumNodes(n1+1) if (unpaired(minimumNode)) then - do n2 = 1_pInt,maximumNodes(1) - maximumNode = maximumNodes(n2+1_pInt) + do n2 = 1,maximumNodes(1) + maximumNode = maximumNodes(n2+1) distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) mesh_nodeTwins(dir,minimumNode) = maximumNode @@ -1382,24 +1382,24 @@ subroutine mesh_build_sharedElems n, & ! node index per element myDim, & ! dimension index nodeTwin ! node twin in the specified dimension - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt), dimension(:), allocatable :: node_seen + integer, dimension (mesh_Nnodes) :: node_count + integer, dimension(:), allocatable :: node_seen allocate(node_seen(maxval(FE_NmatchingNodes))) - node_count = 0_pInt + node_count = 0 - do e = 1_pInt,theMesh%nElems + do e = 1,theMesh%nElems g = theMesh%elem%geomType - node_seen = 0_pInt ! reset node duplicates - do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element + node_seen = 0 ! reset node duplicates + do n = 1,FE_NmatchingNodes(g) ! check each node of element node = mesh_element(4+n,e) if (all(node_seen /= node)) then - node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it - do myDim = 1_pInt,3_pInt ! check in each dimension... + node_count(node) = node_count(node) + 1 ! if FE node not yet encountered -> count it + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) & ! if I am a twin of some node... - node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node + if (nodeTwin > 0) & ! if I am a twin of some node... + node_count(nodeTwin) = node_count(nodeTwin) + 1 ! -> count me again for the twin node enddo endif node_seen(n) = node ! remember this node to be counted already @@ -1408,20 +1408,20 @@ subroutine mesh_build_sharedElems mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node - allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0) - do e = 1_pInt,theMesh%nElems + do e = 1,theMesh%nElems g = theMesh%elem%geomType - node_seen = 0_pInt - do n = 1_pInt,FE_NmatchingNodes(g) - node = mesh_element(4_pInt+n,e) + node_seen = 0 + do n = 1,FE_NmatchingNodes(g) + node = mesh_element(4+n,e) if (all(node_seen /= node)) then - mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements - mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id - do myDim = 1_pInt,3_pInt ! check in each dimension... + mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1 ! count for each node the connected elements + mesh_sharedElem(mesh_sharedElem(1,node)+1,node) = e ! store the respective element id + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) then ! if i am a twin of some node... - mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin + if (nodeTwin > 0) then ! if i am a twin of some node... + mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1 ! ...count me again for the twin mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id endif enddo @@ -1441,7 +1441,7 @@ subroutine mesh_build_ipNeighborhood math_mul3x3 implicit none - integer(pInt) :: myElem, & ! my CP element index + integer :: myElem, & ! my CP element index myIP, & myType, & ! my element type myFace, & @@ -1459,26 +1459,26 @@ subroutine mesh_build_ipNeighborhood neighboringIP, & neighboringElem, & pointingToMe - integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & - linkedNodes = 0_pInt, & + integer, dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0, & matchingNodes logical checkTwins allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems)) - mesh_ipNeighborhood = 0_pInt + mesh_ipNeighborhood = 0 - do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + do myElem = 1,theMesh%nElems ! loop over cpElems myType = theMesh%elem%geomType - do myIP = 1_pInt,theMesh%elem%nIPs + do myIP = 1,theMesh%elem%nIPs - do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP + do neighbor = 1,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP neighboringIPkey = theMesh%elem%IPneighbor(neighbor,myIP) !*** if the key is positive, the neighbor is inside the element !*** that means, we have already found our neighboring IP - if (neighboringIPkey > 0_pInt) then + if (neighboringIPkey > 0) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey @@ -1486,33 +1486,33 @@ subroutine mesh_build_ipNeighborhood !*** if the key is negative, the neighbor resides in a neighboring element !*** that means, we have to look through the face indicated by the key and see which element is behind that face - elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP + elseif (neighboringIPkey < 0) then ! neighboring element's IP myFace = -neighboringIPkey call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match - if (matchingElem > 0_pInt) then ! found match? + if (matchingElem > 0) then ! found match? neighboringType = theMesh%elem%geomType !*** trivial solution if neighbor has only one IP - if (theMesh%elem%nIPs == 1_pInt) then + if (theMesh%elem%nIPs == 1) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1 cycle endif !*** find those nodes which build the link to the neighbor - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt - do a = 1_pInt,theMesh%elem%maxNnodeAtIP + NlinkedNodes = 0 + linkedNodes = 0 + do a = 1,theMesh%elem%maxNnodeAtIP anchor = theMesh%elem%NnodeAtIP(a,myIP) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? - NlinkedNodes = NlinkedNodes + 1_pInt - linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node + NlinkedNodes = NlinkedNodes + 1 + linkedNodes(NlinkedNodes) = mesh_element(4+anchor,myElem) ! CP id of anchor node else ! something went wrong with the linkage, since not all anchors sit on my face - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt + NlinkedNodes = 0 + linkedNodes = 0 exit endif endif @@ -1522,18 +1522,18 @@ subroutine mesh_build_ipNeighborhood !*** and try to find an ip with matching nodes !*** also try to match with node twins - checkCandidateIP: do candidateIP = 1_pInt,theMesh%elem%nIPs - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt - do a = 1_pInt,theMesh%elem%maxNnodeAtIP + checkCandidateIP: do candidateIP = 1,theMesh%elem%nIPs + NmatchingNodes = 0 + matchingNodes = 0 + do a = 1,theMesh%elem%maxNnodeAtIP anchor = theMesh%elem%NnodeAtIP(a,candidateIP) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? - NmatchingNodes = NmatchingNodes + 1_pInt + NmatchingNodes = NmatchingNodes + 1 matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node else ! no matching, because not all nodes sit on the matching face - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt + NmatchingNodes = 0 + matchingNodes = 0 exit endif endif @@ -1545,7 +1545,7 @@ subroutine mesh_build_ipNeighborhood !*** check "normal" nodes whether they match or not checkTwins = .false. - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode checkTwins = .true. exit ! no need to search further @@ -1556,9 +1556,9 @@ subroutine mesh_build_ipNeighborhood if(checkTwins) then dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) - if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... + if (twin_of_linkedNode == 0 .or. & ! twin of linkedNode does not exist... all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode cycle checkCandidateIP ! ... then check next candidateIP endif @@ -1576,15 +1576,15 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + do myElem = 1,theMesh%nElems ! loop over cpElems myType = theMesh%elem%geomType - do myIP = 1_pInt,theMesh%elem%nIPs - do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP + do myIP = 1,theMesh%elem%nIPs + do neighbor = 1,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) - if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... + if (neighboringElem > 0 .and. neighboringIP > 0) then ! if neighbor exists ... neighboringType = theMesh%elem%geomType - do pointingToMe = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! find neighboring index that points from my neighbor to myself + do pointingToMe = 1,FE_NipNeighbors(theMesh%elem%cellType) ! find neighboring index that points from my neighbor to myself if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& @@ -1607,34 +1607,34 @@ subroutine mesh_build_ipNeighborhood subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) implicit none -integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID +integer, intent(out) :: matchingElem, & ! matching CP element ID matchingFace ! matching face ID -integer(pInt), intent(in) :: face, & ! face ID +integer, intent(in) :: face, & ! face ID elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & +integer, dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & myFaceNodes ! global node ids on my face -integer(pInt) :: myType, & +integer :: myType, & candidateType, & candidateElem, & candidateFace, & candidateFaceNode, & minNsharedElems, & NsharedElems, & - lonelyNode = 0_pInt, & + lonelyNode = 0, & i, & n, & dir ! periodicity direction -integer(pInt), dimension(:), allocatable :: element_seen +integer, dimension(:), allocatable :: element_seen logical checkTwins -matchingElem = 0_pInt -matchingFace = 0_pInt -minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case +matchingElem = 0 +matchingFace = 0 +minNsharedElems = mesh_maxNsharedElems + 1 ! init to worst case myType =theMesh%elem%geomType -do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face - myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node - NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node +do n = 1,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face + myFaceNodes(n) = mesh_element(4+FE_face(n,face,myType),elem) ! CP id of face node + NsharedElems = mesh_sharedElem(1,myFaceNodes(n)) ! figure # shared elements for this node if (NsharedElems < minNsharedElems) then minNsharedElems = NsharedElems ! remember min # shared elems lonelyNode = n ! remember most lonely node @@ -1642,33 +1642,33 @@ do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) enddo allocate(element_seen(minNsharedElems)) -element_seen = 0_pInt +element_seen = 0 -checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements - candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem +checkCandidate: do i = 1,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1+i,myFaceNodes(lonelyNode)) ! present candidate elem if (all(element_seen /= candidateElem)) then ! element seen for the first time? element_seen(i) = candidateElem candidateType = theMesh%elem%geomType -checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate +checkCandidateFace: do candidateFace = 1,FE_maxNipNeighbors ! check each face of candidate if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face cycle checkCandidateFace endif checkTwins = .false. - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face - candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes checkTwins = .true. ! perhaps the twin nodes do match exit endif enddo if(checkTwins) then -checkCandidateFaceTwins: do dir = 1_pInt,3_pInt - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face +checkCandidateFaceTwins: do dir = 1,3 + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either - if (dir == 3_pInt) then + if (dir == 3) then cycle checkCandidateFace else cycle checkCandidateFaceTwins ! try twins in next dimension @@ -1693,7 +1693,7 @@ end subroutine mesh_build_ipNeighborhood !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation !-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) +integer function FE_mapElemtype(what) use IO, only: IO_lc, IO_error implicit none @@ -1701,36 +1701,36 @@ integer(pInt) function FE_mapElemtype(what) select case (IO_lc(what)) case ( '6') - FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle + FE_mapElemtype = 1 ! Two-dimensional Plane Strain Triangle case ( '155', & '125', & '128') - FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) + FE_mapElemtype = 2 ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) case ( '11') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + FE_mapElemtype = 3 ! Arbitrary Quadrilateral Plane-strain case ( '27') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + FE_mapElemtype = 4 ! Plane Strain, Eight-node Distorted Quadrilateral case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + FE_mapElemtype = 5 ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration case ( '134') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + FE_mapElemtype = 6 ! Three-dimensional Four-node Tetrahedron case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + FE_mapElemtype = 7 ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + FE_mapElemtype = 8 ! Three-dimensional Ten-node Tetrahedron case ( '136') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + FE_mapElemtype = 9 ! Three-dimensional Arbitrarily Distorted Pentahedral case ( '117', & '123') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + FE_mapElemtype = 10 ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration case ( '7') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + FE_mapElemtype = 11 ! Three-dimensional Arbitrarily Distorted Brick case ( '57') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + FE_mapElemtype = 12 ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration case ( '21') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + FE_mapElemtype = 13 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + call IO_error(error_ID=190,ext_msg=IO_lc(what)) end select end function FE_mapElemtype @@ -1743,13 +1743,13 @@ end function FE_mapElemtype subroutine mesh_build_FEdata implicit none - integer(pInt) :: me - allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + integer :: me + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0) ! *** FE_cellface *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) reshape(int([& 2,3, & @@ -1757,7 +1757,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) reshape(int([& 2,3, & @@ -1766,7 +1766,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) reshape(int([& 1,3,2, & @@ -1775,7 +1775,7 @@ subroutine mesh_build_FEdata 1,4,3 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) reshape(int([& 2,3,7,6, & @@ -1794,18 +1794,18 @@ end subroutine mesh_build_FEdata !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) +integer function mesh_FEasCP(what,myID) use IO, only: & IO_lc implicit none character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID + integer, intent(in) :: myID - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center + integer, dimension(:,:), pointer :: lookupMap + integer :: lower,upper,center - mesh_FEasCP = 0_pInt + mesh_FEasCP = 0 select case(IO_lc(what(1:4))) case('elem') lookupMap => mesh_mapFEtoCPelem @@ -1815,24 +1815,24 @@ integer(pInt) function mesh_FEasCP(what,myID) return endselect - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) + lower = 1 + upper = int(size(lookupMap,2),pInt) - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) + if (lookupMap(1,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2,lower) return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) + elseif (lookupMap(1,upper) == myID) then + mesh_FEasCP = lookupMap(2,upper) return endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then + binarySearch: do while (upper-lower > 1) + center = (lower+upper)/2 + if (lookupMap(1,center) < myID) then lower = center - elseif (lookupMap(1_pInt,center) > myID) then + elseif (lookupMap(1,center) > myID) then upper = center else - mesh_FEasCP = lookupMap(2_pInt,center) + mesh_FEasCP = lookupMap(2,center) exit endif enddo binarySearch diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index da00db2b2..494bbc6f0 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -5,23 +5,21 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_anisoBrittle - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? source_damage_anisoBrittle_instance !< instance of source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_anisoBrittle_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoBrittle_output !< name of each post result output - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family enum, bind(c) @@ -40,9 +38,9 @@ module source_damage_anisoBrittle critLoad real(pReal), dimension(:,:,:,:), allocatable :: & cleavage_systems - integer(pInt) :: & + integer :: & totalNcleavage - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & Ncleavage integer(kind(undefined_ID)), allocatable, dimension(:) :: & outputID !< ID of each post result output @@ -65,8 +63,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -91,10 +87,10 @@ subroutine source_damage_anisoBrittle_init lattice_SchmidMatrix_cleavage, & lattice_maxNcleavageFamily - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p ,i - integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p ,i + integer, dimension(0), parameter :: emptyIntArray = [integer::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -105,14 +101,14 @@ subroutine source_damage_anisoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' - Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) - if (Ninstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID)) + if (Ninstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0_pInt) - allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt) + allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0) + allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0) do phase = 1, material_Nphase source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID) do source = 1, phase_Nsources(phase) @@ -121,11 +117,11 @@ subroutine source_damage_anisoBrittle_init enddo enddo - allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0) allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0) allocate(param(Ninstance)) @@ -162,18 +158,18 @@ subroutine source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('anisobrittle_drivingforce') - source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1_pInt + source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1 source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -189,7 +185,7 @@ subroutine source_damage_anisoBrittle_init sourceOffset = source_damage_anisoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -217,13 +213,13 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) lattice_maxNcleavageFamily, & lattice_NcleavageSystem - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & S - integer(pInt) :: & + integer :: & phase, & constituent, & instance, & @@ -243,10 +239,10 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal - index = 1_pInt - do f = 1_pInt,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family + index = 1 + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) @@ -263,7 +259,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & param(instance)%critDisp(index) - index = index + 1_pInt + index = index + 1 enddo enddo @@ -276,7 +272,7 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -284,7 +280,7 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & sourceOffset sourceOffset = source_damage_anisoBrittle_offset(phase) @@ -303,27 +299,27 @@ function source_damage_anisoBrittle_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & source_damage_anisoBrittle_instance(phase)))) :: & source_damage_anisoBrittle_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_anisoBrittle_postResults(c+1_pInt) = & + source_damage_anisoBrittle_postResults(c+1) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) - c = c + 1_pInt + c = c + 1 end select enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 8f6d68a88..c83f61a9d 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -5,20 +5,18 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_anisoDuctile - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? source_damage_anisoDuctile_instance !< instance of damage source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_anisoDuctile_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoDuctile_output !< name of each post result output @@ -59,8 +57,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoDuctile_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -82,11 +78,11 @@ subroutine source_damage_anisoDuctile_init config_phase - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p ,i + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p ,i - integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer, dimension(0), parameter :: emptyIntArray = [integer::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -98,13 +94,13 @@ subroutine source_damage_anisoDuctile_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID) - if (Ninstance == 0_pInt) return + if (Ninstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0_pInt) - allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0_pInt) + allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0) + allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0) do phase = 1, size(config_phase) source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID) do source = 1, phase_Nsources(phase) @@ -113,7 +109,7 @@ subroutine source_damage_anisoDuctile_init enddo enddo - allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' @@ -146,18 +142,18 @@ subroutine source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('anisoductile_drivingforce') - source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1_pInt + source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1 source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -173,7 +169,7 @@ subroutine source_damage_anisoDuctile_init instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -193,11 +189,11 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) damage, & damageMapping - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element - integer(pInt) :: & + integer :: & phase, & constituent, & sourceOffset, & @@ -229,7 +225,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -237,7 +233,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & sourceOffset sourceOffset = source_damage_anisoDuctile_offset(phase) @@ -256,27 +252,27 @@ function source_damage_anisoDuctile_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, & source_damage_anisoDuctile_instance(phase)))) :: & source_damage_anisoDuctile_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_anisoDuctile_postResults(c+1_pInt) = & + source_damage_anisoDuctile_postResults(c+1) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) - c = c + 1_pInt + c = c + 1 end select enddo diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index b60218458..90aa5089f 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -5,20 +5,18 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_isoBrittle - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_isoBrittle_offset, & !< which source is my current damage mechanism? source_damage_isoBrittle_instance !< instance of damage source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_isoBrittle_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoBrittle_output !< name of each post result output enum, bind(c) @@ -53,8 +51,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoBrittle_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -75,9 +71,9 @@ subroutine source_damage_isoBrittle_init material_Nphase - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p,i - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p,i + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -88,14 +84,14 @@ subroutine source_damage_isoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' - Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) - if (Ninstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID)) + if (Ninstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_isoBrittle_offset(material_Nphase), source=0_pInt) - allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt) + allocate(source_damage_isoBrittle_offset(material_Nphase), source=0) + allocate(source_damage_isoBrittle_instance(material_Nphase), source=0) do phase = 1, material_Nphase source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID) do source = 1, phase_Nsources(phase) @@ -104,7 +100,7 @@ subroutine source_damage_isoBrittle_init enddo enddo - allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_isoBrittle_output = '' @@ -129,18 +125,18 @@ subroutine source_damage_isoBrittle_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('isobrittle_drivingforce') - source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1_pInt + source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1 source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -156,7 +152,7 @@ subroutine source_damage_isoBrittle_init instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,1_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,1) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -175,7 +171,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) math_sym33to6, & math_I3 - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element @@ -183,7 +179,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) Fe real(pReal), intent(in), dimension(6,6) :: & C - integer(pInt) :: & + integer :: & phase, constituent, instance, sourceOffset real(pReal) :: & strain(6), & @@ -219,7 +215,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -227,7 +223,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & instance, sourceOffset instance = source_damage_isoBrittle_instance(phase) @@ -248,25 +244,25 @@ function source_damage_isoBrittle_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, & source_damage_isoBrittle_instance(phase)))) :: & source_damage_isoBrittle_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_isoBrittle_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) + source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent) c = c + 1 end select diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 149803693..9cd4e5d26 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -5,20 +5,18 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_isoDuctile - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_isoDuctile_offset, & !< which source is my current damage mechanism? source_damage_isoDuctile_instance !< instance of damage source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_isoDuctile_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoDuctile_output !< name of each post result output @@ -53,8 +51,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoDuctile_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -75,8 +71,8 @@ subroutine source_damage_isoDuctile_init material_Nphase - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p,i + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p,i character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -89,13 +85,13 @@ subroutine source_damage_isoDuctile_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_damage_isoDuctile_ID) - if (Ninstance == 0_pInt) return + if (Ninstance == 0) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt) - allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt) + allocate(source_damage_isoDuctile_offset(material_Nphase), source=0) + allocate(source_damage_isoDuctile_instance(material_Nphase), source=0) do phase = 1, material_Nphase source_damage_isoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoDuctile_ID) do source = 1, phase_Nsources(phase) @@ -104,7 +100,7 @@ subroutine source_damage_isoDuctile_init enddo enddo - allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_isoDuctile_output = '' @@ -129,18 +125,18 @@ subroutine source_damage_isoDuctile_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('isoductile_drivingforce') - source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1_pInt + source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1 source_damage_isoDuctile_output(i,source_damage_isoDuctile_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -155,7 +151,7 @@ subroutine source_damage_isoDuctile_init instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -176,11 +172,11 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) damage, & damageMapping - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element - integer(pInt) :: & + integer :: & phase, constituent, instance, homog, sourceOffset, damageOffset phase = phaseAt(ipc,ip,el) @@ -204,7 +200,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -212,7 +208,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & sourceOffset sourceOffset = source_damage_isoDuctile_offset(phase) @@ -231,25 +227,25 @@ function source_damage_isoDuctile_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_isoDuctile_sizePostResult(:, & source_damage_isoDuctile_instance(phase)))) :: & source_damage_isoDuctile_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_isoDuctile_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) + source_damage_isoDuctile_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent) c = c + 1 end select