1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program is distributed in the hope that it will be useful,
11!     but WITHOUT ANY WARRANTY; without even the implied warranty of
12!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13!     GNU General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19      subroutine crackpropagations(inpc,textpart,nmethod,iperturb,
20     &  isolver,istep,
21     &  istat,n,tinc,tper,tmin,tmax,idrct,iline,ipol,inl,ipoinp,inp,
22     &  ithermal,cs,ics,tieset,istartset,
23     &  iendset,ialset,ipompc,nodempc,coefmpc,nmpc,nmpc_,ikmpc,
24     &  ilmpc,mpcfree,mcs,set,nset,labmpc,ipoinpc,iexpl,nef,ttime,
25     &  iaxial,nelcon,nmat,tincf,ier,jobnamec,matname)
26!
27!     reading the input deck: *CRACKPROPAGATION
28!
29!     isolver=0: SPOOLES
30!             2: iterative solver with diagonal scaling
31!             3: iterative solver with Cholesky preconditioning
32!             4: sgi solver
33!             5: TAUCS
34!             7: pardiso
35!             8: pastix
36!
37      implicit none
38!
39      logical timereset
40!
41      character*1 inpc(*)
42      character*20 labmpc(*),solver
43      character*80 material,matname(*)
44      character*81 set(*),tieset(3,*)
45      character*132 textpart(16),jobnamec(*)
46!
47      integer nmethod,iperturb(*),isolver,istep,istat,n,key,i,idrct,
48     &  iline,ipol,inl,ipoinp(2,*),inp(3,*),ithermal(*),ics(*),iexpl,
49     &  istartset(*),iendset(*),ialset(*),ipompc(*),nodempc(3,*),
50     &  nmpc,nmpc_,ikmpc(*),ilmpc(*),mpcfree,nset,mcs,ipoinpc(0:*),
51     &  nef,iaxial,nelcon(2,*),nmat,ier,j,k,l
52!
53      real*8 tinc,tper,tmin,tmax,cs(17,*),coefmpc(*),ttime,tincf
54!
55      idrct=0
56      tinc=0.d0
57      tper=0.d0
58      tmin=0.d0
59      tmax=3.5d0
60      timereset=.false.
61!
62      if(istep.ne.1) then
63         write(*,*) '*ERROR reading *CRACK PROPAGATION:'
64         write(*,*) '       *CRACK PROPAGATION can only be used'
65         write(*,*) '       within the first STEP'
66         ier=1
67         return
68      endif
69!
70      do i=2,n
71         if(textpart(i)(1:9).eq.'MATERIAL=') then
72            material=textpart(i)(10:89)
73          elseif(textpart(i)(1:7).eq.'LENGTH=') then
74            if(textpart(i)(8:17).eq.'CUMULATIVE') then
75              tmax=1.5d0
76            elseif(textpart(i)(8:19).eq.'INTERSECTION') then
77              tmax=2.5d0
78            elseif(textpart(i)(8:16).eq.'PRINCIPAL') then
79              tmax=3.5d0
80            else
81              write(*,*)
82     &             '*ERROR reading *CRACK PROPAGATION: nonexistent'
83              write(*,*) '       crack length determination method'
84              write(*,*) '  '
85              call inputerror(inpc,ipoinpc,iline,
86     &             "*CRACK PROPAGATION%",ier)
87            endif
88         elseif(textpart(i)(1:6).eq.'INPUT=') then
89            jobnamec(4)(1:126)=textpart(i)(7:132)
90            jobnamec(4)(127:132)='      '
91            loop1: do j=1,126
92               if(jobnamec(4)(j:j).eq.'"') then
93                  do k=j+1,126
94                     if(jobnamec(4)(k:k).eq.'"') then
95                        do l=k-1,126
96                           jobnamec(4)(l:l)=' '
97                           exit loop1
98                        enddo
99                     endif
100                     jobnamec(4)(k-1:k-1)=jobnamec(4)(k:k)
101                  enddo
102                  jobnamec(4)(126:126)=' '
103               endif
104            enddo loop1
105         else
106            write(*,*)
107     & '*WARNING reading *CRACK PROPAGATION: parameter not recognized:'
108            write(*,*) '         ',
109     &                 textpart(i)(1:index(textpart(i),' ')-1)
110            call inputwarning(inpc,ipoinpc,iline,
111     &"*CRACKPROPAGATION%")
112         endif
113      enddo
114!
115!     check for the existence of the material
116!
117      do i=1,nmat
118         if(matname(i).eq.material) exit
119      enddo
120      if(i.gt.nmat) then
121         write(*,*)
122     &      '*ERROR reading *CRACK PROPAGATION: nonexistent material'
123         write(*,*) '  '
124         call inputerror(inpc,ipoinpc,iline,
125     &        "*CRACK PROPAGATION%",ier)
126         return
127       endif
128!
129!     material name is stored in tmin
130!
131      tmin=i+0.5d0
132!
133      nmethod=15
134!
135      call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
136     &     ipoinp,inp,ipoinpc)
137      if((istat.lt.0).or.(key.eq.1)) then
138            write(*,*) '*ERROR reading *CRACK PROPAGATION:'
139            write(*,*)
140     &           '         a crack propagation analysis is requested'
141            write(*,*)
142     &           '         but no maximum crack increment is specified'
143            ier=1
144            return
145      endif
146!
147!     tinc: maximum crack increment
148!
149      if(n.gt.0) then
150        read(textpart(1)(1:20),'(f20.0)',iostat=istat) tinc
151        if(istat.gt.0) then
152          call inputerror(inpc,ipoinpc,iline,
153     &         "*CRACK PROPAGATION%",ier)
154          return
155        endif
156      endif
157!
158!     default: max. increment = min(a/5,rcur/5)
159!
160      if(tinc.le.0.d0) then
161        tinc=1.d30
162      endif
163!
164!     tper: maximum deflection angle (in degrees)
165!
166      if(n.gt.1) then
167        read(textpart(2)(1:20),'(f20.0)',iostat=istat) tper
168        if(istat.gt.0) then
169          call inputerror(inpc,ipoinpc,iline,
170     &         "*CRACK PROPAGATION%",ier)
171          return
172        endif
173      endif
174!
175!     default: no maximum deflection angle
176!
177      if(tper.le.0.d0) then
178        tper=90.d0
179      endif
180!
181      call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
182     &     ipoinp,inp,ipoinpc)
183!
184      return
185      end
186
187