├── README.md ├── chap04 ├── p41.f03 ├── p41_1.dat ├── p41_2.dat ├── p42.f03 ├── p42_1.dat ├── p42_2.dat ├── p43.f03 ├── p43_1.dat ├── p43_2.dat ├── p44.f03 ├── p44_1.dat ├── p44_2.dat ├── p45.f03 ├── p45_1.dat ├── p45_2.dat ├── p46.f03 ├── p46_1.dat ├── p46_2.dat ├── p47.dat └── p47.f03 ├── chap05 ├── p51.f03 ├── p51.m ├── p51_1.dat ├── p51_2.dat ├── p51_3.dat ├── p51_4.dat ├── p51_5.dat ├── p52.dat ├── p52.f03 ├── p52.m ├── p53.dat ├── p53.f03 ├── p53.m ├── p54.f03 ├── p54.m ├── p54_1.dat ├── p54_2.dat ├── p54_3.dat ├── p55.dat ├── p55.f03 ├── p55.m ├── p56.dat ├── p56.f03 ├── p56.m ├── p56_1.dat ├── p57.dat ├── p57.f03 ├── result.dat └── sparse_p54.m ├── chap06 ├── p61.dat ├── p61.f03 ├── p61.m ├── p610.dat ├── p610.f03 ├── p611.f03 ├── p611_1.dat ├── p611_2.dat ├── p611_3.dat ├── p612.dat ├── p612.f03 ├── p613.dat ├── p613.f03 ├── p62.dat ├── p62.f03 ├── p63.dat ├── p63.f03 ├── p63.m ├── p64.dat ├── p64.f03 ├── p64.m ├── p65.dat ├── p65.f03 ├── p65.m ├── p66.dat ├── p66.f03 ├── p67.dat ├── p67.f03 ├── p68.dat ├── p68.f03 ├── p69.dat └── p69.f03 ├── chap07 ├── p71.f03 ├── p71_1.dat ├── p71_2.dat ├── p72.f03 ├── p72_1.dat ├── p72_2.dat ├── p73.f03 ├── p73_1.dat ├── p73_2.dat ├── p74.dat ├── p74.f03 ├── p75.dat └── p75.f03 ├── chap08 ├── p81.dat ├── p81.f03 ├── p810.dat ├── p810.f03 ├── p811.dat ├── p811.f03 ├── p81_2.dat ├── p81_3.dat ├── p81_4.dat ├── p81_5.dat ├── p82.dat ├── p82.f03 ├── p83.dat ├── p83.f03 ├── p84.f03 ├── p84_1.dat ├── p84_2.dat ├── p85.dat ├── p85.f03 ├── p86.dat ├── p86.f03 ├── p87.dat ├── p87.f03 ├── p88.dat ├── p88.f03 ├── p89.dat └── p89.f03 ├── chap09 ├── p91.dat ├── p91.f03 ├── p92.dat ├── p92.f03 ├── p93.dat ├── p93.f03 ├── p94.dat ├── p94.f03 ├── p95.dat ├── p95.f03 ├── p96.f03 ├── p96_1.dat └── p96_2.dat ├── chap10 ├── p101.dat ├── p101.f03 ├── p102.f03 ├── p102_1.dat ├── p102_2.dat ├── p103.dat ├── p103.f03 ├── p104.dat └── p104.f03 ├── chap11 ├── p111.dat ├── p111.f03 ├── p112.dat ├── p112.f03 ├── p113.dat ├── p113.f03 ├── p114.dat ├── p114.f03 ├── p115.dat ├── p115.f03 ├── p116.dat ├── p116.f03 ├── p117.dat ├── p117.f03 ├── p118.dat └── p118.f03 └── library ├── geom ├── bc_rect.f03 ├── bc_rect.m ├── create.txt ├── emb_2d_bc.f03 ├── emb_2d_bc.m ├── emb_2d_geom.f03 ├── emb_2d_geom.m ├── emb_3d_bc.f03 ├── emb_3d_geom.f03 ├── fmcoem.f03 ├── fmglem.f03 ├── formnf.f03 ├── formnf.m ├── geom_freesurf.f03 ├── geom_int.f03 ├── geom_rect.f03 ├── geom_rect.m ├── hexahedron_xz.f03 ├── hexahedron_xz.m ├── mesh_ensi.m ├── mesh_size.f03 └── mesh_size.m └── main ├── bandred.f03 ├── bandwidth.f03 ├── banmul.f03 ├── bantmul.f03 ├── beam_ge.f03 ├── beam_km.f03 ├── beam_mm.f03 ├── beamdis.f03 ├── bee8.f03 ├── beemat.f03 ├── beemat.m ├── beemat2.m ├── bisect.f03 ├── bmat_nonaxi.f03 ├── bmat_nonaxi.m ├── checon.f03 ├── checon.m ├── chobk1.f03 ├── chobk2.f03 ├── cholin.f03 ├── comred.f03 ├── comsub.f03 ├── contour.f03 ├── create.txt ├── cross_product.f03 ├── deemat.f03 ├── deemat.m ├── determinant.f03 ├── dismsh.f03 ├── dismsh_ensi.f03 ├── ecmat.f03 ├── elmat.f03 ├── exc_nods.f03 ├── fkdiag.f03 ├── fkdiag.m ├── fmacat.f03 ├── fmdsig.f03 ├── fmkdke.f03 ├── fmplat.f03 ├── fmrmat.f03 ├── form_s.f03 ├── formaa.f03 ├── formkb.f03 ├── formkc.f03 ├── formke.f03 ├── formku.f03 ├── formlump.f03 ├── formm.f03 ├── formm.m ├── formtb.f03 ├── formupv.f03 ├── fsparv.f03 ├── fsparv.m ├── gauss_band.f03 ├── getname.f03 ├── glob_to_axial.f03 ├── glob_to_loc.f03 ├── hinge.f03 ├── interp.f03 ├── invar.f03 ├── invar.m ├── invert.f03 ├── linmul_sky.f03 ├── lnblnk.f03 ├── load_function.f03 ├── loc_to_glob.f03 ├── main_int.f03 ├── mcdpl.f03 ├── mcdpl.m ├── mesh.f03 ├── mesh_ensi.f03 ├── mocouf.f03 ├── mocouf.m ├── mocouq.f03 ├── mocouq.m ├── norm.f03 ├── num_to_g.f03 ├── num_to_g.m ├── out_tecplot.m ├── pin_jointed.f03 ├── pmsh_ensi.f03 ├── rect_km.f03 ├── rigid_jointed.f03 ├── rod_km.f03 ├── rod_mm.f03 ├── sample.f03 ├── sample.m ├── seep4.f03 ├── shape_der.f03 ├── shape_der.m ├── shape_fun.f03 ├── shape_fun.m ├── solve_band.f03 ├── spabac.f03 ├── spabac.m ├── spabac_gauss.f03 ├── sparin.f03 ├── sparin.m ├── sparin_gauss.f03 ├── stability.f03 ├── stiff10.f03 ├── stiff15.f03 ├── stiff3.f03 ├── stiff4.f03 ├── stiff6.f03 ├── vecmsh.f03 ├── vmdpl.f03 └── vmflow.f03 /README.md: -------------------------------------------------------------------------------- 1 | # Programming_FEM 2 | Programming the finite element method 3 | This repo is a Matlab re-written of the fortran code from "Programming the finite element method" I.M. Smith, D.V. Griffiths and L. Margetts, 5th ed., John Wiley & Sons, 2014. 4 | For an easy read in Matlab, the format of input file have changed a little. Please use the file in the repo. -------------------------------------------------------------------------------- /chap04/p41.f03: -------------------------------------------------------------------------------- 1 | PROGRAM p41 2 | !------------------------------------------------------------------------- 3 | ! Program 4.1 One dimensional analysis of axially loaded elastic rods 4 | ! using 2-node rod elements. 5 | !------------------------------------------------------------------------- 6 | USE main 7 | USE geom 8 | IMPLICIT NONE 9 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 10 | INTEGER::fixed_freedoms,i,iel,k,loaded_nodes,ndof=2,nels,neq,nlen,nod=2, & 11 | nodof=1,nn,nprops=1,np_types,nr 12 | REAL(iwp)::penalty=1.0e20_iwp,zero=0.0_iwp 13 | CHARACTER(LEN=15)::argv 14 | !-----------------------dynamic arrays------------------------------------ 15 | INTEGER,ALLOCATABLE::etype(:),g(:),g_g(:,:),kdiag(:),nf(:,:),no(:), & 16 | node(:),num(:) 17 | REAL(iwp),ALLOCATABLE::action(:),eld(:),ell(:),km(:,:),kv(:),loads(:), & 18 | prop(:,:),value(:) 19 | !-----------------------input and initialisation-------------------------- 20 | CALL getname(argv,nlen) 21 | OPEN(10,FILE=argv(1:nlen)//'.dat') 22 | OPEN(11,FILE=argv(1:nlen)//'.res') 23 | READ(10,*)nels,np_types 24 | nn=nels+1 25 | ALLOCATE(g(ndof),num(nod),nf(nodof,nn),etype(nels),ell(nels),eld(ndof), & 26 | km(ndof,ndof),action(ndof),g_g(ndof,nels),prop(nprops,np_types)) 27 | READ(10,*)prop 28 | etype=1 29 | IF(np_types>1)READ(10,*)etype 30 | READ(10,*)ell 31 | nf=1 32 | READ(10,*)nr,(k,nf(:,k),i=1,nr) 33 | CALL formnf(nf) 34 | neq=MAXVAL(nf) 35 | ALLOCATE(kdiag(neq),loads(0:neq)) 36 | kdiag=0 37 | !-----------------------loop the elements to find global arrays sizes----- 38 | elements_1: DO iel=1,nels 39 | num=(/iel,iel+1/) 40 | CALL num_to_g(num,nf,g) 41 | g_g(:,iel)=g 42 | CALL fkdiag(kdiag,g) 43 | END DO elements_1 44 | DO i=2,neq 45 | kdiag(i)=kdiag(i)+kdiag(i-1) 46 | END DO 47 | ALLOCATE(kv(kdiag(neq))) 48 | WRITE(11,'(2(A,I5))') & 49 | " There are",neq," equations and the skyline storage is",kdiag(neq) 50 | !-----------------------global stiffness matrix assembly------------------ 51 | kv=zero 52 | elements_2: DO iel=1,nels 53 | CALL rod_km(km,prop(1,etype(iel)),ell(iel)) 54 | g=g_g(:,iel) 55 | CALL fsparv(kv,km,g,kdiag) 56 | END DO elements_2 57 | !-----------------------read loads and/or displacements------------------- 58 | loads=zero 59 | READ(10,*)loaded_nodes,(k,loads(nf(:,k)),i=1,loaded_nodes) 60 | READ(10,*)fixed_freedoms 61 | IF(fixed_freedoms/=0)THEN 62 | ALLOCATE(node(fixed_freedoms),no(fixed_freedoms),value(fixed_freedoms)) 63 | READ(10,*)(node(i),value(i),i=1,fixed_freedoms) 64 | DO i=1,fixed_freedoms 65 | no(i)=nf(1,node(i)) 66 | END DO 67 | kv(kdiag(no))=kv(kdiag(no))+penalty 68 | loads(no)=kv(kdiag(no))*value 69 | END IF 70 | !-----------------------equation solution -------------------------------- 71 | CALL sparin(kv,kdiag) 72 | CALL spabac(kv,loads,kdiag) 73 | loads(0)=zero 74 | WRITE(11,'(/A)')" Node Disp" 75 | DO k=1,nn 76 | WRITE(11,'(I5,2E12.4)')k,loads(nf(:,k)) 77 | END DO 78 | !-----------------------retrieve element end actions---------------------- 79 | WRITE(11,'(/A)')" Element Actions" 80 | elements_3: DO iel=1,nels 81 | CALL rod_km(km,prop(1,etype(iel)),ell(iel)) 82 | g=g_g(:,iel) 83 | eld=loads(g) 84 | action=MATMUL(km,eld) 85 | WRITE(11,'(I5,2E12.4)')iel,action 86 | END DO elements_3 87 | STOP 88 | END PROGRAM p41 89 | -------------------------------------------------------------------------------- /chap04/p41_1.dat: -------------------------------------------------------------------------------- 1 | 4 1 2 | 100000.0 3 | 0.25 0.25 0.25 0.25 4 | 1 5 | 5 0 6 | 5 7 | 1 -0.625 2 -1.25 3 -1.25 4 -1.25 5 -0.625 8 | 0 9 | 10 | 11 | -------------------------------------------------------------------------------- /chap04/p41_2.dat: -------------------------------------------------------------------------------- 1 | 4 2 2 | 2000.0 1000.0 3 | 2 2 1 1 4 | 0.25 0.25 0.25 0.25 5 | 1 6 | 1 0 7 | 0 8 | 1 9 | 5 0.05 10 | 11 | -------------------------------------------------------------------------------- /chap04/p42.f03: -------------------------------------------------------------------------------- 1 | ! Last change: DV 19 Oct 2004 7:58 pm 2 | PROGRAM p42 3 | !------------------------------------------------------------------------- 4 | ! Program 4.2 Analysis of elastic pin-jointed frames using 2-node rod 5 | ! elements in 2- or 3-dimensions 6 | !------------------------------------------------------------------------- 7 | USE main 8 | IMPLICIT NONE 9 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 10 | INTEGER::fixed_freedoms,i,iel,k,loaded_nodes,ndim,ndof=2,nels,neq,nod=2, & 11 | nodof,nn,nprops=1,np_types,nr,nlen 12 | REAL(iwp)::axial,penalty=1.0e20_iwp,zero=0.0_iwp 13 | !-----------------------dynamic arrays------------------------------------ 14 | INTEGER,ALLOCATABLE::etype(:),g(:),g_g(:,:),g_num(:,:),kdiag(:),nf(:,:), & 15 | no(:),node(:),num(:),sense(:) 16 | REAL(iwp),ALLOCATABLE::action(:),coord(:,:),eld(:),g_coord(:,:),km(:,:), & 17 | kv(:),loads(:),prop(:,:),value(:) 18 | CHARACTER(LEN=15)::argv 19 | !-----------------------input and initialisation-------------------------- 20 | CALL getname(argv,nlen) 21 | OPEN(10,FILE=argv(1:nlen)//'.dat') 22 | OPEN(11,FILE=argv(1:nlen)//'.res') 23 | READ(10,*)nels,nn,ndim,np_types 24 | nodof=ndim 25 | ndof=nod*nodof 26 | ALLOCATE(nf(nodof,nn),km(ndof,ndof),coord(nod,ndim),g_coord(ndim,nn), & 27 | eld(ndof),action(ndof),g_num(nod,nels),num(nod),g(ndof),g_g(ndof,nels),& 28 | etype(nels),prop(nprops,np_types)) 29 | READ(10,*)prop 30 | etype=1 31 | IF(np_types>1)READ(10,*)etype 32 | READ(10,*)g_coord 33 | READ(10,*)g_num 34 | nf=1 35 | READ(10,*)nr,(k,nf(:,k),i=1,nr) 36 | CALL formnf(nf) 37 | neq=MAXVAL(nf) 38 | ALLOCATE(kdiag(neq),loads(0:neq)) 39 | !----------------------loop the elements to find global array sizes------- 40 | kdiag=0 41 | elements_1: DO iel=1,nels 42 | num=g_num(:,iel) 43 | CALL num_to_g(num,nf,g) 44 | g_g(:,iel)=g 45 | CALL fkdiag(kdiag,g) 46 | END DO elements_1 47 | DO i=2,neq 48 | kdiag(i)=kdiag(i)+kdiag(i-1) 49 | END DO 50 | ALLOCATE(kv(kdiag(neq))) 51 | WRITE(11,'(2(A,I5))') & 52 | " There are",neq," equations and the skyline storage is",kdiag(neq) 53 | !-----------------------global stiffness matrix assembly------------------ 54 | kv=zero 55 | elements_2: DO iel=1,nels 56 | num=g_num(:,iel) 57 | coord=TRANSPOSE(g_coord(:,num)) 58 | CALL pin_jointed(km,prop(1,etype(iel)),coord) 59 | g=g_g(:,iel) 60 | CALL fsparv(kv,km,g,kdiag) 61 | END DO elements_2 62 | !-----------------------read loads and/or displacements------------------- 63 | loads=zero 64 | READ(10,*)loaded_nodes,(k,loads(nf(:,k)),i=1,loaded_nodes) 65 | READ(10,*)fixed_freedoms 66 | IF(fixed_freedoms/=0)THEN 67 | ALLOCATE(node(fixed_freedoms),no(fixed_freedoms), & 68 | sense(fixed_freedoms),value(fixed_freedoms)) 69 | READ(10,*)(node(i),sense(i),value(i),i=1,fixed_freedoms) 70 | DO i=1,fixed_freedoms 71 | no(i)=nf(sense(i),node(i)) 72 | END DO 73 | kv(kdiag(no))=kv(kdiag(no))+penalty 74 | loads(no)=kv(kdiag(no))*value 75 | END IF 76 | !-----------------------equation solution -------------------------------- 77 | CALL sparin(kv,kdiag) 78 | CALL spabac(kv,loads,kdiag) 79 | loads(0)=zero 80 | WRITE(11,'(/A)') " Node Displacement(s)" 81 | DO k=1,nn 82 | WRITE(11,'(I5,3E12.4)')k,loads(nf(:,k)) 83 | END DO 84 | !-----------------------retrieve element end actions---------------------- 85 | WRITE(11,'(/A)')" Element Actions" 86 | elements_3: DO iel=1,nels 87 | num=g_num(:,iel) 88 | coord=TRANSPOSE(g_coord(:,num)) 89 | g=g_g(:,iel) 90 | eld=loads(g) 91 | CALL pin_jointed(km,prop(1,etype(iel)),coord) 92 | action=MATMUL(km,eld) 93 | WRITE(11,'(I5,6E12.4)')iel,action 94 | CALL glob_to_axial(axial,action,coord) 95 | WRITE(11,'(A,E12.4)')" Axial force =",axial 96 | END DO elements_3 97 | STOP 98 | END PROGRAM p42 99 | 100 | -------------------------------------------------------------------------------- /chap04/p42_1.dat: -------------------------------------------------------------------------------- 1 | 10 6 2 1 2 | 2.0e5 3 | 0.0 3.0 4.0 0.0 4.0 3.0 4 | 8.0 3.0 8.0 0.0 12.0 0.0 5 | 1 2 1 3 3 4 3 5 3 2 6 | 2 4 2 5 5 4 4 6 5 6 7 | 2 8 | 1 0 0 2 1 0 9 | 1 10 | 6 0.0 -10.0 11 | 0 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /chap04/p42_2.dat: -------------------------------------------------------------------------------- 1 | 4 5 3 1 2 | 5.0e5 3 | 0.0 0.0 0.0 1.25 3.0 0.0 3.5 2.0 0.0 4 | 4.0 1.0 0.0 2.0 1.5 3.0 5 | 1 5 2 5 3 5 4 5 6 | 4 7 | 1 0 0 0 2 0 0 0 3 0 0 0 4 0 0 0 8 | 1 9 | 5 20.0 -20.0 30.0 10 | 1 11 | 5 2 -0.0005 12 | 13 | -------------------------------------------------------------------------------- /chap04/p43.f03: -------------------------------------------------------------------------------- 1 | ! Last change: DV 19 Oct 2004 7:58 pm 2 | PROGRAM p43 3 | !------------------------------------------------------------------------- 4 | ! Program 4.3 Analysis of elastic beams using 2-node beam elements 5 | ! (elastic foundation optional). 6 | !------------------------------------------------------------------------- 7 | USE main 8 | USE geom 9 | IMPLICIT NONE 10 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 11 | INTEGER::fixed_freedoms,i,iel,k,loaded_nodes,ndof=4,nels,neq,nod=2, & 12 | nodof=2,nn,nprops,np_types,nr,nlen 13 | REAL(iwp)::penalty=1.0e20_iwp,zero=0.0_iwp 14 | !-----------------------dynamic arrays------------------------------------ 15 | INTEGER,ALLOCATABLE::etype(:),g(:),g_g(:,:),kdiag(:),nf(:,:),no(:), & 16 | node(:),num(:),sense(:) 17 | REAL(iwp),ALLOCATABLE::action(:),eld(:),ell(:),km(:,:),kv(:),loads(:), & 18 | mm(:,:),prop(:,:),value(:) 19 | CHARACTER(LEN=15)::argv 20 | !-----------------------input and initialisation-------------------------- 21 | CALL getname(argv,nlen) 22 | OPEN(10,FILE=argv(1:nlen)//'.dat') 23 | OPEN(11,FILE=argv(1:nlen)//'.res') 24 | READ(10,*)nels,nprops,np_types 25 | nn=nels+1 26 | ALLOCATE(g(ndof),num(nod),nf(nodof,nn),etype(nels),ell(nels),eld(ndof), & 27 | km(ndof,ndof),mm(ndof,ndof),action(ndof),g_g(ndof,nels), & 28 | prop(nprops,np_types)) 29 | READ(10,*)prop 30 | etype=1 31 | IF(np_types>1)READ(10,*)etype 32 | READ(10,*)ell 33 | nf=1 34 | READ(10,*)nr,(k,nf(:,k),i=1,nr) 35 | CALL formnf(nf) 36 | neq=MAXVAL(nf) 37 | ALLOCATE(kdiag(neq),loads(0:neq)) 38 | !-----------------------loop the elements to find global array sizes------ 39 | kdiag=0 40 | elements_1: DO iel=1,nels 41 | num=(/iel,iel+1/) 42 | CALL num_to_g(num,nf,g) 43 | g_g(:,iel)=g 44 | CALL fkdiag(kdiag,g) 45 | END DO elements_1 46 | DO i=2,neq 47 | kdiag(i)=kdiag(i)+kdiag(i-1) 48 | END DO 49 | ALLOCATE(kv(kdiag(neq))) 50 | WRITE(11,'(2(A,I5))') & 51 | " There are",neq," equations and the skyline storage is",kdiag(neq) 52 | !-----------------------global stiffness matrix assembly------------------ 53 | kv=zero 54 | elements_2: DO iel=1, nels 55 | CALL beam_km(km,prop(1,etype(iel)),ell(iel)) 56 | mm=zero 57 | IF(nprops>1)CALL beam_mm(mm,prop(2,etype(iel)),ell(iel)) 58 | g=g_g(:,iel) 59 | CALL fsparv(kv,km+mm,g,kdiag) 60 | END DO elements_2 61 | !-----------------------read loads and/or displacements------------------- 62 | loads=zero 63 | READ(10,*)loaded_nodes,(k,loads(nf(:,k)),i=1,loaded_nodes) 64 | READ(10,*)fixed_freedoms 65 | IF(fixed_freedoms/=0)THEN 66 | ALLOCATE(node(fixed_freedoms),no(fixed_freedoms), & 67 | sense(fixed_freedoms),value(fixed_freedoms)) 68 | READ(10,*)(node(i),sense(i),value(i),i=1,fixed_freedoms) 69 | DO i=1,fixed_freedoms 70 | no(i)=nf(sense(i),node(i)) 71 | END DO 72 | kv(kdiag(no))=kv(kdiag(no))+penalty 73 | loads(no)=kv(kdiag(no))*value 74 | END IF 75 | !-----------------------equation solution -------------------------------- 76 | CALL sparin(kv,kdiag) 77 | CALL spabac(kv,loads,kdiag) 78 | loads(0)=zero 79 | WRITE(11,'(/A)')" Node Translation Rotation" 80 | DO k=1,nn 81 | WRITE(11,'(I5,2E12.4)')k,loads(nf(:,k)) 82 | END DO 83 | !-----------------------retrieve element end actions---------------------- 84 | WRITE(11,'(/A)')" Element Force Moment Force Moment" 85 | elements_3: DO iel=1,nels 86 | CALL beam_km(km,prop(1,etype(iel)),ell(iel)) 87 | mm=zero 88 | IF(nprops>1)CALL beam_mm(mm,prop(2,etype(iel)),ell(iel)) 89 | g=g_g(:,iel) 90 | eld=loads(g) 91 | action=MATMUL(km+mm,eld) 92 | WRITE(11,'(I5,4E12.4)')iel,action 93 | END DO elements_3 94 | CALL beamdis(loads,nf,0.40_iwp,10,nels,ell,argv,nlen,12) 95 | STOP 96 | END PROGRAM p43 97 | 98 | -------------------------------------------------------------------------------- /chap04/p43_1.dat: -------------------------------------------------------------------------------- 1 | 4 1 2 2 | 4.0e4 2.0e4 3 | 1 1 2 2 4 | 2.5 2.5 3.0 2.0 5 | 2 6 | 1 0 1 4 0 1 7 | 4 8 | 2 -20.0 0.0 3 -6.0 -3.0 9 | 4 -8.8 2.2 5 -1.2 0.53333 10 | 2 11 | 1 2 -0.001 3 1 -0.005 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /chap04/p43_2.dat: -------------------------------------------------------------------------------- 1 | 5 2 5 2 | 1.924e4 0.2 3 | 1.924e4 0.6 4 | 1.924e4 1.0 5 | 1.924e4 1.4 6 | 1.924e4 1.8 7 | 1 2 3 4 5 8 | 2.0 2.0 2.0 2.0 2.0 9 | 0 10 | 1 11 | 1 1.0 0.0 12 | 0 13 | 14 | -------------------------------------------------------------------------------- /chap04/p44.f03: -------------------------------------------------------------------------------- 1 | ! Last change: DV 19 Oct 2004 7:58 pm 2 | PROGRAM p44 3 | !------------------------------------------------------------------------- 4 | ! Program 4.4 Analysis of elastic rigid-jointed frames using 2-node 5 | ! beam/rod elements in 2- or 3-dimensions. 6 | !------------------------------------------------------------------------- 7 | USE main 8 | IMPLICIT NONE 9 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 10 | INTEGER::fixed_freedoms,i,iel,k,loaded_nodes,ndim,ndof,nels,neq,nod=2, & 11 | nodof,nn,nprops,np_types,nr,nlen 12 | REAL(iwp)::penalty=1.0e20_iwp,zero=0.0_iwp 13 | !-----------------------dynamic arrays------------------------------------ 14 | INTEGER,ALLOCATABLE::etype(:),g(:),g_g(:,:),g_num(:,:),kdiag(:),nf(:,:), & 15 | no(:),node(:),num(:),sense(:) 16 | REAL(iwp),ALLOCATABLE::action(:),coord(:,:),eld(:),gamma(:),g_coord(:,:),& 17 | km(:,:),kv(:),loads(:),prop(:,:),value(:) 18 | CHARACTER(LEN=15)::argv 19 | !-----------------------input and initialisation-------------------------- 20 | CALL getname(argv,nlen) 21 | OPEN(10,FILE=argv(1:nlen)//'.dat') 22 | OPEN(11,FILE=argv(1:nlen)//'.res') 23 | READ(10,*)nels,nn,ndim,nprops,np_types 24 | IF(ndim==2)nodof=3 25 | IF(ndim==3)nodof=6 26 | ndof=nod*nodof 27 | ALLOCATE(nf(nodof,nn),km(ndof,ndof),coord(nod,ndim),g_coord(ndim,nn), & 28 | eld(ndof),action(ndof),g_num(nod,nels),num(nod),g(ndof),gamma(nels), & 29 | g_g(ndof,nels),prop(nprops,np_types),etype(nels)) 30 | READ(10,*)prop 31 | etype=1 32 | IF(np_types>1)READ(10,*)etype 33 | IF(ndim==3)READ(10,*)gamma 34 | READ(10,*)g_coord 35 | READ(10,*)g_num 36 | nf=1 37 | READ(10,*)nr,(k,nf(:,k),i=1,nr) 38 | CALL formnf(nf) 39 | neq=MAXVAL(nf) 40 | ALLOCATE(kdiag(neq),loads(0:neq)) 41 | !-----------------------loop the elements to find global array sizes------ 42 | kdiag=0 43 | elements_1: DO iel=1,nels 44 | num=g_num(:,iel) 45 | CALL num_to_g(num,nf,g) 46 | g_g(:,iel)=g 47 | CALL fkdiag(kdiag,g) 48 | END DO elements_1 49 | DO i=2,neq 50 | kdiag(i)=kdiag(i)+kdiag(i-1) 51 | END DO 52 | ALLOCATE(kv(kdiag(neq))) 53 | WRITE(11,'(2(A,I10))') & 54 | " There are",neq," equations and the skyline storage is",kdiag(neq) 55 | !-----------------------global stiffness matrix assembly------------------ 56 | kv=zero 57 | elements_2: DO iel=1,nels 58 | num=g_num(:,iel) 59 | coord=TRANSPOSE(g_coord(:,num)) 60 | CALL rigid_jointed(km,prop,gamma,etype,iel,coord) 61 | g=g_g(:,iel) 62 | CALL fsparv(kv,km,g,kdiag) 63 | END DO elements_2 64 | !-----------------------read loads and/or displacements------------------- 65 | loads=zero 66 | READ(10,*)loaded_nodes,(k,loads(nf(:,k)),i=1,loaded_nodes) 67 | READ(10,*)fixed_freedoms 68 | IF(fixed_freedoms/=0)THEN 69 | ALLOCATE(node(fixed_freedoms),no(fixed_freedoms), & 70 | sense(fixed_freedoms),value(fixed_freedoms)) 71 | READ(10,*)(node(i),sense(i),value(i),i=1,fixed_freedoms) 72 | DO i=1,fixed_freedoms 73 | no(i)=nf(sense(i),node(i)) 74 | END DO 75 | kv(kdiag(no))=kv(kdiag(no))+penalty 76 | loads(no)=kv(kdiag(no))*value 77 | END IF 78 | !-----------------------equation solution -------------------------------- 79 | CALL sparin(kv,kdiag) 80 | CALL spabac(kv,loads,kdiag) 81 | loads(0)=zero 82 | WRITE(11,'(/A)') " Node Displacements and Rotation(s)" 83 | DO k=1,nn 84 | WRITE(11,'(I5,6E12.4)')k,loads(nf(:,k)) 85 | END DO 86 | !-----------------------retrieve element end actions---------------------- 87 | WRITE(11,'(/A)')" Element Actions" 88 | elements_3: DO iel=1,nels 89 | num=g_num(:,iel) 90 | coord=TRANSPOSE(g_coord(:,num)) 91 | g=g_g(:,iel) 92 | eld=loads(g) 93 | CALL rigid_jointed(km,prop,gamma,etype,iel,coord) 94 | action=MATMUL(km,eld) 95 | IF(ndim<3)THEN 96 | WRITE(11,'(I5,6E12.4)')iel,action 97 | ELSE 98 | WRITE(11,'(I5,6E12.4)')iel, action(1: 6) 99 | WRITE(11,'(A,6E12.4)')" ",action(7:12) 100 | END IF 101 | END DO elements_3 102 | STOP 103 | END PROGRAM p44 104 | 105 | -------------------------------------------------------------------------------- /chap04/p44_1.dat: -------------------------------------------------------------------------------- 1 | 6 6 2 2 2 2 | 5.0e9 6.0e4 3 | 1.0e9 2.0e4 4 | 1 1 1 2 2 2 5 | 0.0 0.0 6.0 0.0 6.0 -4.0 6 | 12.0 0.0 12.0 -5.0 14.0 0.0 7 | 1 2 2 4 4 6 3 2 3 4 5 4 8 | 3 9 | 1 0 0 1 3 0 0 0 5 0 0 0 10 | 4 11 | 1 0.0 -60.0 -60.0 2 0.0 -180.0 -80.0 12 | 4 0.0 -140.0 133.33 6 0.0 -20.0 6.67 13 | 0 14 | -------------------------------------------------------------------------------- /chap04/p44_2.dat: -------------------------------------------------------------------------------- 1 | 3 4 3 4 1 2 | 4.0e6 1.0e6 0.3e6 0.3e6 3 | 0.0 0.0 90.0 4 | 0.0 5.0 5.0 5 | 5.0 5.0 5.0 6 | 5.0 5.0 0.0 7 | 5.0 0.0 0.0 8 | 1 2 3 2 4 3 9 | 2 10 | 1 0 0 0 0 0 0 4 0 0 0 0 0 0 11 | 1 12 | 2 0.0 -100.0 0.0 0.0 0.0 0.0 13 | 0 14 | 15 | -------------------------------------------------------------------------------- /chap04/p45_1.dat: -------------------------------------------------------------------------------- 1 | 7 8 2 3 3 2 | 1.0e10 1.0e6 20.0 3 | 1.0e10 1.0e6 50.0 4 | 1.0e10 1.0e6 80.0 5 | 1 2 2 1 3 3 1 6 | 0.0 0.0 0.0 15.0 10.0 15.0 20.0 15.0 7 | 20.0 0.0 35.0 15.0 50.0 15.0 50.0 0.0 8 | 1 2 2 3 3 4 5 4 4 6 6 7 8 7 9 | 3 10 | 1 0 0 0 5 0 0 0 8 0 0 0 11 | 3 12 | 2 4.0 0.0 0.0 13 | 3 0.0 -6.0 0.0 14 | 6 0.0 -12.0 0.0 15 | 200 0.0001 16 | 8 17 | 0.5 0.3 0.2 0.2 0.1 0.05 0.02 0.01 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /chap04/p45_2.dat: -------------------------------------------------------------------------------- 1 | 12 10 3 7 1 2 | 1.0 1.e4 1.e4 1.0 1.0 1.0 1.e8 3 | 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 4 | 0.0 0.0 0.0 1.0 0.0 0.0 1.0 1.0 0.0 2.0 0.0 0.0 5 | 2.0 1.0 0.0 2.0 2.0 0.0 3.0 0.0 0.0 3.0 1.0 0.0 6 | 3.0 2.0 0.0 3.0 3.0 0.0 7 | 1 2 2 3 2 4 3 5 4 5 5 6 4 7 5 8 6 9 7 8 8 9 9 10 8 | 4 9 | 1 0 0 0 0 0 0 3 0 0 0 0 0 0 6 0 0 0 0 0 0 10 0 0 0 0 0 0 10 | 1 11 | 7 0.0 0.0 1.0 0.0 0.0 0.0 12 | 200 0.00001 13 | 5 14 | 0.5 0.5 0.5 0.05 0.05 15 | -------------------------------------------------------------------------------- /chap04/p46.f03: -------------------------------------------------------------------------------- 1 | ! Last change: DV 19 Oct 2004 7:58 pm 2 | PROGRAM p46 3 | !------------------------------------------------------------------------- 4 | ! Program 4.6 Stability (buckling) analysis of elastic beams using 2-node 5 | ! beam elements (elastic foundation optional). 6 | !------------------------------------------------------------------------- 7 | USE main 8 | USE geom 9 | IMPLICIT NONE 10 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 11 | INTEGER::i,iel,iters,k,limit,ndof=4,nels,neq,nod=2,nodof=2,nn,nprops, & 12 | np_types,nr,nlen 13 | REAL(iwp)::eval,tol,zero=0.0_iwp 14 | !-----------------------dynamic arrays------------------------------------ 15 | INTEGER,ALLOCATABLE::etype(:),g(:),g_g(:,:),kdiag(:),nf(:,:),num(:) 16 | REAL(iwp),ALLOCATABLE::ell(:),evec(:),kg(:,:),gv(:),km(:,:),kv(:), & 17 | mm(:,:),prop(:,:) 18 | CHARACTER(LEN=15)::argv 19 | !-----------------------input and initialisation-------------------------- 20 | CALL getname(argv,nlen) 21 | OPEN(10,FILE=argv(1:nlen)//'.dat') 22 | OPEN(11,FILE=argv(1:nlen)//'.res') 23 | READ(10,*)nels,nprops,np_types 24 | nn=nels+1 25 | ALLOCATE(nf(nodof,nn),ell(nels),num(nod),g(ndof),g_g(ndof,nels), & 26 | etype(nels),prop(nprops,np_types),km(ndof,ndof),kg(ndof,ndof), & 27 | mm(ndof,ndof)) 28 | READ(10,*)prop 29 | etype=1 30 | IF(np_types>1)READ(10,*)etype 31 | READ(10,*)ell 32 | nf=1 33 | READ(10,*)nr,(k,nf(:,k),i=1,nr),limit,tol 34 | CALL formnf(nf) 35 | neq=MAXVAL(nf) 36 | ALLOCATE(kdiag(neq),evec(0:neq)) 37 | !-----------------------loop the elements to find global array sizes------ 38 | kdiag=0 39 | elements_1: DO iel=1,nels 40 | num=(/iel,iel+1/) 41 | CALL num_to_g(num,nf,g) 42 | g_g(:,iel)=g 43 | CALL fkdiag(kdiag,g) 44 | END DO elements_1 45 | DO i=2,neq 46 | kdiag(i)=kdiag(i)+kdiag(i-1) 47 | END DO 48 | ALLOCATE(kv(kdiag(neq)),gv(kdiag(neq))) 49 | WRITE(11,'(2(A,I5))') & 50 | " There are",neq," equations and the skyline storage is",kdiag(neq) 51 | !-----------------------global stiffness and geometric matrix assembly---- 52 | kv=zero 53 | gv=zero 54 | elements_2: DO iel=1, nels 55 | mm=zero 56 | CALL beam_km(km,prop(1,etype(iel)),ell(iel)) 57 | IF(nprops>1)CALL beam_mm(mm,prop(2,etype(iel)),ell(iel)) 58 | CALL beam_gm(kg,ell(iel)) 59 | g=g_g(:,iel) 60 | CALL fsparv(kv,km+mm,g,kdiag) 61 | CALL fsparv(gv,kg,g,kdiag) 62 | END DO elements_2 63 | !-----------------------solve eigenvalue problems------------------------- 64 | CALL stability(kv,gv,kdiag,tol,limit,iters,evec,eval) 65 | WRITE(11,'(/A,E12.4,/)')" The buckling load =",eval 66 | evec(0)=zero 67 | WRITE(11,'(A)')" The buckling mode" 68 | WRITE(11,'(/A)')" Node Translation Rotation" 69 | DO k=1,nn 70 | WRITE(11,'(I5,2E12.4)')k,evec(nf(:,k)) 71 | END DO 72 | WRITE(11,'(/A,I5,A)')" Converged in",iters," iterations" 73 | CALL beamdis(evec,nf,0.40_iwp,10,nels,ell,argv,nlen,12) 74 | STOP 75 | END PROGRAM p46 76 | 77 | -------------------------------------------------------------------------------- /chap04/p46_1.dat: -------------------------------------------------------------------------------- 1 | 4 1 1 2 | 1.0 3 | 0.25 0.25 0.25 0.25 4 | 2 5 | 1 0 1 5 0 0 6 | 100 1.0e-5 7 | -------------------------------------------------------------------------------- /chap04/p46_2.dat: -------------------------------------------------------------------------------- 1 | 4 2 1 2 | 1.0 800.0 3 | 0.25 0.25 0.25 0.25 4 | 2 5 | 1 0 1 5 0 1 6 | 100 1.0e-5 7 | 8 | -------------------------------------------------------------------------------- /chap04/p47.dat: -------------------------------------------------------------------------------- 1 | 2 2 1 2 | 0.25 0.25 1.0 3 | 10.92 0.3 4 | 8 5 | 1 0 0 0 1 2 0 0 1 1 3 0 0 1 0 4 0 1 0 1 6 | 6 1 0 1 0 7 0 1 0 0 8 1 1 0 0 9 1 0 0 0 7 | 1 8 | 9 0.25 0.0 0.0 0.0 9 | 0 10 | 11 | 12 | -------------------------------------------------------------------------------- /chap05/p51.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap05/p51.m -------------------------------------------------------------------------------- /chap05/p51_1.dat: -------------------------------------------------------------------------------- 1 | 'plane' 2 | 'triangle' 3 | 3 4 | 'x' 5 | 2 2 1 1 6 | 1.0e6 0.3 7 | 0.0 0.5 1.0 8 | 0.0 -0.5 -1.0 9 | 5 10 | 1 0 1 11 | 4 0 1 12 | 7 0 0 13 | 8 1 0 14 | 9 1 0 15 | 3 16 | 1 0.0 -0.25 17 | 2 0.0 -0.50 18 | 3 0.0 -0.25 19 | 0 20 | -------------------------------------------------------------------------------- /chap05/p51_2.dat: -------------------------------------------------------------------------------- 1 | 'plane' 2 | 'triangle' 3 | 15 4 | 'y' 5 | 2 1 12 1 6 | 1.0e5 0.2 7 | 0.0 1.0 6.0 8 | 0.0 -2.0 9 | 17 10 | 1 0 1 11 | 2 0 1 12 | 3 0 1 13 | 4 0 1 14 | 5 0 0 15 | 10 0 0 16 | 15 0 0 17 | 20 0 0 18 | 25 0 0 19 | 30 0 0 20 | 35 0 0 21 | 40 0 0 22 | 41 0 1 23 | 42 0 1 24 | 43 0 1 25 | 44 0 1 26 | 45 0 0 27 | 5 28 | 1 0.0 -0.0778 29 | 6 0.0 -0.3556 30 | 11 0.0 -0.1333 31 | 16 0.0 -0.3556 32 | 21 0.0 -0.0778 33 | 0 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /chap05/p51_3.dat: -------------------------------------------------------------------------------- 1 | 'plane' 2 | 'quadrilateral' 3 | 4 4 | 'y' 5 | 3 2 4 1 6 | 1.0e6 0.3 7 | 0.0 10.0 20.0 30.0 8 | 0.0 -5.0 -10.0 9 | 8 10 | 1 0 1 11 | 2 0 1 12 | 3 0 0 13 | 6 0 0 14 | 9 0 0 15 | 10 0 1 16 | 11 0 1 17 | 12 0 0 18 | 0 19 | 2 20 | 1 2 -1.0e-5 21 | 4 2 -1.0e-5 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /chap05/p51_4.dat: -------------------------------------------------------------------------------- 1 | 'plane' 2 | 'quadrilateral' 3 | 8 4 | 'x' 5 | 2 3 4 1 6 | 1.0e6 0.3 7 | 0.0 3.0 6.0 8 | 0.0 -3.0 -6.0 -9.0 9 | 17 10 | 1 0 1 11 | 6 0 1 12 | 9 0 1 13 | 14 0 1 14 | 17 0 1 15 | 22 0 1 16 | 25 0 0 17 | 26 0 0 18 | 27 0 0 19 | 28 0 0 20 | 5 0 1 21 | 8 0 1 22 | 13 0 1 23 | 16 0 1 24 | 21 0 1 25 | 24 0 1 26 | 29 0 0 27 | 3 28 | 1 0.0 -0.5 29 | 2 0.0 -2.0 30 | 3 0.0 -0.5 31 | 0 32 | 33 | 34 | -------------------------------------------------------------------------------- /chap05/p51_5.dat: -------------------------------------------------------------------------------- 1 | 'axisymmetric' 2 | 'quadrilateral' 3 | 4 4 | 'z' 5 | 3 2 9 2 6 | 100.0 0.3 7 | 1000.0 0.45 8 | 1 2 1 2 1 2 9 | 0.0 4.0 10.0 30.0 10 | 0.0 -4.0 -10.0 11 | 8 12 | 1 0 1 13 | 2 0 1 14 | 3 0 0 15 | 6 0 0 16 | 9 0 0 17 | 10 0 1 18 | 11 0 1 19 | 12 0 0 20 | 3 21 | 1 0.0 -2.6667 22 | 4 0.0 -23.3333 23 | 7 0.0 -24.0 24 | 0 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /chap05/p52.dat: -------------------------------------------------------------------------------- 1 | 1 5 2 | 1 1 0.0 1 3 | 1.0e5 0.3 4 | 0.0 0.5 5 | 10.0 8.0 6.0 4.0 2.0 0.0 6 | 13 7 | 1 1 0 1 8 | 4 1 0 1 9 | 6 1 0 1 10 | 9 1 0 1 11 | 11 1 0 1 12 | 14 1 0 1 13 | 16 1 0 1 14 | 19 1 0 1 15 | 21 1 0 1 16 | 24 1 0 1 17 | 26 0 0 0 18 | 27 0 0 0 19 | 28 0 0 0 20 | 1 21 | 3 0.3183 0.0 0.0 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /chap05/p52.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap05/p52.m -------------------------------------------------------------------------------- /chap05/p53.dat: -------------------------------------------------------------------------------- 1 | 20 2 | 1 3 2 8 2 3 | 100.0 0.3 4 | 50.0 0.3 5 | 1 6 | 2 7 | 1 8 | 2 9 | 1 10 | 2 11 | 0.0 0.5 12 | 0.0 1.0 2.0 3.0 13 | 0.0 -1.0 -2.0 14 | 46 15 | 1 0 0 1 16 | 2 1 0 1 17 | 3 1 0 1 18 | 4 0 0 1 19 | 5 1 0 1 20 | 6 0 0 1 21 | 7 1 0 1 22 | 8 1 0 1 23 | 9 0 0 1 24 | 10 1 0 1 25 | 11 0 0 0 26 | 12 0 0 0 27 | 13 0 0 0 28 | 14 0 1 1 29 | 16 0 1 1 30 | 18 0 0 0 31 | 19 0 0 0 32 | 20 0 1 1 33 | 23 0 1 1 34 | 25 0 1 1 35 | 28 0 1 1 36 | 30 0 0 0 37 | 31 0 0 0 38 | 32 0 0 0 39 | 33 0 1 1 40 | 35 0 1 1 41 | 37 0 0 0 42 | 38 0 0 0 43 | 39 0 1 1 44 | 42 0 1 1 45 | 44 0 1 1 46 | 47 0 1 1 47 | 49 0 0 0 48 | 50 0 0 0 49 | 51 0 0 0 50 | 52 0 1 1 51 | 54 0 1 1 52 | 56 0 0 0 53 | 57 0 0 0 54 | 58 0 1 1 55 | 61 0 1 1 56 | 63 0 1 1 57 | 66 0 1 1 58 | 68 0 0 0 59 | 69 0 0 0 60 | 70 0 0 0 61 | 8 62 | 1 0.0 0.0 0.0417 63 | 2 0.0 0.0 -0.1667 64 | 3 0.0 0.0 0.0417 65 | 14 0.0 0.0 -0.1667 66 | 15 0.0 0.0 -0.1667 67 | 20 0.0 0.0 0.0417 68 | 21 0.0 0.0 -0.1667 69 | 22 0.0 0.0 0.0417 70 | 0 71 | 72 | -------------------------------------------------------------------------------- /chap05/p53.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap05/p53.m -------------------------------------------------------------------------------- /chap05/p54.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap05/p54.m -------------------------------------------------------------------------------- /chap05/p54_1.dat: -------------------------------------------------------------------------------- 1 | 'quadrilateral' 2 | 9 6 35 9 2 3 2 1 3 | 1.0e6 0.3 10.0 4 | 0.0 0.0 5 | 1.5 0.0 6 | 3.0 0.0 7 | 4.5 0.0 8 | 6.0 0.0 9 | 0.0 -1.5 10 | 1.5 -1.5 11 | 3.0 -1.5 12 | 4.5 -1.5 13 | 6.0 -1.5 14 | 0.0 -3.0 15 | 1.5 -3.0 16 | 3.0 -3.0 17 | 4.5 -3.0 18 | 6.0 -3.0 19 | 0.0 -4.5 20 | 1.5 -4.5 21 | 3.0 -4.5 22 | 4.5 -4.5 23 | 6.0 -4.5 24 | 0.0 -6.0 25 | 1.5 -6.0 26 | 3.0 -6.0 27 | 4.5 -6.0 28 | 6.0 -6.0 29 | 0.0 -7.5 30 | 1.5 -7.5 31 | 3.0 -7.5 32 | 4.5 -7.5 33 | 6.0 -7.5 34 | 0.0 -9.0 35 | 1.5 -9.0 36 | 3.0 -9.0 37 | 4.5 -9.0 38 | 6.0 -9.0 39 | 11 6 1 2 3 8 13 12 7 40 | 21 16 11 12 13 18 23 22 17 41 | 31 26 21 22 23 28 33 32 27 42 | 13 8 3 4 5 10 15 14 9 43 | 23 18 13 14 15 20 25 24 19 44 | 33 28 23 24 25 30 35 34 29 45 | 17 46 | 1 0 1 47 | 5 0 1 48 | 6 0 1 49 | 10 0 1 50 | 11 0 1 51 | 15 0 1 52 | 16 0 1 53 | 20 0 1 54 | 21 0 1 55 | 25 0 1 56 | 26 0 1 57 | 30 0 1 58 | 31 0 0 59 | 32 0 0 60 | 33 0 0 61 | 34 0 0 62 | 35 0 0 63 | 3 64 | 1 0.0 -0.5 65 | 2 0.0 -2.0 66 | 3 0.0 -0.5 67 | 0 68 | 69 | 70 | 71 | -------------------------------------------------------------------------------- /chap05/p54_2.dat: -------------------------------------------------------------------------------- 1 | 'tetrahedron' 2 | 4 6 8 1 3 6 3 1 3 | 100.0 0.3 0.0 4 | 0.0 0.0 0.0 5 | 1.0 0.0 0.0 6 | 0.0 0.0 -1.0 7 | 1.0 0.0 -1.0 8 | 0.0 1.0 0.0 9 | 1.0 1.0 0.0 10 | 0.0 1.0 -1.0 11 | 1.0 1.0 -1.0 12 | 1 3 4 7 13 | 1 4 2 7 14 | 1 2 5 7 15 | 6 4 8 7 16 | 6 2 4 7 17 | 6 5 2 7 18 | 7 19 | 1 0 0 1 20 | 2 1 0 1 21 | 3 0 0 0 22 | 4 1 0 0 23 | 5 0 1 1 24 | 7 0 1 0 25 | 8 1 1 0 26 | 4 27 | 1 0.0 0.0 -0.1667 28 | 2 0.0 0.0 -0.3333 29 | 5 0.0 0.0 -0.3333 30 | 6 0.0 0.0 -0.1667 31 | 0 32 | 33 | 34 | -------------------------------------------------------------------------------- /chap05/p54_3.dat: -------------------------------------------------------------------------------- 1 | 'hexahedron' 2 | 14 7 40 27 3 6 3 1 3 | 1.0 0.49 0.0 4 | 0.0000 0.0000 0.0000 5 | 0.0000 1.0000 0.0000 6 | 0.0000 0.0000 -1.0000 7 | 0.0000 1.0000 -1.0000 8 | 1.0000 0.0000 0.0000 9 | 1.0000 1.0000 0.0000 10 | 1.0000 0.0000 -1.0000 11 | 1.0000 1.0000 -1.0000 12 | 0.1650 0.2980 -0.2550 13 | 0.2720 0.7700 -0.2500 14 | 0.3200 0.3570 -0.8140 15 | 0.2490 0.8080 -0.6580 16 | 0.7880 0.3560 -0.3070 17 | 0.8500 0.7370 -0.3510 18 | 0.6770 0.3170 -0.6950 19 | 0.8260 0.7120 -0.7120 20 | 0.0000 0.5000 -0.5000 21 | 0.5000 0.5000 0.0000 22 | 0.5000 0.0000 -0.5000 23 | 0.5000 1.0000 -0.5000 24 | 0.5000 0.5000 -1.0000 25 | 1.0000 0.5000 -0.5000 26 | 0.2515 0.5582 -0.4942 27 | 0.5188 0.5403 -0.2908 28 | 0.4875 0.3320 -0.5177 29 | 0.5493 0.7568 -0.4928 30 | 0.5180 0.5485 -0.7197 31 | 0.7853 0.5305 -0.5162 32 | 0.1093 0.5170 -0.1263 33 | 0.5305 0.8767 -0.1503 34 | 0.9095 0.5232 -0.1645 35 | 0.4882 0.1635 -0.1405 36 | 0.1213 0.1637 -0.5173 37 | 0.1303 0.8945 -0.4770 38 | 0.9190 0.8623 -0.5158 39 | 0.8663 0.1682 -0.5005 40 | 0.1423 0.5412 -0.8680 41 | 0.5187 0.8800 -0.8425 42 | 0.8758 0.5072 -0.8518 43 | 0.4992 0.1685 -0.8773 44 | 11 9 13 15 25 23 24 28 27 12 10 14 16 26 45 | 3 1 9 11 33 17 29 23 37 4 2 10 12 34 46 | 9 1 5 13 32 29 18 31 24 10 2 6 14 30 47 | 15 13 5 7 36 28 31 22 39 16 14 6 8 35 48 | 3 11 15 7 40 37 27 39 21 4 12 16 8 38 49 | 12 10 14 16 26 34 30 35 38 4 2 6 8 20 50 | 3 1 5 7 19 33 32 36 40 11 9 13 15 25 51 | 10 52 | 1 0 1 1 53 | 2 0 0 1 54 | 3 0 1 0 55 | 4 0 0 0 56 | 6 1 0 1 57 | 7 1 1 0 58 | 8 1 0 0 59 | 17 0 1 1 60 | 20 1 0 1 61 | 21 1 1 0 62 | 0 63 | 5 64 | 1 2 0.01 65 | 3 2 0.01 66 | 5 2 0.01 67 | 7 2 0.01 68 | 19 2 0.01 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /chap05/p55.dat: -------------------------------------------------------------------------------- 1 | 'plane' 2 | 'quadrilateral' 3 | 8 4 | 'y' 5 | 20 2 4 1 6 | 1.0e5 0.0 1.E-5 1.E-5 7 | 0.0 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95 1.00 8 | 0.05 0.0 -0.05 9 | 5 10 | 1 0 0 11 | 2 0 0 12 | 3 0 0 13 | 4 0 0 14 | 5 0 0 15 | 0.50 0.25 0.00 -0.25 -0.50 16 | 0.50 0.00 -0.50 17 | 0.50 0.25 0.00 -0.25 -0.50 18 | 0.50 0.00 -0.50 19 | 0.50 0.25 0.00 -0.25 -0.50 20 | 0.50 0.00 -0.50 21 | 0.50 0.25 0.00 -0.25 -0.50 22 | 0.50 0.00 -0.50 23 | 0.50 0.25 0.00 -0.25 -0.50 24 | 0.50 0.00 -0.50 25 | 0.50 0.25 0.00 -0.25 -0.50 26 | 0.50 0.00 -0.50 27 | 0.50 0.25 0.00 -0.25 -0.50 28 | 0.50 0.00 -0.50 29 | 0.50 0.25 0.00 -0.25 -0.50 30 | 0.50 0.00 -0.50 31 | 0.50 0.25 0.00 -0.25 -0.50 32 | 0.50 0.00 -0.50 33 | 0.50 0.25 0.00 -0.25 -0.50 34 | 0.50 0.00 -0.50 35 | 0.50 0.25 0.00 -0.25 -0.50 36 | 0.50 0.00 -0.50 37 | 0.50 0.25 0.00 -0.25 -0.50 38 | 0.50 0.00 -0.50 39 | 0.50 0.25 0.00 -0.25 -0.50 40 | 0.50 0.00 -0.50 41 | 0.50 0.25 0.00 -0.25 -0.50 42 | 0.50 0.00 -0.50 43 | 0.50 0.25 0.00 -0.25 -0.50 44 | 0.50 0.00 -0.50 45 | 0.50 0.25 0.00 -0.25 -0.50 46 | 0.50 0.00 -0.50 47 | 0.50 0.25 0.00 -0.25 -0.50 48 | 0.50 0.00 -0.50 49 | 0.50 0.25 0.00 -0.25 -0.50 50 | 0.50 0.00 -0.50 51 | 0.50 0.25 0.00 -0.25 -0.50 52 | 0.50 0.00 -0.50 53 | 0.50 0.25 0.00 -0.25 -0.50 54 | 0.50 0.00 -0.50 55 | 0.50 0.25 0.00 -0.25 -0.50 56 | 1 57 | 163 2 50.0 58 | 0 59 | 0 60 | 61 | 62 | 63 | -------------------------------------------------------------------------------- /chap05/p55.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap05/p55.m -------------------------------------------------------------------------------- /chap05/p56.dat: -------------------------------------------------------------------------------- 1 | 20 2 | 1 3 2 8 1.0e-5 200 3 | 2 4 | 100.0 0.3 5 | 50.0 0.3 6 | 1 2 1 2 1 2 7 | 0.0 0.5 8 | 0.0 1.0 2.0 3.0 9 | 0.0 -1.0 -2.0 10 | 46 11 | 1 0 0 1 12 | 2 1 0 1 13 | 3 1 0 1 14 | 4 0 0 1 15 | 5 1 0 1 16 | 6 0 0 1 17 | 7 1 0 1 18 | 8 1 0 1 19 | 9 0 0 1 20 | 10 1 0 1 21 | 11 0 0 0 22 | 12 0 0 0 23 | 13 0 0 0 24 | 14 0 1 1 25 | 16 0 1 1 26 | 18 0 0 0 27 | 19 0 0 0 28 | 20 0 1 1 29 | 23 0 1 1 30 | 25 0 1 1 31 | 28 0 1 1 32 | 30 0 0 0 33 | 31 0 0 0 34 | 32 0 0 0 35 | 33 0 1 1 36 | 35 0 1 1 37 | 37 0 0 0 38 | 38 0 0 0 39 | 39 0 1 1 40 | 42 0 1 1 41 | 44 0 1 1 42 | 47 0 1 1 43 | 49 0 0 0 44 | 50 0 0 0 45 | 51 0 0 0 46 | 52 0 1 1 47 | 54 0 1 1 48 | 56 0 0 0 49 | 57 0 0 0 50 | 58 0 1 1 51 | 61 0 1 1 52 | 63 0 1 1 53 | 66 0 1 1 54 | 68 0 0 0 55 | 69 0 0 0 56 | 70 0 0 0 57 | 8 58 | 1 0.0 0.0 0.0417 59 | 2 0.0 0.0 -0.1667 60 | 3 0.0 0.0 0.0417 61 | 14 0.0 0.0 -0.1667 62 | 15 0.0 0.0 -0.1667 63 | 20 0.0 0.0 0.0417 64 | 21 0.0 0.0 -0.1667 65 | 22 0.0 0.0 0.0417 66 | 0 67 | 68 | -------------------------------------------------------------------------------- /chap05/p56.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap05/p56.m -------------------------------------------------------------------------------- /chap05/sparse_p54.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap05/sparse_p54.m -------------------------------------------------------------------------------- /chap06/p61.dat: -------------------------------------------------------------------------------- 1 | 8 4 1 2 | 100.0 1.0e5 0.3 3 | 0.0 1.0 2.0 3.0 4.0 5.5 7.0 9.0 12.0 4 | 0.0 -1.25 -2.5 -3.75 -5.0 5 | 33 6 | 1 0 1 2 0 1 3 0 1 4 0 1 5 0 1 6 0 1 7 | 7 0 1 8 0 1 9 0 0 14 0 0 23 0 0 28 0 0 8 | 37 0 0 42 0 0 51 0 0 56 0 0 65 0 0 70 0 0 9 | 79 0 0 84 0 0 93 0 0 98 0 0 107 0 0 112 0 0 10 | 113 0 1 114 0 1 115 0 1 116 0 1 117 0 1 118 0 1 11 | 119 0 1 120 0 1 121 0 0 12 | 5 13 | 1 0.0 -0.166667 10 0.0 -0.666667 15 0.0 -0.333333 14 | 24 0.0 -0.666667 29 0.0 -0.166667 15 | 0.001 250 16 | 10 17 | 200.0 100.0 50.0 50.0 50.0 30.0 20.0 10.0 5.0 4.0 18 | 19 | -------------------------------------------------------------------------------- /chap06/p61.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap06/p61.m -------------------------------------------------------------------------------- /chap06/p610.dat: -------------------------------------------------------------------------------- 1 | 16 65 1 2 | 0.0 9.0 0.0 20.0 1.0e5 0.49 1.0 3 | 0.00 0.00 0.00 -0.50 0.00 -1.00 0.00 -1.50 0.00 -2.00 4 | 0.00 -2.50 0.00 -3.00 0.00 -3.50 0.00 -4.00 0.50 0.00 5 | 0.50 -1.00 0.50 -2.00 0.50 -3.00 0.50 -4.00 1.00 0.00 6 | 1.00 -0.50 1.00 -1.00 1.00 -1.50 1.00 -2.00 1.00 -2.50 7 | 1.00 -3.00 1.00 -3.50 1.00 -4.00 1.50 0.00 1.50 -1.00 8 | 1.50 -2.00 1.50 -3.00 1.50 -4.00 2.00 0.00 2.00 -0.50 9 | 2.00 -1.00 2.00 -1.50 2.00 -2.00 2.00 -2.50 2.00 -3.00 10 | 2.00 -3.50 2.00 -4.00 2.50 0.00 2.50 -1.00 2.50 -2.00 11 | 2.50 -3.00 2.50 -4.00 3.00 0.00 3.00 -0.50 3.00 -1.00 12 | 3.00 -1.50 3.00 -2.00 3.00 -2.50 3.00 -3.00 3.00 -3.50 13 | 3.00 -4.00 3.50 0.00 3.50 -1.00 3.50 -2.00 3.50 -3.00 14 | 3.50 -4.00 4.00 0.00 4.00 -0.50 4.00 -1.00 4.00 -1.50 15 | 4.00 -2.00 4.00 -2.50 4.00 -3.00 4.00 -3.50 4.00 -4.00 16 | 3 2 1 10 15 16 17 11 17 | 5 4 3 11 17 18 19 12 18 | 7 6 5 12 19 20 21 13 19 | 9 8 7 13 21 22 23 14 20 | 17 16 15 24 29 30 31 25 21 | 19 18 17 25 31 32 33 26 22 | 21 20 19 26 33 34 35 27 23 | 23 22 21 27 35 36 37 28 24 | 31 30 29 38 43 44 45 39 25 | 33 32 31 39 45 46 47 40 26 | 35 34 33 40 47 48 49 41 27 | 37 36 35 41 49 50 51 42 28 | 45 44 43 52 57 58 59 53 29 | 47 46 45 53 59 60 61 54 30 | 49 48 47 54 61 62 63 55 31 | 51 50 49 55 63 64 65 56 32 | 25 33 | 1 0 1 2 0 1 3 0 1 4 0 1 5 0 1 6 0 1 7 0 1 8 0 1 34 | 9 0 0 14 0 0 23 0 0 28 0 0 37 0 0 42 0 0 51 0 0 56 0 0 35 | 57 0 1 58 0 1 59 0 1 60 0 1 61 0 1 62 0 1 63 0 1 64 0 1 36 | 65 0 0 37 | 4 38 | 29 30 31 32 39 | 0.0001 250 40 | 5 2 41 | 2 42 | 9 13 43 | 2 44 | 10 14 45 | 46 | 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /chap06/p611_1.dat: -------------------------------------------------------------------------------- 1 | 1 1 2 | 30.0 0.0 0.0 2.5e4 0.25 0.0 -100.0 3 | 0.0 1.0 4 | 0.0 -2.0 5 | 5 6 | 1 0 1 2 0 1 3 0 0 5 1 0 8 1 0 7 | 3 8 | 1 2 4 2 6 2 9 | 0.0001 50 10 -2.0e-3 10 | -------------------------------------------------------------------------------- /chap06/p611_2.dat: -------------------------------------------------------------------------------- 1 | 1 1 2 | 30.0 0.0 0.0 2.5e4 0.25 1.0e6 -100.0 3 | 0.0 1.0 4 | 0.0 -2.0 5 | 5 6 | 1 0 1 2 0 1 3 0 0 5 1 0 8 1 0 7 | 3 8 | 1 2 4 2 6 2 9 | 0.0001 50 8 -2.0e-3 10 | -------------------------------------------------------------------------------- /chap06/p611_3.dat: -------------------------------------------------------------------------------- 1 | 1 1 2 | 30.0 0.0 30.0 2.5e4 0.25 1.0e6 -100.0 3 | 0.0 1.0 4 | 0.0 -2.0 5 | 5 6 | 1 0 1 2 0 1 3 0 0 5 1 0 8 1 0 7 | 3 8 | 1 2 4 2 6 2 9 | 0.0001 50 8 -2.0e-3 10 | -------------------------------------------------------------------------------- /chap06/p612.dat: -------------------------------------------------------------------------------- 1 | 20.0 20.0 20.0 10.0 5.0 40.0 2 | 5 3 5 3 5 3 | 2 4 | 5 5 | 0.0 60.0 0.0 20.0 1.0e5 0.3 6 | 0.0 55.0 0.0 20.0 1.0e5 0.3 7 | 0.0 50.0 0.0 20.0 1.0e5 0.3 8 | 0.0 45.0 0.0 20.0 1.0e5 0.3 9 | 0.0 40.0 0.0 20.0 1.0e5 0.3 10 | 11 | 1 1 1 1 1 12 | 1 1 1 1 1 13 | 1 1 1 1 1 14 | 1 1 1 1 1 15 | 1 1 1 1 1 16 | 1 1 1 1 1 1 1 1 17 | 1 1 1 1 1 1 1 1 18 | 1 1 1 1 1 1 1 1 19 | 20 | 2 2 2 2 2 21 | 2 2 2 2 2 22 | 2 2 2 2 2 23 | 2 2 2 2 2 24 | 2 2 2 2 2 25 | 2 2 2 2 2 2 2 2 26 | 2 2 2 2 2 2 2 2 27 | 2 2 2 2 2 2 2 2 28 | 29 | 3 3 3 3 3 30 | 3 3 3 3 3 31 | 3 3 3 3 3 32 | 3 3 3 3 3 33 | 3 3 3 3 3 34 | 3 3 3 3 3 3 3 3 35 | 3 3 3 3 3 3 3 3 36 | 3 3 3 3 3 3 3 3 37 | 38 | 4 4 4 4 4 39 | 4 4 4 4 4 40 | 4 4 4 4 4 41 | 4 4 4 4 4 42 | 4 4 4 4 4 43 | 4 4 4 4 4 4 4 4 44 | 4 4 4 4 4 4 4 4 45 | 4 4 4 4 4 4 4 4 46 | 47 | 5 5 5 5 5 48 | 5 5 5 5 5 49 | 5 5 5 5 5 50 | 5 5 5 5 5 51 | 5 5 5 5 5 52 | 5 5 5 5 5 5 5 5 53 | 5 5 5 5 5 5 5 5 54 | 5 5 5 5 5 5 5 5 55 | 56 | 0.0001 1000 57 | 6 58 | 1.0 1.4 1.5 1.55 1.58 1.60 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | -------------------------------------------------------------------------------- /chap06/p613.dat: -------------------------------------------------------------------------------- 1 | 20.0 20.0 20.0 10.0 5.0 40.0 2 | 5 3 5 3 5 3 | 2 4 | 0.0001 500 5 | 5 6 | 0.0 60.0 0.0 20.0 1.0e5 0.3 7 | 0.0 55.0 0.0 20.0 1.0e5 0.3 8 | 0.0 50.0 0.0 20.0 1.0e5 0.3 9 | 0.0 45.0 0.0 20.0 1.0e5 0.3 10 | 0.0 40.0 0.0 20.0 1.0e5 0.3 11 | 12 | 1 1 1 1 1 13 | 1 1 1 1 1 14 | 1 1 1 1 1 15 | 1 1 1 1 1 16 | 1 1 1 1 1 17 | 1 1 1 1 1 1 1 1 18 | 1 1 1 1 1 1 1 1 19 | 1 1 1 1 1 1 1 1 20 | 21 | 2 2 2 2 2 22 | 2 2 2 2 2 23 | 2 2 2 2 2 24 | 2 2 2 2 2 25 | 2 2 2 2 2 26 | 2 2 2 2 2 2 2 2 27 | 2 2 2 2 2 2 2 2 28 | 2 2 2 2 2 2 2 2 29 | 30 | 3 3 3 3 3 31 | 3 3 3 3 3 32 | 3 3 3 3 3 33 | 3 3 3 3 3 34 | 3 3 3 3 3 35 | 3 3 3 3 3 3 3 3 36 | 3 3 3 3 3 3 3 3 37 | 3 3 3 3 3 3 3 3 38 | 39 | 4 4 4 4 4 40 | 4 4 4 4 4 41 | 4 4 4 4 4 42 | 4 4 4 4 4 43 | 4 4 4 4 4 44 | 4 4 4 4 4 4 4 4 45 | 4 4 4 4 4 4 4 4 46 | 4 4 4 4 4 4 4 4 47 | 48 | 5 5 5 5 5 49 | 5 5 5 5 5 50 | 5 5 5 5 5 51 | 5 5 5 5 5 52 | 5 5 5 5 5 53 | 5 5 5 5 5 5 5 5 54 | 5 5 5 5 5 5 5 5 55 | 5 5 5 5 5 5 5 5 56 | 57 | 0.0001 1000 58 | 6 59 | 1.0 1.4 1.5 1.55 1.58 1.60 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | -------------------------------------------------------------------------------- /chap06/p62.dat: -------------------------------------------------------------------------------- 1 | 8 4 0.0001 100 1 2 | 100.0 1.0e5 0.3 3 | 0.0 1.0 2.0 3.0 4.0 5.5 7.0 9.0 12.0 4 | 0.0 -1.25 -2.5 -3.75 -5.0 5 | 33 6 | 1 0 1 2 0 1 3 0 1 4 0 1 5 0 1 6 0 1 7 | 7 0 1 8 0 1 9 0 0 14 0 0 23 0 0 28 0 0 8 | 37 0 0 42 0 0 51 0 0 56 0 0 65 0 0 70 0 0 9 | 79 0 0 84 0 0 93 0 0 98 0 0 107 0 0 112 0 0 10 | 113 0 0 114 0 0 115 0 0 116 0 0 117 0 0 118 0 0 11 | 119 0 0 120 0 0 121 0 0 12 | 5 13 | 1 0.0 -0.166667 10 0.0 -0.666667 15 0.0 -0.333333 14 | 24 0.0 -0.666667 29 0.0 -0.166667 15 | 0.001 250 16 | 10 17 | 200.0 100.0 50.0 50.0 50.0 30.0 20.0 10.0 5.0 4.0 18 | -------------------------------------------------------------------------------- /chap06/p63.dat: -------------------------------------------------------------------------------- 1 | 40 20 8 2 | 1 3 | 20.0 10.0 20.0 16.0 1.0E5 0.3 4 | 20.0 5 | 0.0 0.25 0.5 0.75 1.0 1.25 1.5 1.75 2.0 2.25 2.5 2.75 3.0 6 | 3.25 3.5 3.75 4.0 4.25 4.5 4.75 5.0 5.25 5.5 5.75 6.0 7 | 6.25 6.5 6.75 7.0 7.25 7.5 7.75 8.0 8.25 8.5 8.75 9.0 8 | 9.25 9.5 9.75 10.0 9 | 5.0 4.75 4.5 4.25 4.0 3.75 3.5 3.25 3.0 2.75 2.5 2.25 2.0 1.75 1.5 10 | 1.25 1.0 0.75 0.5 0.25 0.0 11 | 0.001 500 12 | 25 -0.001 13 | 14 | 15 | -------------------------------------------------------------------------------- /chap06/p63.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap06/p63.m -------------------------------------------------------------------------------- /chap06/p64.dat: -------------------------------------------------------------------------------- 1 | 20.0 20.0 20.0 10.0 5.0 2 | 20 10 10 5 3 | 1 4 | 20.0 15.0 0.0 20.0 1.0e5 0.3 5 | 0.0001 500 6 | 6 7 | 1.0 1.2 1.4 1.5 1.55 1.6 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /chap06/p65.dat: -------------------------------------------------------------------------------- 1 | 7 7 1 2 | 30.0 0.0 30.0 20.0 1.0 1.0e5 0.3 3 | 0.0 0.25 0.5 1.0 1.5 2.5 3.5 5.0 4 | 1.0 0.75 0.5 0.25 0.0 -0.25 -0.625 -1.0 5 | 29 6 | 15 0 0 23 0 0 38 0 0 46 0 0 61 0 0 69 0 0 7 | 84 0 0 92 0 0 107 0 0 115 0 0 130 0 0 138 0 0 8 | 153 0 0 161 0 0 162 0 0 163 0 0 164 0 0 165 0 0 9 | 166 0 0 167 0 0 168 0 0 169 0 0 170 0 0 171 0 0 10 | 172 0 0 173 0 0 174 0 0 175 0 0 176 0 0 11 | 9 12 | 1 1 2 1 3 1 4 1 5 1 6 1 13 | 7 1 8 1 9 1 14 | 0.001 75 35 2.0e-5 15 | -------------------------------------------------------------------------------- /chap06/p65.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/chap06/p65.m -------------------------------------------------------------------------------- /chap06/p66.dat: -------------------------------------------------------------------------------- 1 | 8 4 1 2 | 100.0 1.0E5 0.3 3 | 0.0 1.0 2.0 3.0 4.0 5.5 7.0 9.0 12.0 4 | 0.0 -1.25 -2.5 -3.75 -5.0 5 | 5 6 | 1 0.0 -0.166667 10 0.0 -0.666667 15 0.0 -0.333333 7 | 24 0.0 -0.666667 29 0.0 -0.166667 8 | 0.00005 0.001 25 9 | 10 10 | 200.0 100.0 50.0 50.0 50.0 30.0 20.0 10.0 5.0 4.0 11 | 12 | -------------------------------------------------------------------------------- /chap06/p67.dat: -------------------------------------------------------------------------------- 1 | 8 4 0.0001 150 1 2 | 100.0 1.0E5 0.3 3 | 0.0 1.0 2.0 3.0 4.0 5.5 7.0 9.0 12.0 4 | 0.0 -1.25 -2.5 -3.75 -5.0 5 | 5 6 | 1 0.0 -0.166667 10 0.0 -0.666667 15 0.0 -0.333333 7 | 24 0.0 -0.666667 29 0.0 -0.166667 8 | 0.00005 0.001 25 9 | 10 10 | 200.0 100.0 50.0 50.0 50.0 30.0 20.0 10.0 5.0 4.0 11 | 12 | -------------------------------------------------------------------------------- /chap06/p68.dat: -------------------------------------------------------------------------------- 1 | 8 4 1 2 | 100.0 1.0E5 0.3 3 | 0.0 1.0 2.0 3.0 4.0 5.5 7.0 9.0 12.0 4 | 0.0 -1.25 -2.5 -3.75 -5.0 5 | 5 6 | 1 0.0 -0.166667 10 0.0 -0.666667 15 0.0 -0.333333 7 | 24 0.0 -0.666667 29 0.0 -0.166667 8 | 0.001 25 9 | 10 10 | 200.0 100.0 50.0 50.0 50.0 30.0 20.0 10.0 5.0 4.0 11 | 12 | 13 | -------------------------------------------------------------------------------- /chap06/p69.dat: -------------------------------------------------------------------------------- 1 | 12 4 263 3 500 0.0001 2 | 5 8 4 1 1.0 3 | 1.0e5 0.49 14.0 0.0 0.0 20.0 4 | 1.0e5 0.49 14.0 0.0 0.0 20.0 5 | 0.0 10.0 15.0 18.0 20.0 22.0 24.0 26.0 28.0 30.0 32.0 35.0 38.0 6 | 0.0 5.0 7.5 9.0 10.0 7 | 20.0 22.0 24.0 26.0 28.0 30.0 32.0 35.0 38.0 8 | 10.0 11.0 12.0 13.0 14.0 9 | 49 10 | 1 0 0 2 0 0 3 0 0 4 0 0 5 0 0 6 0 0 7 0 0 8 0 0 11 | 9 0 0 10 0 0 11 0 0 12 0 0 13 0 0 14 0 0 15 0 0 16 0 0 12 | 17 0 0 18 0 0 19 0 0 20 0 0 21 0 0 22 0 0 23 0 0 24 0 0 13 | 25 0 0 26 0 1 38 0 1 39 0 1 63 0 1 64 0 1 76 0 1 77 0 1 14 | 101 0 1 102 0 1 114 0 1 115 0 1 139 0 1 140 0 1 152 0 1 153 0 1 15 | 177 0 1 186 0 1 203 0 1 211 0 1 226 0 1 233 0 1 246 0 1 252 0 1 16 | 263 0 1 17 | 18 | -------------------------------------------------------------------------------- /chap07/p71.f03: -------------------------------------------------------------------------------- 1 | PROGRAM p71 2 | !------------------------------------------------------------------------- 3 | ! Program 7.1 One dimensional analysis of steady seepage using 4 | ! 2-node "rod" elements. 5 | !------------------------------------------------------------------------- 6 | USE main 7 | IMPLICIT NONE 8 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 9 | INTEGER::fixed_freedoms,i,iel,k,loaded_nodes,nels,neq,nlen,nod=2,nn, & 10 | nprops=1,np_types 11 | REAL(iwp)::penalty=1.0e20_iwp,zero=0.0_iwp 12 | CHARACTER(LEN=15)::argv 13 | !-----------------------dynamic arrays------------------------------------ 14 | INTEGER,ALLOCATABLE::etype(:),kdiag(:),g_num(:,:),node(:),num(:) 15 | REAL(iwp),ALLOCATABLE::disps(:),ell(:),kp(:,:),kv(:),kvh(:),loads(:), & 16 | prop(:,:),value(:) 17 | !-----------------------input and initialisation-------------------------- 18 | CALL getname(argv,nlen) 19 | OPEN(10,FILE=argv(1:nlen)//'.dat') 20 | OPEN(11,FILE=argv(1:nlen)//'.res') 21 | READ(10,*)nels,nn,np_types 22 | neq=nn 23 | ALLOCATE(ell(nels),num(nod),prop(nprops,np_types),etype(nels), & 24 | kp(nod,nod),g_num(nod,nels),kdiag(neq),loads(0:neq),disps(0:neq)) 25 | READ(10,*)prop 26 | etype=1 27 | IF(np_types>1)READ(10,*)etype 28 | READ(10,*)ell 29 | READ(10,*)g_num 30 | kdiag=0 31 | !-----------------------loop the elements to find global arrays sizes----- 32 | elements_1: DO iel=1,nels 33 | num=g_num(:,iel) 34 | CALL fkdiag(kdiag,num) 35 | END DO elements_1 36 | DO i=2,neq 37 | kdiag(i)=kdiag(i)+kdiag(i-1) 38 | END DO 39 | WRITE(11,'(2(A,I5))') & 40 | " There are",neq," equations and the skyline storage is",kdiag(neq) 41 | ALLOCATE(kv(kdiag(neq)),kvh(kdiag(neq))) 42 | kv=zero 43 | !-----------------------global conductivity matrix assembly--------------- 44 | elements_2: DO iel=1,nels 45 | CALL rod_km(kp,prop(1,etype(iel)),ell(iel)) 46 | num=g_num(:,iel) 47 | CALL fsparv(kv,kp,num,kdiag) 48 | END DO elements_2 49 | kvh=kv 50 | !-----------------------specify boundary values--------------------------- 51 | loads=zero 52 | READ(10,*)loaded_nodes,(k,loads(k),i=1,loaded_nodes) 53 | READ(10,*)fixed_freedoms 54 | IF(fixed_freedoms/=0)THEN 55 | ALLOCATE(node(fixed_freedoms),value(fixed_freedoms)) 56 | READ(10,*)(node(i),value(i),i=1,fixed_freedoms) 57 | kv(kdiag(node))=kv(kdiag(node))+penalty 58 | loads(node)=kv(kdiag(node))*value 59 | END IF 60 | !-----------------------equation solution--------------------------------- 61 | CALL sparin(kv,kdiag) 62 | CALL spabac(kv,loads,kdiag) 63 | !-----------------------retrieve nodal net flow rates--------------------- 64 | CALL linmul_sky(kvh,loads,disps,kdiag) 65 | WRITE(11,'(/A)')" Node Total Head Flow rate" 66 | disps(0)=zero 67 | DO k=1,nn 68 | WRITE(11,'(I5,2E12.4)')k,loads(k),disps(k) 69 | END DO 70 | WRITE(11,'(/A)')" Inflow Outflow" 71 | WRITE(11,'(5X,2E12.4)') & 72 | SUM(disps,MASK=disps>zero),SUM(disps,MASK=disps1)READ(10,*)etype 32 | READ(10,*)g_coord; 33 | READ(10,*)g_num 34 | IF(ndim==2)CALL mesh(g_coord,g_num,argv,nlen,12); 35 | kdiag=0 36 | !-----------------------loop the elements to find global arrays sizes----- 37 | elements_1: DO iel =1,nels; 38 | num=g_num(:,iel); 39 | CALL fkdiag(kdiag,num) 40 | END DO elements_1 41 | DO i=2,neq; 42 | kdiag(i)=kdiag(i)+kdiag(i-1); 43 | END DO 44 | WRITE(11,'(2(A,I5))') & 45 | " There are",neq," equations and the skyline storage is",kdiag(neq) 46 | ALLOCATE(kv(kdiag(neq)),kvh(kdiag(neq))); 47 | kv=zero 48 | CALL sample(element,points,weights) 49 | !-----------------------global conductivity matrix assembly--------------- 50 | elements_2: DO iel=1,nels 51 | kay=zero; 52 | DO i=1,ndim; 53 | kay(i,i)=prop(i,etype(iel)); 54 | END DO 55 | num=g_num(:,iel); 56 | coord=TRANSPOSE(g_coord(:,num)); 57 | kp=zero 58 | gauss_pts_1: DO i=1,nip 59 | CALL shape_der(der,points,i); 60 | jac=MATMUL(der,coord) 61 | det=determinant(jac); 62 | CALL invert(jac); 63 | deriv=MATMUL(jac,der) 64 | kp=kp+MATMUL(MATMUL(TRANSPOSE(deriv),kay),deriv)*det*weights(i) 65 | END DO gauss_pts_1; 66 | CALL fsparv(kv,kp,num,kdiag) 67 | END DO elements_2; 68 | kvh=kv 69 | !-----------------------specify boundary values--------------------------- 70 | loads=zero; 71 | READ(10,*)loaded_nodes,(k,loads(k),i=1,loaded_nodes) 72 | READ(10,*)fixed_freedoms 73 | IF(fixed_freedoms/=0)THEN 74 | ALLOCATE(node(fixed_freedoms),value(fixed_freedoms)) 75 | READ(10,*)(node(i),value(i),i=1,fixed_freedoms) 76 | kv(kdiag(node))=kv(kdiag(node))+penalty 77 | loads(node)=kv(kdiag(node))*value 78 | END IF 79 | !-----------------------equation solution--------------------------------- 80 | CALL sparin(kv,kdiag); 81 | CALL spabac(kv,loads,kdiag) 82 | !-----------------------retrieve nodal net flow rates--------------------- 83 | CALL linmul_sky(kvh,loads,disps,kdiag) 84 | WRITE(11,'(/A)')" Node Total Head Flow rate" 85 | DO k=1,nn; 86 | WRITE(11,'(I5,2E12.4)')k,loads(k),disps(k); 87 | END DO 88 | disps(0)=zero; 89 | WRITE(11,'(/A)')" Inflow Outflow" 90 | WRITE(11,'(5X,2E12.4)') & 91 | SUM(disps,MASK=disps>zero),SUM(disps,MASK=disps1)READ(10,*)etype 29 | READ(10,*)ell 30 | READ(10,*)dtim,nstep,theta,npri,nres,ntime 31 | kdiag=0 32 | !-----------------------loop the elements to find global arrays sizes----- 33 | elements_1: DO iel=1,nels 34 | num=(/iel,iel+1/) 35 | CALL fkdiag(kdiag,num) 36 | END DO elements_1 37 | DO i=2,neq 38 | kdiag(i)=kdiag(i)+kdiag(i-1) 39 | END DO 40 | ALLOCATE(kv(kdiag(neq)),bp(kdiag(neq))) 41 | bp=zero 42 | kv=zero 43 | WRITE(11,'(2(a,i5))') & 44 | " There are",neq," equations and the skyline storage is",kdiag(neq) 45 | !-----------------------global conductivity and "mass" matrix assembly---- 46 | elements_2: DO iel=1,nels 47 | num=(/iel,iel+1/) 48 | CALL rod_km(kc,prop(1,etype(iel)),ell(iel)) 49 | CALL rod_mm(mm,ell(iel)) 50 | CALL fsparv(kv,kc,num,kdiag) 51 | CALL fsparv(bp,mm,num,kdiag) 52 | END DO elements_2 53 | kv=kv*theta*dtim 54 | bp=bp+kv 55 | kv=bp-kv/theta 56 | !-----------------------specify initial and boundary values--------------- 57 | loads(0)=zero 58 | READ(10,*)loads(1:) 59 | a0=zero 60 | DO iel=1,nels 61 | a0=a0+pt5*ell(iel)*(loads(iel)+loads(iel+1)) 62 | END DO 63 | READ(10,*)fixed_freedoms 64 | IF(fixed_freedoms/=0)then 65 | ALLOCATE(node(fixed_freedoms),value(fixed_freedoms), & 66 | storbp(fixed_freedoms)) 67 | READ(10,*)(node(i),value(i),i=1,fixed_freedoms) 68 | bp(kdiag(node))=bp(kdiag(node))+penalty 69 | storbp=bp(kdiag(node)) 70 | END IF 71 | !-----------------------factorise equations------------------------------- 72 | CALL sparin(bp,kdiag) 73 | !-----------------------time stepping loop-------------------------------- 74 | WRITE(11,'(/a,i3,a)')" Time Uav Pressure (node",nres,")" 75 | WRITE(11,'(3e12.4)')0.0,0.0,loads(nres) 76 | timesteps: DO j=1,nstep 77 | time=j*dtim 78 | CALL linmul_sky(kv,loads,newlo,kdiag) 79 | IF(fixed_freedoms/=0)newlo(node)=storbp*value 80 | CALL spabac(bp,newlo,kdiag) 81 | loads=newlo 82 | at=zero 83 | DO iel=1,nels 84 | at=at+pt5*ell(iel)*(loads(iel)+loads(iel+1)) 85 | END DO 86 | IF(j==ntime)press(1:)=loads(1:) 87 | IF(j/npri*npri==j)WRITE(11,'(3e12.4)')time,(a0-at)/a0,loads(nres) 88 | END DO timesteps 89 | WRITE(11,'(/a,e10.4,a)')" Depth Pressure (time=",ntime*dtim,")" 90 | WRITE(11,'(3e12.4)')0.0,press(1) 91 | WRITE(11,'(2e12.4)')(SUM(ell(1:i)),press(i+1),i=1,nels) 92 | STOP 93 | END PROGRAM p81 94 | -------------------------------------------------------------------------------- /chap08/p810.dat: -------------------------------------------------------------------------------- 1 | 1 100 1 2 | 0.0 0.0 3 | 0.00 0.02 4 | 0.00 -0.02 -0.04 -0.06 -0.08 -0.10 -0.12 -0.14 -0.16 -0.18 5 | -0.20 -0.22 -0.24 -0.26 -0.28 -0.30 -0.32 -0.34 -0.36 -0.38 6 | -0.40 -0.42 -0.44 -0.46 -0.48 -0.50 -0.52 -0.54 -0.56 -0.58 7 | -0.60 -0.62 -0.64 -0.66 -0.68 -0.70 -0.72 -0.74 -0.76 -0.78 8 | -0.80 -0.82 -0.84 -0.86 -0.88 -0.90 -0.92 -0.94 -0.96 -0.98 9 | -1.00 -1.02 -1.04 -1.06 -1.08 -1.10 -1.12 -1.14 -1.16 -1.18 10 | -1.20 -1.22 -1.24 -1.26 -1.28 -1.30 -1.32 -1.34 -1.36 -1.38 11 | -1.40 -1.42 -1.44 -1.46 -1.48 -1.50 -1.52 -1.54 -1.56 -1.58 12 | -1.60 -1.62 -1.64 -1.66 -1.68 -1.70 -1.72 -1.74 -1.76 -1.78 13 | -1.80 -1.82 -1.84 -1.86 -1.88 -1.90 -1.92 -1.94 -1.96 -1.98 14 | -2.00 15 | 0.04 25 0.5 1 3 25 16 | 0.0 1.0 17 | 2 18 | 1 2 19 | 20 | 21 | -------------------------------------------------------------------------------- /chap08/p811.dat: -------------------------------------------------------------------------------- 1 | 'axisymmetric' 'z' 2 | 8 6 1 3 | 17.4 17.4 4155400.0 4 | 0.0 0.005 0.01 0.015 0.02 0.025 0.03 0.035 0.04 5 | 0.0 -0.005 -0.01 -0.015 -0.02 -0.025 -0.03 6 | 1.0 180 0.5 15 7 180 7 | 0 8 | 14 9 | 1 8 500.0 300.0 10 | 8 15 500.0 300.0 11 | 15 22 500.0 300.0 12 | 22 29 500.0 300.0 13 | 29 36 500.0 300.0 14 | 36 43 500.0 300.0 15 | 43 50 500.0 300.0 16 | 50 57 500.0 300.0 17 | 57 58 500.0 300.0 18 | 58 59 500.0 300.0 19 | 59 60 500.0 300.0 20 | 60 61 500.0 300.0 21 | 61 62 500.0 300.0 22 | 62 63 500.0 300.0 23 | 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 24 | 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 25 | 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 26 | 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 27 | 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 28 | 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 29 | 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 600.0 30 | 0 31 | 10 32 | 33 | 34 | 0.1 1800 0.5 150 7 1800 35 | -------------------------------------------------------------------------------- /chap08/p81_2.dat: -------------------------------------------------------------------------------- 1 | 10 1 2 | 1.0 3 | 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 4 | 0.001 2000 0.5 100 11 1000 5 | 0.0 6 | 10.0 7 | 20.0 8 | 30.0 9 | 40.0 10 | 50.0 11 | 60.0 12 | 70.0 13 | 80.0 14 | 90.0 15 | 100.0 16 | 1 17 | 1 0.0 18 | -------------------------------------------------------------------------------- /chap08/p81_3.dat: -------------------------------------------------------------------------------- 1 | 10 1 2 | 1.0 3 | 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 4 | 0.001 2000 0.5 100 11 1000 5 | 100.0 6 | 90.0 7 | 80.0 8 | 70.0 9 | 60.0 10 | 50.0 11 | 40.0 12 | 30.0 13 | 20.0 14 | 10.0 15 | 0.0 16 | 1 17 | 1 0.0 18 | -------------------------------------------------------------------------------- /chap08/p81_4.dat: -------------------------------------------------------------------------------- 1 | 100 2 2 | 1.0 10.0 3 | 1 1 1 1 1 1 1 1 1 1 4 | 1 1 1 1 1 1 1 1 1 1 5 | 1 1 1 1 1 1 1 1 1 1 6 | 1 1 1 1 1 1 1 1 1 1 7 | 2 2 2 2 2 2 2 2 2 2 8 | 2 2 2 2 2 2 2 2 2 2 9 | 1 1 1 1 1 1 1 1 1 1 10 | 1 1 1 1 1 1 1 1 1 1 11 | 1 1 1 1 1 1 1 1 1 1 12 | 1 1 1 1 1 1 1 1 1 1 13 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 14 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 15 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 16 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 17 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 18 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 19 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 20 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 21 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 22 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 23 | 0.001 2000 0.5 100 101 1000 24 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 25 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 26 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 27 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 28 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 29 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 30 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 31 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 32 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 33 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 34 | 100.0 35 | 1 36 | 1 0.0 37 | 38 | -------------------------------------------------------------------------------- /chap08/p81_5.dat: -------------------------------------------------------------------------------- 1 | 100 2 2 | 10.0 1.0 3 | 1 1 1 1 1 1 1 1 1 1 4 | 1 1 1 1 1 1 1 1 1 1 5 | 1 1 1 1 1 1 1 1 1 1 6 | 1 1 1 1 1 1 1 1 1 1 7 | 2 2 2 2 2 2 2 2 2 2 8 | 2 2 2 2 2 2 2 2 2 2 9 | 1 1 1 1 1 1 1 1 1 1 10 | 1 1 1 1 1 1 1 1 1 1 11 | 1 1 1 1 1 1 1 1 1 1 12 | 1 1 1 1 1 1 1 1 1 1 13 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 14 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 15 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 16 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 17 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 18 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 19 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 20 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 21 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 22 | 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 23 | 0.001 2000 0.5 100 101 1000 24 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 25 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 26 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 27 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 28 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 29 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 30 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 31 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 32 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 33 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 34 | 100.0 35 | 1 36 | 1 0.0 37 | 38 | 39 | 40 | 41 | -------------------------------------------------------------------------------- /chap08/p82.dat: -------------------------------------------------------------------------------- 1 | 40 4 2 | 2.78E-11 6.41E-5 3 | 8.25E-11 4.08E-5 4 | 1.17E-11 2.04E-5 5 | 2.94E-11 4.08E-5 6 | 9.81 7 | 1 1 1 1 1 1 1 1 1 1 8 | 2 2 2 2 2 2 2 2 2 2 9 | 3 3 3 3 3 3 3 3 3 3 10 | 4 4 4 4 4 4 4 4 4 4 11 | 0.305 0.305 0.305 0.305 0.305 0.305 0.305 0.305 0.305 0.305 12 | 0.61 0.61 0.61 0.61 0.61 0.61 0.61 0.61 0.61 0.61 13 | 0.914 0.914 0.914 0.914 0.914 0.914 0.914 0.914 0.914 0.914 14 | 0.61 0.61 0.61 0.61 0.61 0.61 0.61 0.61 0.61 0.61 15 | 86400.0 7200 0.5 400 21 740 16 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 17 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 18 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 19 | 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 20 | 100.0 21 | 2 22 | 1 0.0 23 | 41 0.0 24 | 25 | -------------------------------------------------------------------------------- /chap08/p83.dat: -------------------------------------------------------------------------------- 1 | 10 1 2 | 1.0 3 | 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 4 | 0.001 2000 100 11 1000 5 | 100.0 100.0 100.0 100.0 100.0 100.0 6 | 100.0 100.0 100.0 100.0 100.0 7 | 1 8 | 1 0.0 9 | 10 | -------------------------------------------------------------------------------- /chap08/p83.f03: -------------------------------------------------------------------------------- 1 | PROGRAM p83 2 | !------------------------------------------------------------------------- 3 | ! Program 8.3 One dimensional consolidation analysis using 2-node "rod" 4 | ! elements. Explicit time integration. Element-by-element. 5 | ! Lumped mass. 6 | !------------------------------------------------------------------------- 7 | USE main 8 | IMPLICIT NONE 9 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 10 | INTEGER::fixed_freedoms,i,iel,j,nels,neq,nlen,nod=2,npri,nprops=1, & 11 | np_types,nres,nstep,ntime 12 | REAL(iwp)::at,a0,dtim,one=1.0_iwp,pt5=0.5_iwp,time,two=2.0_iwp, & 13 | zero=0.0_iwp 14 | CHARACTER(LEN=15)::argv 15 | !-----------------------dynamic arrays------------------------------------ 16 | INTEGER,ALLOCATABLE::etype(:),node(:),num(:) 17 | REAL(iwp),ALLOCATABLE::ell(:),globma(:),kc(:,:),loads(:),mass(:),mm(:,:),& 18 | newlo(:),press(:),prop(:,:),store_mm(:,:,:),value(:) 19 | !-----------------------input and initialisation-------------------------- 20 | CALL getname(argv,nlen) 21 | OPEN(10,FILE=argv(1:nlen)//'.dat') 22 | OPEN(11,FILE=argv(1:nlen)//'.res') 23 | READ(10,*)nels,np_types 24 | neq=nels+1 25 | ALLOCATE(num(nod),etype(nels),kc(nod,nod),mm(nod,nod),press(0:neq), & 26 | prop(nprops,np_types),ell(nels),loads(0:neq),newlo(0:neq),mass(nod), & 27 | globma(0:neq),store_mm(nod,nod,nels)) 28 | READ(10,*)prop 29 | etype=1 30 | IF(np_types>1)READ(10,*)etype 31 | READ(10,*)ell,dtim,nstep,npri,nres,ntime 32 | globma=zero 33 | WRITE(11,'(2(A,I5))')" There are",neq," equations" 34 | !-----------------------global conductivity and "mass" matrix assembly---- 35 | elements_1: DO iel=1,nels 36 | num=(/iel,iel+1/) 37 | CALL rod_km(kc,prop(1,etype(iel)),ell(iel)) 38 | mm=zero 39 | DO i=1,nod 40 | mm(i,i)=ell(iel)/two 41 | mass(i)=ell(iel)/two 42 | END DO 43 | store_mm(:,:,iel)=mm-kc*dtim 44 | globma(num)=globma(num)+mass 45 | END DO elements_1 46 | !-----------------------specify initial and boundary values--------------- 47 | READ(10,*)loads(1:) 48 | loads(0)=zero 49 | READ(10,*)fixed_freedoms 50 | globma(1:)=one/globma(1:) 51 | IF(fixed_freedoms/=0)then 52 | ALLOCATE(node(fixed_freedoms),value(fixed_freedoms)) 53 | READ(10,*)(node(i),value(i),i=1,fixed_freedoms) 54 | END IF 55 | !-----------------------time stepping loop-------------------------------- 56 | WRITE(11,'(/A,I3,A)')" Time Uav Pressure (node",nres,")" 57 | WRITE(11,'(3E12.4)')0.0,0.0,loads(nres) 58 | a0=zero 59 | DO iel=1,nels 60 | a0=a0+pt5*ell(iel)*(loads(iel)+loads(iel+1)) 61 | END DO 62 | timesteps: DO j=1,nstep 63 | time=j*dtim 64 | newlo=zero 65 | elements_2: DO iel=1,nels 66 | num=(/iel,iel+1/) 67 | mm=store_mm(:,:,iel) 68 | newlo(num)=newlo(num)+MATMUL(mm,loads(num)) 69 | END DO elements_2 70 | newlo(0)=zero 71 | loads=newlo*globma 72 | IF(fixed_freedoms/=0)loads(node)=value 73 | at=zero 74 | DO iel=1,nels 75 | at=at+pt5*ell(iel)*(loads(iel)+loads(iel+1)) 76 | END DO 77 | IF(j==ntime)press(1:)=loads(1:) 78 | IF(j/npri*npri==j)WRITE(11,'(3E12.4)')time,(a0-at)/a0,loads(nres) 79 | END DO timesteps 80 | WRITE(11,'(/A,E10.4,A)')" Depth Pressure (time=",ntime*dtim,")" 81 | WRITE(11,'(3E12.4)')0.0,press(1) 82 | WRITE(11,'(2E12.4)')(SUM(ell(1:i)),press(i+1),i=1,nels) 83 | STOP 84 | END PROGRAM p83 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | -------------------------------------------------------------------------------- /chap08/p84_1.dat: -------------------------------------------------------------------------------- 1 | 'plane' 'x' 2 | 5 5 1 3 | 1.0 1.0 4 | 0.0 0.2 0.4 0.6 0.8 1.0 5 | 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 6 | 0.01 150 0.5 10 31 100 7 | 0.0 0.0 0.0 0.0 0.0 0.0 8 | 100.0 100.0 100.0 100.0 100.0 0.0 9 | 100.0 100.0 100.0 100.0 100.0 0.0 10 | 100.0 100.0 100.0 100.0 100.0 0.0 11 | 100.0 100.0 100.0 100.0 100.0 0.0 12 | 100.0 100.0 100.0 100.0 100.0 0.0 13 | 11 14 | 1 0.0 2 0.0 3 0.0 4 0.0 5 0.0 6 0.0 15 | 12 0.0 18 0.0 24 0.0 30 0.0 36 0.0 16 | 10 17 | -------------------------------------------------------------------------------- /chap08/p84_2.dat: -------------------------------------------------------------------------------- 1 | 'axisymmetric' 'r' 2 | 5 5 1 3 | 1.0 1.0 4 | 0.0 0.2 0.4 0.6 0.8 1.0 5 | 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 6 | 0.01 150 0.5 10 31 100 7 | 0.0 0.0 0.0 0.0 0.0 0.0 8 | 100.0 100.0 100.0 100.0 100.0 0.0 9 | 100.0 100.0 100.0 100.0 100.0 0.0 10 | 100.0 100.0 100.0 100.0 100.0 0.0 11 | 100.0 100.0 100.0 100.0 100.0 0.0 12 | 100.0 100.0 100.0 100.0 100.0 0.0 13 | 11 14 | 1 0.0 2 0.0 3 0.0 4 0.0 5 0.0 6 0.0 15 | 12 0.0 18 0.0 24 0.0 30 0.0 36 0.0 16 | 10 17 | 18 | -------------------------------------------------------------------------------- /chap08/p85.dat: -------------------------------------------------------------------------------- 1 | 'plane' 'x' 2 | 5 5 0.0001 100 1 3 | 1.0 1.0 4 | 0.0 0.2 0.4 0.6 0.8 1.0 5 | 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 6 | 0.01 150 0.5 10 31 100 7 | 0.0 0.0 0.0 0.0 0.0 0.0 8 | 100.0 100.0 100.0 100.0 100.0 0.0 9 | 100.0 100.0 100.0 100.0 100.0 0.0 10 | 100.0 100.0 100.0 100.0 100.0 0.0 11 | 100.0 100.0 100.0 100.0 100.0 0.0 12 | 100.0 100.0 100.0 100.0 100.0 0.0 13 | 11 14 | 1 0.0 2 0.0 3 0.0 4 0.0 5 0.0 6 0.0 15 | 12 0.0 18 0.0 24 0.0 30 0.0 36 0.0 16 | 10 17 | 18 | 19 | -------------------------------------------------------------------------------- /chap08/p86.dat: -------------------------------------------------------------------------------- 1 | 'plane' 'x' 2 | 5 5 1 3 | 1.0 1.0 4 | 0.0 0.2 0.4 0.6 0.8 1.0 5 | 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 6 | 0.01 150 10 31 100 7 | 0.0 0.0 0.0 0.0 0.0 0.0 8 | 100.0 100.0 100.0 100.0 100.0 0.0 9 | 100.0 100.0 100.0 100.0 100.0 0.0 10 | 100.0 100.0 100.0 100.0 100.0 0.0 11 | 100.0 100.0 100.0 100.0 100.0 0.0 12 | 100.0 100.0 100.0 100.0 100.0 0.0 13 | 11 14 | 1 0.0 2 0.0 3 0.0 4 0.0 5 0.0 6 0.0 15 | 12 0.0 18 0.0 24 0.0 30 0.0 36 0.0 16 | 10 17 | 18 | 19 | -------------------------------------------------------------------------------- /chap08/p87.dat: -------------------------------------------------------------------------------- 1 | 'plane' 'x' 2 | 5 5 1 3 | 1.0 1.0 4 | 0.0 0.2 0.4 0.6 0.8 1.0 5 | 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 6 | 0.01 150 0.5 10 31 100 7 | 0.0 0.0 0.0 0.0 0.0 0.0 8 | 100.0 100.0 100.0 100.0 100.0 0.0 9 | 100.0 100.0 100.0 100.0 100.0 0.0 10 | 100.0 100.0 100.0 100.0 100.0 0.0 11 | 100.0 100.0 100.0 100.0 100.0 0.0 12 | 100.0 100.0 100.0 100.0 100.0 0.0 13 | 11 14 | 1 0.0 2 0.0 3 0.0 4 0.0 5 0.0 6 0.0 15 | 12 0.0 18 0.0 24 0.0 30 0.0 36 0.0 16 | 10 17 | -------------------------------------------------------------------------------- /chap08/p89.dat: -------------------------------------------------------------------------------- 1 | 1 40 2 | 1 3 | 1.0e-6 0.49 4 | 0.0 1.4 5 | 56.0 54.6 53.2 51.8 50.4 49.0 47.6 46.2 44.8 43.4 6 | 42.0 40.6 39.2 37.8 36.4 35.0 33.6 32.2 30.8 29.4 7 | 28.0 26.6 25.2 23.8 22.4 21.0 19.6 18.2 16.8 15.4 8 | 14.0 12.6 11.2 9.8 8.4 7.0 5.6 4.2 2.8 1.4 9 | 0.0 10 | 300.0 20 1.0 1 82 5 11 | 0.0 0.0135 12 | 10 13 | -------------------------------------------------------------------------------- /chap09/p91.dat: -------------------------------------------------------------------------------- 1 | 5 5 0.001 30 0.01 1.0 2 | 0.0 0.2 0.4 0.6 0.8 1.0 3 | 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 4 | 81 5 | 1 1 0 0 2 1 0 0 3 1 1 0 4 1 0 0 5 1 1 0 6 1 0 0 6 | 7 1 1 0 8 1 0 0 9 1 1 0 10 1 0 0 11 1 1 0 12 0 0 0 7 | 13 1 0 1 14 1 0 1 15 1 0 1 16 1 0 1 17 0 0 0 18 0 1 0 8 | 19 1 0 1 21 1 0 1 23 1 0 1 25 1 0 1 27 1 0 1 28 0 1 0 9 | 29 0 0 0 30 1 0 1 31 1 0 1 32 1 0 1 33 1 0 1 34 0 0 0 10 | 35 0 1 0 36 1 0 1 38 1 0 1 40 1 0 1 42 1 0 1 44 1 0 1 11 | 45 0 1 0 46 0 0 0 47 1 0 1 48 1 0 1 49 1 0 1 50 1 0 1 12 | 51 0 0 0 52 0 1 0 53 1 0 1 54 1 1 1 55 1 0 1 57 1 0 1 13 | 59 1 0 1 61 1 0 1 62 0 1 0 63 0 0 0 64 1 0 1 65 1 0 1 14 | 66 1 0 1 67 1 0 1 68 0 0 0 69 0 1 0 70 1 0 1 72 1 0 1 15 | 74 1 0 1 76 1 0 1 78 1 0 1 79 0 1 0 80 0 0 0 81 1 0 1 16 | 82 1 0 1 83 1 0 1 84 1 0 1 85 0 0 0 86 0 1 0 87 0 0 0 17 | 88 0 1 0 89 0 0 0 90 0 1 0 91 0 0 0 92 0 1 0 93 0 0 0 18 | 94 0 1 0 95 0 0 0 96 0 1 0 19 | 11 20 | 1 1 1.0 2 1 1.0 3 1 1.0 4 1 1.0 5 1 1.0 21 | 6 1 1.0 7 1 1.0 8 1 1.0 9 1 1.0 10 1 1.0 22 | 11 1 1.0 23 | -------------------------------------------------------------------------------- /chap09/p92.dat: -------------------------------------------------------------------------------- 1 | 5 5 0.001 30 0.01 1.0 2 | 1.0e-5 200 1.0 4 0.0 3 | 0.0 0.2 0.4 0.6 0.8 1.0 4 | 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 5 | 81 6 | 1 1 0 0 2 1 0 0 3 1 1 0 4 1 0 0 5 1 1 0 6 1 0 0 7 | 7 1 1 0 8 1 0 0 9 1 1 0 10 1 0 0 11 1 1 0 12 0 0 0 8 | 13 1 0 1 14 1 0 1 15 1 0 1 16 1 0 1 17 0 0 0 18 0 1 0 9 | 19 1 0 1 21 1 0 1 23 1 0 1 25 1 0 1 27 1 0 1 28 0 1 0 10 | 29 0 0 0 30 1 0 1 31 1 0 1 32 1 0 1 33 1 0 1 34 0 0 0 11 | 35 0 1 0 36 1 0 1 38 1 0 1 40 1 0 1 42 1 0 1 44 1 0 1 12 | 45 0 1 0 46 0 0 0 47 1 0 1 48 1 0 1 49 1 0 1 50 1 0 1 13 | 51 0 0 0 52 0 1 0 53 1 0 1 54 1 1 1 55 1 0 1 57 1 0 1 14 | 59 1 0 1 61 1 0 1 62 0 1 0 63 0 0 0 64 1 0 1 65 1 0 1 15 | 66 1 0 1 67 1 0 1 68 0 0 0 69 0 1 0 70 1 0 1 72 1 0 1 16 | 74 1 0 1 76 1 0 1 78 1 0 1 79 0 1 0 80 0 0 0 81 1 0 1 17 | 82 1 0 1 83 1 0 1 84 1 0 1 85 0 0 0 86 0 1 0 87 0 0 0 18 | 88 0 1 0 89 0 0 0 90 0 1 0 91 0 0 0 92 0 1 0 93 0 0 0 19 | 94 0 1 0 95 0 0 0 96 0 1 0 20 | 11 21 | 1 1 1.0 2 1 1.0 3 1 1.0 4 1 1.0 5 1 1.0 22 | 6 1 1.0 7 1 1.0 8 1 1.0 9 1 1.0 10 1 1.0 23 | 11 1 1.0 24 | -------------------------------------------------------------------------------- /chap09/p93.dat: -------------------------------------------------------------------------------- 1 | 25 1 2 | 2.694E-4 3.215E-5 3 | 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 4 | 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 5 | 1.0 1.0 1.0 1.0 1.0 6 | 1.0 30 0.5 2 26 10 7 | 2 8 | 1 1 0 26 0 1 9 | 1 10 | 1 1.0 11 | 5 12 | 0.0 0.0 5.0 300.0 13 | 10.0 450.0 20.0 500.0 14 | 300.0 500.0 15 | 16 | -------------------------------------------------------------------------------- /chap09/p94.dat: -------------------------------------------------------------------------------- 1 | 1 4 2 | 1 3 | 1.0 1.0 1.0 0.0 4 | 0.0 0.25 5 | 0.0 -0.25 -0.50 -0.75 -1.00 6 | 0.01 300 0.5 10 21 7 | 23 8 | 1 0 1 0 2 1 1 0 3 0 1 0 4 0 1 0 5 0 1 0 9 | 6 0 1 1 7 1 1 0 8 0 1 1 9 0 1 0 10 0 1 0 10 | 11 0 1 1 12 1 1 0 13 0 1 1 14 0 1 0 15 0 1 0 11 | 16 0 1 1 17 1 1 0 18 0 1 1 19 0 1 0 20 0 1 0 12 | 21 0 0 1 22 0 0 0 23 0 0 1 13 | 3 14 | 1 0.0 -0.041667 2 0.0 -0.166667 3 0.0 -0.041667 15 | 3 16 | 0.0 0.0 0.5 1.0 3.0 1.0 17 | 18 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /chap09/p95.dat: -------------------------------------------------------------------------------- 1 | 1 4 1.0e-5 200 2 | 1 3 | 1.0 1.0 1.0 0.0 4 | 0.0 0.25 5 | 0.0 -0.25 -0.50 -0.75 -1.00 6 | 0.01 300 0.5 10 21 7 | 23 8 | 1 0 1 0 2 1 1 0 3 0 1 0 4 0 1 0 5 0 1 0 9 | 6 0 1 1 7 1 1 0 8 0 1 1 9 0 1 0 10 0 1 0 10 | 11 0 1 1 12 1 1 0 13 0 1 1 14 0 1 0 15 0 1 0 11 | 16 0 1 1 17 1 1 0 18 0 1 1 19 0 1 0 20 0 1 0 12 | 21 0 0 1 22 0 0 0 23 0 0 1 13 | 3 14 | 1 0.0 -0.041667 2 0.0 -0.166667 3 0.0 -0.041667 15 | 3 16 | 0.0 0.0 0.5 1.0 3.0 1.0 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /chap09/p96_1.dat: -------------------------------------------------------------------------------- 1 | 2 2 1 2 | 1.0e-6 1.0e-6 1.0e4 0.25 30.0 0.0 0.0 3 | -100.0 4 | 0.0 0.5 1.0 5 | 0.0 -0.5 -1.0 6 | 0.5 200 0.5 1 1 7 | 20 8 | 1 0 1 0 2 1 1 0 3 1 1 0 4 1 1 0 5 1 1 0 9 | 6 0 1 0 7 1 1 0 8 1 1 0 9 0 1 1 10 1 1 0 10 | 12 1 1 0 13 1 1 0 14 0 1 0 15 1 1 0 16 1 1 0 11 | 17 0 0 1 18 1 0 0 19 1 0 1 20 1 0 0 21 1 0 0 12 | 5 13 | 1 0.0 -0.08333 2 0.0 -0.33333 3 0.0 -0.16667 14 | 4 0.0 -0.33333 5 0.0 -0.08333 15 | 0.001 250 16 | 2 17 | 0.0 0.0 10.0 150.0 18 | 19 | 20 | -------------------------------------------------------------------------------- /chap09/p96_2.dat: -------------------------------------------------------------------------------- 1 | 2 2 1 2 | 1.0e-6 1.0e-6 1.0e4 0.25 30.0 0.0 0.0 3 | -100.0 4 | 0.0 0.5 1.0 5 | 0.0 -0.5 -1.0 6 | 30.0 1000 0.5 1 1 7 | 20 8 | 1 0 1 0 2 1 1 0 3 1 1 0 4 1 1 0 5 1 1 0 9 | 6 0 1 0 7 1 1 0 8 1 1 0 9 0 1 1 10 1 1 0 10 | 12 1 1 0 13 1 1 0 14 0 1 0 15 1 1 0 16 1 1 0 11 | 17 0 0 1 18 1 0 0 19 1 0 1 20 1 0 0 21 1 0 0 12 | 5 13 | 1 0.0 -0.08333 2 0.0 -0.33333 3 0.0 -0.16667 14 | 4 0.0 -0.33333 5 0.0 -0.08333 15 | 0.001 250 16 | 2 17 | 0.0 0.0 12500.0 250.0 18 | 19 | 20 | -------------------------------------------------------------------------------- /chap10/p101.dat: -------------------------------------------------------------------------------- 1 | 5 2 | 1 3 | 0.08333 1.0 4 | 0.8 0.8 0.8 0.8 0.8 5 | 1 6 | 1 0 0 7 | 3 8 | -------------------------------------------------------------------------------- /chap10/p101.f03: -------------------------------------------------------------------------------- 1 | PROGRAM p101 2 | !------------------------------------------------------------------------- 3 | ! Program 10.1 Eigenvalue analysis of elastic beams using 2-node 4 | ! beam elements. Lumped mass. 5 | !------------------------------------------------------------------------- 6 | USE main 7 | USE geom 8 | IMPLICIT NONE 9 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 10 | INTEGER::i,idiag,iel,ifail,j,k,nband,ndof=4,nels,neq,nlen,nmodes,nn, & 11 | nod=2,nodof=2,nprops=2,np_types,nr 12 | REAL(iwp)::d12=12.0_iwp,one=1.0_iwp,pt5=0.5_iwp,penalty=1.e20_iwp, & 13 | etol=1.0e-30_iwp,zero=0.0_iwp 14 | CHARACTER(LEN=15)::argv 15 | !-----------------------dynamic arrays------------------------------------ 16 | INTEGER,ALLOCATABLE::etype(:),g(:),g_g(:,:),kdiag(:),nf(:,:),num(:) 17 | REAL(iwp),ALLOCATABLE::diag(:),ell(:),kh(:),km(:,:),ku(:,:),kv(:), & 18 | mm(:,:),prop(:,:),rrmass(:),udiag(:) 19 | !-----------------------input and initialisation-------------------------- 20 | CALL getname(argv,nlen) 21 | OPEN(10,FILE=argv(1:nlen)//'.dat') 22 | OPEN(11,FILE=argv(1:nlen)//'.res') 23 | READ(10,*)nels,np_types 24 | nn=nels+1 25 | ALLOCATE(nf(nodof,nn),km(ndof,ndof),num(nod),g(ndof),mm(ndof,ndof), & 26 | ell(nels),etype(nels),g_g(ndof,nels),prop(nprops,np_types)) 27 | READ(10,*)prop 28 | etype=1 29 | IF(np_types>1)READ(10,*)etype 30 | READ(10,*)ell 31 | nf=1 32 | READ(10,*)nr,(k,nf(:,k),i=1,nr) 33 | CALL formnf(nf) 34 | neq=MAXVAL(nf) 35 | ALLOCATE(diag(0:neq),udiag(0:neq),kdiag(neq),rrmass(0:neq)) 36 | !-----------------------loop the elements to find global array sizes------ 37 | nband=0 38 | kdiag=0 39 | elements_1: DO iel=1,nels 40 | num=(/iel,iel+1/) 41 | CALL num_to_g(num,nf,g) 42 | g_g(:,iel)=g 43 | IF(nband1)READ(10,*)etype 36 | READ(10,*)x_coords,y_coords,dtim,nstep,npri,nres 37 | nf=1 38 | READ(10,*)nr,(k,nf(:,k),i=1,nr) 39 | CALL formnf(nf) 40 | neq=MAXVAL(nf) 41 | CALL sample(element,points,weights) 42 | nband=0 43 | !---------------loop the elements to find bandwidth-------------------- 44 | elements_1: DO iel=1,nels 45 | CALL geom_rect(element,iel,x_coords,y_coords,coord,num,'y') 46 | call num_to_g(num,nf,g) 47 | g_num(:,iel)=num 48 | g_g(:,iel)=g 49 | g_coord(:,num)=transpose(coord) 50 | IF(nband=1)THEN 20 | loop_1: DO k=1,n2 21 | maxr=iw 22 | IF(n-k0)THEN 59 | DO l=1,maxl 60 | u=c*a(j-1,l+2)-s*a(j,l+1) 61 | a(j,l+1)=s*a(j-1,l+2)+c*a(j,l+1) 62 | a(j-1,l+2)=u 63 | END DO 64 | END IF 65 | IF(j+iw<=n)THEN 66 | g=-s*a(j,iw+1) 67 | a(j,iw+1)=c*a(j,iw+1) 68 | END IF 69 | END DO loop_3 70 | END DO loop_2 71 | END DO loop_1 72 | END IF 73 | e(1)=zero 74 | d(1:n)=a(1:n,1) 75 | IF(2<=n)THEN 76 | DO i=2,n 77 | e(i)=a(i-1,2) 78 | END DO 79 | END IF 80 | RETURN 81 | END SUBROUTINE bandred 82 | -------------------------------------------------------------------------------- /library/main/bandwidth.f03: -------------------------------------------------------------------------------- 1 | FUNCTION bandwidth(g) RESULT(nband) 2 | ! 3 | ! This function finds the element bandwidth from g. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,INTENT(IN)::g(:) 7 | INTEGER::nband 8 | nband=MAXVAL(g,1,g>0)-MINVAL(g,1,g>0) 9 | RETURN 10 | END FUNCTION bandwidth 11 | 12 | -------------------------------------------------------------------------------- /library/main/banmul.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE banmul(kb,loads,ans) 2 | ! This subroutine multiplies a symmetrical band kb by the vector loads. 3 | ! 4 | IMPLICIT NONE 5 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 6 | REAL(iwp),INTENT(IN)::kb(:,:),loads(0:) 7 | REAL(iwp),INTENT(OUT)::ans(0:) 8 | INTEGER::neq,nband,i,j 9 | REAL(iwp)::x,zero=0.0_iwp 10 | neq=UBOUND(kb,1) 11 | nband=UBOUND(kb,2)-1 12 | DO i=1,neq 13 | x=zero 14 | DO j=nband+1,1,-1 15 | IF(i+j>nband+1)x=x+kb(i,j)*loads(i+j-nband-1) 16 | END DO 17 | DO j=nband,1,-1 18 | IF(i-j=1)x=x+kb(i,j)*loads(m) 22 | END DO 23 | ans(i)=x 24 | END DO 25 | RETURN 26 | END SUBROUTINE bantmul 27 | -------------------------------------------------------------------------------- /library/main/beam_ge.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE beam_gm(gm,ell) 2 | ! 3 | ! This subroutine forms the beam geometric matrix for stability analysis. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::ell 8 | REAL(iwp),INTENT(OUT)::gm(:,:) 9 | REAL(iwp)::pt1=0.1_iwp,opt2=1.2_iwp,two=2.0_iwp,d15=15.0_iwp,d30=30.0_iwp 10 | gm(1,1)=opt2/ell 11 | gm(1,2)=pt1 12 | gm(2,1)=pt1 13 | gm(1,3)=-opt2/ell 14 | gm(3,1)=-opt2/ell 15 | gm(1,4)=pt1 16 | gm(4,1)=pt1 17 | gm(2,2)=two*ell/d15 18 | gm(2,3)=-pt1 19 | gm(3,2)=-pt1 20 | gm(2,4)=-ell/d30 21 | gm(4,2)=-ell/d30 22 | gm(3,3)=opt2/ell 23 | gm(3,4)=-pt1 24 | gm(4,3)=-pt1 25 | gm(4,4)=two*ell/d15 26 | RETURN 27 | END SUBROUTINE beam_gm 28 | -------------------------------------------------------------------------------- /library/main/beam_km.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE beam_km(km,ei,ell) 2 | ! 3 | ! This subroutine forms the stiffness matrix of a 4 | ! beam element (bending only). 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::ei,ell 9 | REAL(iwp),INTENT(OUT)::km(:,:) 10 | REAL(iwp)::two=2.0_iwp,d4=4.0_iwp,d6=6.0_iwp,d12=12.0_iwp 11 | km(1,1)=d12*ei/(ell*ell*ell) 12 | km(3,3)=km(1,1) 13 | km(1,2)=d6*ei/(ell*ell) 14 | km(2,1)=km(1,2) 15 | km(1,4)=km(1,2) 16 | km(4,1)=km(1,4) 17 | km(1,3)=-km(1,1) 18 | km(3,1)=km(1,3) 19 | km(3,4)=-km(1,2) 20 | km(4,3)=km(3,4) 21 | km(2,3)=km(3,4) 22 | km(3,2)=km(2,3) 23 | km(2,2)=d4*ei/ell 24 | km(4,4)=km(2,2) 25 | km(2,4)=two*ei/ell 26 | km(4,2)=km(2,4) 27 | RETURN 28 | END SUBROUTINE beam_km 29 | -------------------------------------------------------------------------------- /library/main/beam_mm.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE beam_mm(mm,fs,ell) 2 | ! 3 | ! This subroutine forms the consistent mass matrix of a beam element. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::fs,ell 8 | REAL(iwp),INTENT(OUT)::mm(:,:) 9 | REAL(iwp)::fac 10 | fac=(fs*ell)/420.0_iwp 11 | mm(1,1)=156.0_iwp*fac 12 | mm(3,3)=mm(1,1) 13 | mm(1,2)=22.0_iwp*ell*fac 14 | mm(2,1)=mm(1,2) 15 | mm(3,4)=-mm(1,2) 16 | mm(4,3)=mm(3,4) 17 | mm(1,3)=54.0_iwp*fac 18 | mm(3,1)=mm(1,3) 19 | mm(1,4)=-13.0_iwp*ell*fac 20 | mm(4,1)=mm(1,4) 21 | mm(2,3)=-mm(1,4) 22 | mm(3,2)=mm(2,3) 23 | mm(2,2)=4.0_iwp*(ell**2)*fac 24 | mm(4,4)=mm(2,2) 25 | mm(2,4)=-3.0_iwp*(ell**2)*fac 26 | mm(4,2)=mm(2,4) 27 | RETURN 28 | END SUBROUTINE beam_mm 29 | -------------------------------------------------------------------------------- /library/main/beamdis.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE beamdis(loads,nf,ratmax,interp,nels,ell,argv,nlen,ips) 2 | ! 3 | ! This subroutine produces a PostScript output file "*.dis" displaying 4 | ! the deformed 1-D finite element mesh. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::loads(0:),ratmax,ell(:) 9 | INTEGER,INTENT(IN)::ips,nf(:,:),nels,interp,nlen 10 | REAL(iwp)::width,height,scale=72,sxy,xo,yo,x,y,dismag,vmax 11 | REAL(iwp)::xmin,xmax,ymin,ymax,xnow,dmax,zero=0.0_iwp,pt5=0.5_iwp, & 12 | opt5=1.5_iwp,fpt5=5.5_iwp,d8=8.0_iwp,ept5=8.5_iwp,d11=11.0_iwp, & 13 | one=1.0_iwp,two=2.0_iwp,thr=3.0_iwp, & 14 | localx,globalx,na,nb,nc,nd,ll,wold,wnew 15 | INTEGER::i,j,nn 16 | CHARACTER(LEN=15)::argv 17 | REAL(iwp),ALLOCATABLE::xcoord(:) 18 | OPEN(ips,FILE=argv(1:nlen)//'.dis') 19 | ! 20 | nn=nels+1 21 | ALLOCATE(xcoord(nn)) 22 | 23 | xmin=zero 24 | xmax=zero 25 | xnow=zero 26 | ymin=zero 27 | ymax=zero 28 | 29 | xcoord(1)=xnow 30 | 31 | DO i=2,nn 32 | xnow=xnow+ell(i-1) 33 | xcoord(i)=xnow 34 | END DO 35 | 36 | xmax=xcoord(nn) 37 | 38 | DO i=1,nn 39 | IF(loads(nf(1,i))ymax)ymax=loads(nf(1,i)) 41 | END DO 42 | 43 | width=xmax-xmin 44 | height=ymax-ymin 45 | dmax=ratmax*width 46 | IF(height>width)dmax=ratmax*height 47 | ! 48 | vmax=zero 49 | DO i=1,nn 50 | IF(ABS(loads(nf(1,i)))>vmax)vmax=ABS(loads(nf(1,i))) 51 | END DO 52 | dismag=dmax/vmax 53 | ! 54 | ymin=zero 55 | ymax=zero 56 | 57 | DO i=1,nn 58 | IF(dismag*loads(nf(1,i))ymax) & 61 | ymax=dismag*loads(nf(1,i)) 62 | ! 63 | IF(loads(nf(1,i))ymax)ymax=loads(nf(1,i)) 65 | END DO 66 | ! 67 | width =xmax-xmin 68 | height=ymax-ymin 69 | ! 70 | ! allow 1.5" margin minimum on each side of figure 71 | ! 72 | ! portrait mode 73 | ! 74 | IF(height.GE.d11/ept5*width)THEN 75 | ! 76 | ! height governs the scale 77 | ! 78 | sxy=scale*d8/height 79 | xo=scale*pt5*(ept5-d8*width/height) 80 | yo=scale*opt5 81 | ELSE 82 | ! 83 | ! width governs the scale 84 | ! 85 | sxy=scale*fpt5/width 86 | xo=scale*opt5 87 | yo=scale*pt5*(d11-fpt5*height/width) 88 | END IF 89 | ! 90 | ! 91 | ! start PostScript output 92 | ! 93 | WRITE(ips,'(a)')'%!PS-Adobe-1.0' 94 | WRITE(ips,'(a)')'%%DocumentFonts: none' 95 | WRITE(ips,'(a)')'%%Pages: 1' 96 | WRITE(ips,'(a)')'%%EndComments' 97 | WRITE(ips,'(a)')'/m {moveto} def' 98 | WRITE(ips,'(a)')'/l {lineto} def' 99 | WRITE(ips,'(a)')'/s {stroke} def' 100 | WRITE(ips,'(a)')'/c {closepath} def' 101 | WRITE(ips,'(a)')'%%EndProlog' 102 | WRITE(ips,'(a)')'%%Page: 0 1' 103 | WRITE(ips,'(a)')'gsave' 104 | ! 105 | ! draw the deformed mesh 106 | ! 107 | WRITE(ips,'(2f9.2,a)') xo, yo, ' translate' 108 | WRITE(ips,'(f9.2,a)') 0.5, ' setlinewidth' 109 | 110 | wnew=loads(nf(1,1)) 111 | 112 | DO i=1,nels 113 | DO j=1,interp 114 | 115 | wold=wnew 116 | localx=j*ell(i)/interp 117 | globalx=localx+xcoord(i) 118 | ll=ell(i) 119 | na=(one/(ll**3))*(ll**3-thr*ll*localx**2+two*localx**3) 120 | nb=(one/(ll**2))*(localx*ll**2-two*ll*localx**2+localx**3) 121 | nc=(one/(ll**3))*(thr*ll*localx**2-two*localx**3) 122 | nd=(one/(ll**2))*(localx**3-ll*localx**2) 123 | wnew=na*loads(nf(1,i))+nb*loads(nf(2,i))+nc*loads(nf(1,1+i))+nd*loads(nf(2,i+1)) 124 | 125 | x=sxy*((globalx-ell(i)/interp)-xmin) 126 | y=sxy*(dismag*wold-ymin) 127 | WRITE(ips,'(2f9.2,a)') x, y,' m' 128 | x=sxy*(globalx-xmin) 129 | y=sxy*(dismag*wnew-ymin) 130 | WRITE(ips,'(2f9.2,a)') x, y,' l' 131 | WRITE(ips,'(a)')'c s' 132 | 133 | END DO 134 | 135 | END DO 136 | ! 137 | WRITE(ips,'(a)')'grestore' 138 | WRITE(ips,'(a)')'showpage' 139 | CLOSE(ips) 140 | ! 141 | RETURN 142 | END SUBROUTINE beamdis 143 | 144 | -------------------------------------------------------------------------------- /library/main/beemat.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE beemat(bee,deriv) 2 | ! 3 | ! This subroutine forms the bee matrix in 2-d (ih=3 or 4) or 3-d (ih=6). 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::deriv(:,:) 8 | REAL(iwp),INTENT(OUT)::bee(:,:) 9 | INTEGER::k,l,m,n,ih,nod 10 | REAL::x,y,z 11 | bee=0.0_iwp 12 | ih=UBOUND(bee,1) 13 | nod=UBOUND(deriv,2) 14 | SELECT CASE (ih) 15 | CASE(3,4) 16 | DO m=1,nod 17 | k=2*m 18 | l=k-1 19 | x=deriv(1,m) 20 | y=deriv(2,m) 21 | bee(1,l)=x 22 | bee(3,k)=x 23 | bee(2,k)=y 24 | bee(3,l)=y 25 | END DO 26 | CASE(6) 27 | DO m=1,nod 28 | n=3*m 29 | k=n-1 30 | l=k-1 31 | x=deriv(1,m) 32 | y=deriv(2,m) 33 | z=deriv(3,m) 34 | bee(1,l)=x 35 | bee(4,k)=x 36 | bee(6,n)=x 37 | bee(2,k)=y 38 | bee(4,l)=y 39 | bee(5,n)=y 40 | bee(3,n)=z 41 | bee(5,k)=z 42 | bee(6,l)=z 43 | END DO 44 | CASE DEFAULT 45 | WRITE(*,*)'wrong dimension for nst in bee matrix' 46 | END SELECT 47 | RETURN 48 | END SUBROUTINE beemat 49 | 50 | -------------------------------------------------------------------------------- /library/main/beemat.m: -------------------------------------------------------------------------------- 1 | function bee =beemat( deriv,ih ) 2 | % This subroutine forms the bee matrix in 2-d (ih=3 or 4) or 3-d (ih=6). 3 | nod=size(deriv,2); 4 | 5 | switch ih 6 | case {3,4} 7 | bee=zeros(ih,nod*2); 8 | for m=1:nod 9 | k=2*m; 10 | l=k-1; 11 | x=deriv(1,m); 12 | y=deriv(2,m); 13 | bee(1,l)=x; 14 | bee(3,k)=x; 15 | bee(2,k)=y; 16 | bee(3,l)=y; 17 | end 18 | case 6 19 | bee=zeros(ih,nod*3); 20 | for m=1:nod 21 | n=3*m; 22 | k=n-1; 23 | l=k-1; 24 | x=deriv(1,m); 25 | y=deriv(2,m); 26 | z=deriv(3,m); 27 | bee(1,l)=x; 28 | bee(4,k)=x; 29 | bee(6,n)=x; 30 | bee(2,k)=y; 31 | bee(4,l)=y; 32 | bee(5,n)=y; 33 | bee(3,n)=z; 34 | bee(5,k)=z; 35 | bee(6,l)=z; 36 | end 37 | otherwise 38 | disp('wrong dimension for nst in bee matrix'); 39 | end 40 | 41 | end 42 | 43 | -------------------------------------------------------------------------------- /library/main/beemat2.m: -------------------------------------------------------------------------------- 1 | function bee =beemat2( deriv,ih ) 2 | % This subroutine forms the bee matrix in 2-d (ih=3 or 4) or 3-d (ih=6). 3 | nod=size(deriv,2); 4 | 5 | switch ih 6 | case {3,4} 7 | bee=zeros(4,nod*2); 8 | for m=1:nod 9 | k=2*m; 10 | l=k-1; 11 | x=deriv(1,m); 12 | y=deriv(2,m); 13 | bee(1,l)=x; 14 | bee(2,k)=y; 15 | bee(3,l)=y; 16 | bee(4,k)=x; 17 | end 18 | case 6 19 | bee=zeros(ih,nod*3); 20 | for m=1:nod 21 | n=3*m; 22 | k=n-1; 23 | l=k-1; 24 | x=deriv(1,m); 25 | y=deriv(2,m); 26 | z=deriv(3,m); 27 | bee(1,l)=x; 28 | bee(4,k)=x; 29 | bee(6,n)=x; 30 | bee(2,k)=y; 31 | bee(4,l)=y; 32 | bee(5,n)=y; 33 | bee(3,n)=z; 34 | bee(5,k)=z; 35 | bee(6,l)=z; 36 | end 37 | otherwise 38 | disp('wrong dimension for nst in bee matrix'); 39 | end 40 | 41 | end 42 | 43 | -------------------------------------------------------------------------------- /library/main/bisect.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE bisect(d,e,acheps,ifail) 2 | ! 3 | ! This subroutine finds the eigenvalues of a tridiagonal matrix, 4 | ! given with its diagonal elements in the array d(n) and 5 | ! its subdiagonal elements in the last n - 1 stores of the 6 | ! array e(n), using ql transformations. The eigenvalues are 7 | ! overwritten on the diagonal elements in the array d in 8 | ! ascending order. The subroutine will fail if any one 9 | ! eigenvalue takes more than 30 iterations. 10 | ! 11 | IMPLICIT NONE 12 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 13 | REAL(iwp),INTENT(IN)::acheps 14 | REAL(iwp),INTENT(IN OUT)::d(0:),e(0:) 15 | INTEGER,INTENT(IN OUT)::ifail 16 | INTEGER::m,n,i,l,j,i1,m1,ii,aux 17 | REAL(iwp)::b,f,h,g,p,r,c,s,zero=0.0_iwp,pt5=0.5_iwp,one=1.0_iwp, & 18 | two=2.0_iwp 19 | n=UBOUND(d,1) 20 | IF(n/=1)THEN 21 | DO i=2,n 22 | e(i-1)=e(i) 23 | END DO 24 | END IF 25 | e(n)=zero 26 | b=zero 27 | f=zero 28 | loop_1: DO l=1,n 29 | j=0 30 | h=acheps*(ABS(d(l))+ABS(e(l))) 31 | IF(b=ABS(e(i)))THEN 75 | c= e(i)/p 76 | r=SQRT(c*c+one) 77 | e(i+1)=s*p*r 78 | s=c/r 79 | c=one/r 80 | ELSE 81 | c=p/e(i) 82 | r=SQRT(c*c+one) 83 | e(i+1)=s*e(i)*r 84 | s=one/r 85 | c=c/r 86 | END IF 87 | p=c*d(i)-s*g 88 | d(i+1)=h+s*(c*g+s*d(i)) 89 | END DO loop_4 90 | e(l)=s*p 91 | d(l)=c*p 92 | IF(ABS(e(l))<=b)EXIT loop_2 93 | END DO loop_2 94 | END IF 95 | p=d(l)+f 96 | ! order eigenvalue 97 | aux=0 98 | IF(l/=1)THEN 99 | loop_3: DO ii=2,l 100 | i=l-ii+2 101 | IF(p>=d(i-1))THEN 102 | aux=1 103 | EXIT loop_3 104 | END IF 105 | d(i)=d(i-1) 106 | END DO loop_3 107 | END IF 108 | IF(aux==0)THEN 109 | i=1 110 | END IF 111 | d(i) = p 112 | ifail=0 113 | END DO loop_1 114 | RETURN 115 | END SUBROUTINE bisect 116 | -------------------------------------------------------------------------------- /library/main/bmat_nonaxi.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE bmat_nonaxi(bee,radius,coord,deriv,fun,iflag,lth) 2 | ! 3 | ! This subroutine forms the strain-displacement matrix for 4 | ! axisymmetric solids subjected to non-axisymmetric loading. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::deriv(:,:),fun(:),coord(:,:) 9 | REAL(iwp),INTENT(OUT)::bee(:,:),radius 10 | INTEGER,INTENT(IN)::iflag,lth 11 | INTEGER::nod,k,l,m,n 12 | nod=UBOUND(deriv,2) 13 | bee=0.0_iwp 14 | radius=SUM(fun*coord(:,1)) 15 | DO m=1,nod 16 | n=3*m 17 | k=n-1 18 | l=k-1 19 | bee(1,l)=deriv(1,m) 20 | bee(2,k)=deriv(2,m) 21 | bee(3,l)=fun(m)/radius 22 | bee(3,n)=iflag*lth*bee(3,l) 23 | bee(4,l)=deriv(2,m) 24 | bee(4,k)=deriv(1,m) 25 | bee(5,k)=-iflag*lth*fun(m)/radius 26 | bee(5,n)=deriv(2,m) 27 | bee(6,l)=bee(5,k) 28 | bee(6,n)=deriv(1,m)-fun(m)/radius 29 | END DO 30 | RETURN 31 | END SUBROUTINE bmat_nonaxi 32 | 33 | 34 | -------------------------------------------------------------------------------- /library/main/bmat_nonaxi.m: -------------------------------------------------------------------------------- 1 | function [bee,radius] = bmat_nonaxi(coord,deriv,fun,iflag,lth) 2 | nod=size(deriv,2); 3 | bee=zeros(6,3*nod); 4 | radius=fun'*coord(:,1); 5 | for m=1:nod 6 | n=3*m; 7 | k=n-1; 8 | l=k-1; 9 | bee(1,l)=deriv(1,m); 10 | bee(2,k)=deriv(2,m); 11 | bee(3,l)=fun(m)/radius; 12 | bee(3,n)=iflag*lth*bee(3,l) ; 13 | bee(4,l)=deriv(2,m); 14 | bee(4,k)=deriv(1,m); 15 | bee(5,k)=-iflag*lth*fun(m)/radius ; 16 | bee(5,n)=deriv(2,m); 17 | bee(6,l)=bee(5,k) ; 18 | bee(6,n)=deriv(1,m)-fun(m)/radius; 19 | end 20 | end 21 | 22 | -------------------------------------------------------------------------------- /library/main/checon.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE checon(loads,oldlds,tol,converged) 2 | ! 3 | ! This subroutine sets converged to .FALSE. if relative change in loads 4 | ! and oldlds is greater than tol and updates oldlds. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::loads(0:),tol 9 | REAL(iwp),INTENT(IN OUT)::oldlds(0:) 10 | LOGICAL,INTENT(OUT)::converged 11 | CONVERGED=.TRUE. 12 | CONVERGED=(MAXVAL(ABS(loads-oldlds))/MAXVAL(ABS(loads))<=tol) 13 | oldlds=loads 14 | RETURN 15 | END SUBROUTINE checon 16 | -------------------------------------------------------------------------------- /library/main/checon.m: -------------------------------------------------------------------------------- 1 | function [converged,oldlds,res] =checon(loads,oldlds,tol) 2 | % ! This subroutine sets converged to .FALSE. if relative change in loads 3 | % ! and oldlds is greater than tol and updates oldlds. 4 | res=max(abs(loads-oldlds))/max(abs(loads)); 5 | converged=(max(abs(loads-oldlds))/max(abs(loads))<=tol); 6 | oldlds=loads; 7 | end 8 | 9 | -------------------------------------------------------------------------------- /library/main/chobk1.f03: -------------------------------------------------------------------------------- 1 | subroutine chobk1(kb,loads) 2 | !Choleski back-substitution 3 | implicit none 4 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 5 | REAL(iwp),intent(in)::kb(:,:) 6 | REAL(iwp),intent(in out)::loads(0:) 7 | integer::iw,n,i,j,k 8 | REAL(iwp)::x 9 | n=size(kb,1) 10 | iw=size(kb,2)-1 11 | loads(1)=loads(1)/kb(1,iw+1) 12 | do i=2,n 13 | x=.0 14 | k=1 15 | if(i<=iw+1)k=iw-i+2 16 | do j=k,iw 17 | x=x+kb(i,j)*loads(i+j-iw-1) 18 | end do 19 | loads(i)=(loads(i)-x)/kb(i,iw+1) 20 | end do 21 | return 22 | end subroutine chobk1 23 | 24 | 25 | -------------------------------------------------------------------------------- /library/main/chobk2.f03: -------------------------------------------------------------------------------- 1 | subroutine chobk2(kb,loads) 2 | !Choleski back-substitution 3 | implicit none 4 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 5 | REAL(iwp),intent(in)::kb(:,:) 6 | REAL(iwp),intent(in out)::loads(0:) 7 | integer::iw,n,i,j,l,m 8 | REAL(iwp)::x 9 | n=size(kb,1) 10 | iw=size(kb,2)-1 11 | loads(n)=loads(n)/kb(n,iw+1) 12 | do i=n-1,1,-1 13 | x=0.0 14 | l=i+iw 15 | if(i>n-iw)l=n 16 | m=i+1 17 | do j=m,l 18 | x=x+kb(j,iw+i-j+1)*loads(j) 19 | end do 20 | loads(i)=(loads(i)-x)/kb(i,iw+1) 21 | end do 22 | return 23 | end subroutine chobk2 -------------------------------------------------------------------------------- /library/main/cholin.f03: -------------------------------------------------------------------------------- 1 | subroutine cholin(kb) 2 | ! Choleski reduction on kb(l,iw+1) stored as a lower triangle 3 | implicit none 4 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 5 | REAL(iwp),intent(in out)::kb(:,:) 6 | integer::i,j,k,l,ia,ib,n,iw 7 | REAL(iwp)::x 8 | n=ubound(kb,1) 9 | iw=ubound(kb,2)-1 10 | do i=1,n 11 | x=.0 12 | do j=1,iw 13 | x=x+kb(i,j)**2 14 | end do 15 | kb(i,iw+1)=sqrt(kb(i,iw+1)-x) 16 | do k=1,iw 17 | x=.0 18 | if(i+k<=n)then 19 | if(k/=iw)then 20 | do l=iw-k,1,-1 21 | x=x+kb(i+k,l)*kb(i,l+k) 22 | end do 23 | end if 24 | ia=i+k 25 | ib=iw-k+1 26 | kb(ia,ib)=(kb(ia,ib)-x)/kb(i,iw+1) 27 | end if 28 | end do 29 | end do 30 | return 31 | end subroutine cholin 32 | -------------------------------------------------------------------------------- /library/main/comred.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE comred(bk,n) 2 | ! gaussian reduction on a vector stored as an upper triangle : complex 3 | IMPLICIT NONE 4 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 5 | COMPLEX(iwp),INTENT(in out)::bk(:);INTEGER,INTENT(IN)::n 6 | INTEGER::i,il1,kbl,j,ij,nkb,m,ni,nj,iw ; COMPLEX(iwp)::sum 7 | iw = UBOUND(bk,1)/n-1 8 | DO i=2,n 9 | il1=i-1;kbl=il1+iw+1 10 | IF(kbl-n>0)kbl=n 11 | DO j=i,kbl 12 | ij=(j-i)*n+i;sum=bk(ij);nkb=j-iw 13 | IF(nkb<=0)nkb=1 14 | IF(nkb-il1<=0)THEN 15 | DO m=nkb,il1 16 | ni=(i-m)*n+m ; nj=(j-m)*n+m 17 | sum=sum-bk(ni)*bk(nj)/bk(m) 18 | END DO 19 | END IF 20 | bk(ij)=sum 21 | END DO 22 | END DO 23 | RETURN 24 | END SUBROUTINE COMRED 25 | -------------------------------------------------------------------------------- /library/main/comsub.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE comsub(bk,loads) 2 | ! performs the complete gaussian backsubstitution : complex version 3 | IMPLICIT NONE 4 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 5 | COMPLEX(iwp),INTENT(IN)::bk(:);COMPLEX(iwp),INTENT(IN OUT)::loads(0:) 6 | INTEGER::nkb,k,i,jn,jj,i1,n,iw; COMPLEX::sum 7 | n = UBOUND(loads,1); iw = UBOUND(bk,1)/n - 1 8 | loads(1)=loads(1)/bk(1) 9 | DO i=2,n 10 | sum=loads(i);i1=i-1 ; nkb=i-iw 11 | IF(nkb<=0)nkb=1 12 | DO k=nkb,i1 13 | jn=(i-k)*n+k;sum=sum-bk(jn)*loads(k) 14 | END DO 15 | loads(i)=sum/bk(i) 16 | END DO 17 | DO jj=2,n 18 | i=n-jj+1;sum=.0;i1=i+1;nkb=i+iw 19 | if(nkb-n>0)nkb=n 20 | DO k=i1,nkb 21 | jn=(k-i)*n+i ; sum=sum+bk(jn)*loads(k) 22 | END DO 23 | loads(i)=loads(i)-sum/bk(i) 24 | END DO 25 | RETURN 26 | END SUBROUTINE comsub 27 | -------------------------------------------------------------------------------- /library/main/create.txt: -------------------------------------------------------------------------------- 1 | How to modify the library: 2 | 3 | 1) To create *.o modules: 4 | 5 | g95 -c sub1.f03 6 | g95 -c sub2.f03 or do them all with 7 | g95 -c *.f03 8 | 9 | 10 | 2) To create the whole library (assume library is called mainlib.a): 11 | 12 | ar -r mainlib.a *.o 13 | 14 | 2a) To add modules to the library : 15 | 16 | ar -r mainlib.a sub1.o 17 | 18 | 2b) To remove modules from the library: 19 | 20 | ar -d mainlib.a sub1.o 21 | 22 | 3) Creation of the *.mod file. 23 | A typical interface module (called main_int.f03) looks like: 24 | 25 | MODULE main 26 | ! 27 | INTERFACE 28 | ! 29 | SUBROUTINE mesh(g_coord,g_num,ips) 30 | ! 31 | ! this subroutine draw the finite element mesh 32 | ! 33 | IMPLICIT NONE 34 | REAL,INTENT(IN)::g_coord(:,:) 35 | INTEGER,INTENT(IN)::g_num(:,:),ips 36 | END SUBROUTINE mesh 37 | ! 38 | SUBROUTINE interp(k,dt,rt,rl,al,ntp) 39 | . 40 | . 41 | . 42 | END SUBROUTINE interp 43 | ! 44 | END INTERFACE 45 | ! 46 | END MODULE MAIN 47 | 48 | 49 | 4) Compile modified interface file: 50 | g95 -c main_int.f03 51 | 52 | This command creates main.mod 53 | -------------------------------------------------------------------------------- /library/main/cross_product.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE cross_product(b,c,a) 2 | ! 3 | ! This subroutine forms the cross product of two vectors, a = b x c 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::b(:),c(:) 8 | REAL(iwp),INTENT(OUT)::a(:,:) 9 | INTEGER::ib,ic,i,j 10 | ib=SIZE(b) 11 | ic=SIZE(c) 12 | DO i=1,ib 13 | DO j=1,ic 14 | a(i,j)=b(i)*c(j) 15 | END DO 16 | END DO 17 | RETURN 18 | END SUBROUTINE cross_product 19 | -------------------------------------------------------------------------------- /library/main/deemat.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE deemat(dee,e,v) 2 | ! 3 | ! This subroutine returns the elastic dee matrix for ih=3 (plane strain), 4 | ! ih=4 (axisymmetry or plane strain elastoplasticity) or ih=6 5 | ! (three dimensions). 6 | ! 7 | IMPLICIT NONE 8 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 9 | REAL(iwp),INTENT(IN)::e,v 10 | REAL(iwp),INTENT(OUT)::dee(:,:) 11 | REAL(iwp)::v1,v2,c,vv,zero=0.0_iwp,pt5=0.5_iwp,one=1.0_iwp,two=2.0_iwp 12 | INTEGER::i,ih 13 | dee=zero 14 | ih=UBOUND(dee,1) 15 | v1=one-v 16 | c=e/((one+v)*(one-two*v)) 17 | SELECT CASE(ih) 18 | CASE(3) 19 | dee(1,1)=v1*c 20 | dee(2,2)=v1*c 21 | dee(1,2)=v*c 22 | dee(2,1)=v*c 23 | dee(3,3)=pt5*c*(one-two*v) 24 | CASE(4) 25 | dee(1,1)=v1*c 26 | dee(2,2)=v1*c 27 | dee(4,4)=v1*c 28 | dee(3,3)=pt5*c*(one-two*v) 29 | dee(1,2)=v*c 30 | dee(2,1)=v*c 31 | dee(1,4)=v*c 32 | dee(4,1)=v*c 33 | dee(2,4)=v*c 34 | dee(4,2)=v*c 35 | CASE(6) 36 | v2=v/(one-v) 37 | vv=(one-two*v)/(one-v)*pt5 38 | DO i=1,3 39 | dee(i,i)=one 40 | END DO 41 | DO i=4,6 42 | dee(i,i)=vv 43 | END DO 44 | dee(1,2)=v2 45 | dee(2,1)=v2 46 | dee(1,3)=v2 47 | dee(3,1)=v2 48 | dee(2,3)=v2 49 | dee(3,2)=v2 50 | dee=dee*e/(two*(one+v)*vv) 51 | CASE DEFAULT 52 | WRITE(*,*)'wrong size for dee matrix' 53 | END SELECT 54 | RETURN 55 | END SUBROUTINE deemat 56 | -------------------------------------------------------------------------------- /library/main/deemat.m: -------------------------------------------------------------------------------- 1 | function dee = deemat(e,v,ih) 2 | %! This subroutine returns the elastic dee matrix for ih=3 (plane strain), 3 | %! ih=4 (axisymmetry or plane strain elastoplasticity) or ih=6 4 | %! (three dimensions). 5 | v1=1-v; 6 | c=e/((1+v)*(1-2*v)); 7 | switch ih 8 | case 3 9 | dee=[v1*c v*c 0 10 | v*c v1*c 0 11 | 0 0 0.5*c*(1-2*v)]; 12 | case 4 13 | dee=[v1*c v*c 0 v*c 14 | v*c v1*c 0 v*c 15 | 0 0 0.5*c*(1-2*v) 0 16 | v*c v*c 0 v1*c]; 17 | 18 | case 6 19 | v2=v/(1-v); 20 | vv=(1-2*v)/(1-v)*0.5; 21 | dee=[1 v2 v2 0 0 0 22 | v2 1 v2 0 0 0 23 | v2 v2 1 0 0 0 24 | 0 0 0 vv 0 0 25 | 0 0 0 0 vv 0 26 | 0 0 0 0 0 vv]... 27 | *e/(2*(1+v)*vv); 28 | end 29 | end 30 | 31 | -------------------------------------------------------------------------------- /library/main/determinant.f03: -------------------------------------------------------------------------------- 1 | FUNCTION determinant(jac)RESULT(det) 2 | ! 3 | ! This function returns the determinant of a 1x1, 2x2 or 3x3 4 | ! Jacobian matrix. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::jac(:,:) 9 | REAL(iwp)::det 10 | INTEGER::it 11 | it=UBOUND(jac,1) 12 | SELECT CASE(it) 13 | CASE(1) 14 | det=1.0_iwp 15 | CASE(2) 16 | det=jac(1,1)*jac(2,2)-jac(1,2)*jac(2,1) 17 | CASE(3) 18 | det=jac(1,1)*(jac(2,2)*jac(3,3)-jac(3,2)*jac(2,3)) 19 | det=det-jac(1,2)*(jac(2,1)*jac(3,3)-jac(3,1)*jac(2,3)) 20 | det=det+jac(1,3)*(jac(2,1)*jac(3,2)-jac(3,1)*jac(2,2)) 21 | CASE DEFAULT 22 | WRITE(*,*)' wrong dimension for Jacobian matrix' 23 | END SELECT 24 | RETURN 25 | END FUNCTION determinant 26 | -------------------------------------------------------------------------------- /library/main/dismsh_ensi.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE dismsh_ensi(argv,nlen,step,nf,loads) 2 | ! 3 | ! This subroutine outputs displacements in the Ensight gold format for 4 | ! visualization in ParaView. ParaView also requires the output of subroutine 5 | ! mesh_ensi for the geometry. 6 | ! 7 | IMPLICIT none 8 | 9 | INTEGER,PARAMETER :: iwp=SELECTED_REAL_KIND(15) 10 | INTEGER, INTENT(IN) :: nlen,step,nf(:,:) 11 | INTEGER :: i,j 12 | REAL(iwp), INTENT(IN) :: loads(:) 13 | CHARACTER(LEN=15), INTENT(IN) :: argv 14 | CHARACTER(LEN=5) :: ch 15 | 16 | WRITE(ch,'(I5.5)') step ! convert integer to string using internal file 17 | 18 | OPEN(17,FILE=argv(1:nlen)//'.ensi.displ-'//ch) 19 | 20 | WRITE(17,'(A)') "Alya Ensight Gold --- Vector per-node variable file" 21 | WRITE(17,'(A/A/A)') "part", " 1","coordinates" 22 | 23 | DO i=1,UBOUND(nf,1) 24 | DO j=1,UBOUND(nf,2) 25 | WRITE(17,'(E12.5)') loads(nf(i,j)) 26 | END DO 27 | END DO 28 | 29 | IF(UBOUND(nf,1)==2) THEN ! ensight requires zeros for the z-ordinate 30 | DO i=1,UBOUND(nf,2) 31 | WRITE(17,'(A)') " 0.00000E+00" 32 | END DO 33 | END IF 34 | 35 | CLOSE(17) 36 | 37 | RETURN 38 | 39 | END SUBROUTINE dismsh_ensi 40 | -------------------------------------------------------------------------------- /library/main/ecmat.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE ecmat(ecm,fun,ndof,nodof) 2 | ! 3 | ! This subroutine forms the element consistent mass matrix. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::fun(:) 8 | REAL(iwp),INTENT(OUT)::ecm(:,:) 9 | INTEGER,INTENT(IN)::nodof,ndof 10 | INTEGER::nod,i,j 11 | REAL::nt(ndof,nodof),tn(nodof,ndof),zero=0.0_iwp 12 | nod=ndof/nodof 13 | nt=zero 14 | tn=zero 15 | DO i=1,nod 16 | DO j=1,nodof 17 | nt((i-1)*nodof+j,j)=fun(i) 18 | tn(j,(i-1)*nodof+j)=fun(i) 19 | END DO 20 | END DO 21 | ecm=MATMUL(nt,tn) 22 | RETURN 23 | END SUBROUTINE ecmat 24 | -------------------------------------------------------------------------------- /library/main/elmat.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE elmat(area,rho,emm) 2 | ! 3 | ! This subroutine forms the "analytical" lumped mass matrix for 4 | ! quadrilateral 4- or 8-node plane strain elements. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::area,rho 9 | REAL(iwp),INTENT(OUT)::emm(:,:) 10 | REAL(iwp)::zero=0.0_iwp,pt2=0.2_iwp,pt25=0.25_iwp 11 | INTEGER::i,ndof 12 | ndof=UBOUND(emm,1) 13 | emm=zero 14 | SELECT CASE(ndof) 15 | CASE(8) 16 | DO i=1,8 17 | emm(i,i)=pt25*area*rho 18 | END DO 19 | CASE(16) 20 | DO i=1,16 21 | emm(i,i)=pt2*area*rho 22 | END DO 23 | DO i=1,13,4 24 | emm(i,i)=pt25*emm(3,3) 25 | END DO 26 | DO i=2,14,4 27 | emm(i,i)=pt25*emm(3,3) 28 | END DO 29 | CASE DEFAULT 30 | WRITE(*,*)"Wrong number of nodes for rectangular element" 31 | END SELECT 32 | RETURN 33 | END SUBROUTINE elmat 34 | 35 | -------------------------------------------------------------------------------- /library/main/exc_nods.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE exc_nods(noexe,exele,g_num,totex,ntote,nf) 2 | ! 3 | ! This subroutine forms the nodes removed in an excavation lift. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,INTENT(IN)::noexe,exele(:),g_num(:,:) 7 | INTEGER,INTENT(IN OUT)::totex(:),ntote,nf(:,:) 8 | INTEGER::i,jj,k,iel,modex,nodex,ncheck,nels,nod 9 | nels=UBOUND(g_num,2) 10 | nod=UBOUND(g_num,1) 11 | ntote=ntote+noexe 12 | totex(ntote-noexe+1:ntote)=exele 13 | DO i=1,noexe 14 | DO k=1,8 15 | nodex=0 16 | ncheck=g_num(k,exele(i)) 17 | DO iel=1,nels 18 | modex=0 19 | DO jj=1,ntote 20 | IF(iel==totex(jj))THEN 21 | modex=1 22 | EXIT 23 | END IF 24 | END DO 25 | IF(modex==1)CYCLE 26 | DO jj=1,nod 27 | IF(ncheck==g_num(jj,iel))THEN 28 | nodex=1 29 | EXIT 30 | END IF 31 | END DO 32 | IF(nodex==1)EXIT 33 | END DO 34 | IF(nodex==0)nf(:,ncheck)=0 35 | END DO 36 | END DO 37 | RETURN 38 | END SUBROUTINE exc_nods 39 | -------------------------------------------------------------------------------- /library/main/fkdiag.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE fkdiag(kdiag,g) 2 | ! 3 | ! This subroutine computes the skyline profile. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,INTENT(IN)::g(:) 7 | INTEGER,INTENT(OUT)::kdiag(:) 8 | INTEGER::idof,i,iwp1,j,im,k 9 | idof=SIZE(g) 10 | DO i=1,idof 11 | iwp1=1 12 | IF(g(i)/=0)THEN 13 | DO j=1,idof 14 | IF(g(j)/=0)THEN 15 | im=g(i)-g(j)+1 16 | IF(im>iwp1)iwp1=im 17 | END IF 18 | END DO 19 | k=g(i) 20 | IF(iwp1>kdiag(k))kdiag(k)=iwp1 21 | END IF 22 | END DO 23 | RETURN 24 | END SUBROUTINE fkdiag 25 | -------------------------------------------------------------------------------- /library/main/fkdiag.m: -------------------------------------------------------------------------------- 1 | function kdiag = fkdiag(kdiag, g) 2 | % get the maximum semi band 3 | g=unique(g);idof=length(g); 4 | for i =1:idof 5 | iwp1=1; 6 | if g(i)~=0 7 | for j=1:idof 8 | if g(j)~=0 9 | im=g(i)-g(j)+1; 10 | if im>iwp1 11 | iwp1=im; 12 | end 13 | end 14 | end 15 | k=g(i); 16 | if iwp1>kdiag(k) 17 | kdiag(k)=iwp1; 18 | end 19 | end 20 | end 21 | end 22 | 23 | -------------------------------------------------------------------------------- /library/main/fmacat.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE fmacat(vmfl,acat) 2 | ! 3 | ! This subroutine sets up an intermediate matrix acat. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::vmfl(:) 8 | REAL(iwp),INTENT(OUT)::acat(:,:) 9 | REAL(iwp)::temp(4,4),zero=0.0_iwp,pt5=0.5_iwp,one=1.0_iwp,three=3.0_iwp 10 | INTEGER::i,j 11 | temp=zero 12 | temp(1,1)=one 13 | temp(1,2)=-pt5 14 | temp(1,4)=-pt5 15 | temp(2,1)=-pt5 16 | temp(2,2)=one 17 | temp(2,4)=-pt5 18 | temp(3,3)=three 19 | temp(4,1)=-pt5 20 | temp(4,2)=-pt5 21 | temp(4,4)=one 22 | DO i=1,4 23 | DO j=1,4 24 | acat(i,j)=vmfl(i)*vmfl(j) 25 | END DO 26 | END DO 27 | acat=temp-acat 28 | RETURN 29 | END SUBROUTINE fmacat 30 | -------------------------------------------------------------------------------- /library/main/fmdsig.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE fmdsig(dee,e,v) 2 | ! 3 | ! This subroutine returns the elastic dee matrix for ih=3 (plane stress), 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::e,v 8 | REAL(iwp),INTENT(OUT)::dee(:,:) 9 | REAL(iwp)::zero=0.0_iwp,pt5=0.5_iwp,one=1.0_iwp 10 | INTEGER::ih 11 | dee=zero 12 | ih=UBOUND(dee,1) 13 | SELECT CASE(ih) 14 | CASE(3) 15 | dee=zero 16 | dee(1,1)=e/(one-v*v) 17 | dee(2,2)=dee(1,1) 18 | dee(3,3)=pt5*e/(one+v) 19 | dee(1,2)=v*dee(1,1) 20 | dee(2,1)=dee(1,2) 21 | CASE DEFAULT 22 | WRITE(*,*)'wrong size for dee matrix' 23 | END SELECT 24 | RETURN 25 | END SUBROUTINE fmdsig 26 | -------------------------------------------------------------------------------- /library/main/fmkdke.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE fmkdke(km,kp,c,ke,kd,theta) 2 | ! 3 | ! This subroutine builds up the 'coupled' stiffnesses ke and kd from 4 | ! the 'elastic' stiffness km, fluid stiffness kp and coupling matrix c. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::km(:,:),kp(:,:),c(:,:),theta 9 | REAL(iwp),INTENT(OUT)::ke(:,:),kd(:,:) 10 | INTEGER::ndof 11 | REAL::one=1.0_iwp 12 | ndof=SIZE(km,1) 13 | ke(:ndof,:ndof)=theta*km 14 | ke(:ndof,ndof+1:)=theta*c 15 | ke(ndof+1:,:ndof)=theta*TRANSPOSE(c) 16 | ke(ndof+1:,ndof+1:)=-theta**2*kp 17 | kd(:ndof,:ndof)=(theta-one)*km 18 | kd(:ndof,ndof+1:)=(theta-one)*c 19 | kd(ndof+1:,:ndof)=ke(ndof+1:,:ndof) 20 | kd(ndof+1:,ndof+1:)=theta*(one-theta)*kp 21 | RETURN 22 | END SUBROUTINE fmkdke -------------------------------------------------------------------------------- /library/main/fmplat.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE fmplat(d2x,d2y,d2xy,points,aa,bb,i) 2 | ! 3 | ! This subroutine forms the 2nd derivatives for rectangular 4 | ! plate bending elements. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::points(:,:),aa,bb 9 | REAL(iwp),INTENT(OUT)::d2x(:),d2y(:),d2xy(:) 10 | INTEGER,INTENT(IN)::i 11 | REAL(iwp)::x,e,xp1,xp12,xp13,ep1,ep12,ep13,p1,q1,p2,q2,p3,q3,p4,q4,dp1, & 12 | dq1,dp2,dq2,dp3,dq3,dp4,dq4,d2p1,d2p2,d2p3,d2p4,d2q1,d2q2,d2q3,d2q4, & 13 | pt25=0.25_iwp,pt375=0.375_iwp,pt5=0.5_iwp,pt75=0.75_iwp,one=1.0_iwp, & 14 | opt5=1.5_iwp,d3=3.0_iwp 15 | x=points(i,1) 16 | e=points(i,2) 17 | xp1=x+one 18 | xp12=xp1*xp1 19 | xp13=xp12*xp1 20 | ep1=e+one 21 | ep12=ep1*ep1 22 | ep13=ep12*ep1 23 | p1=one-pt75*xp12+pt25*xp13 24 | q1=one-pt75*ep12+pt25*ep13 25 | p2=pt5*aa*xp1*(one-xp1+pt25*xp12) 26 | q2=pt5*bb*ep1*(one-ep1+pt25*ep12) 27 | p3=pt25*xp12*(d3-xp1) 28 | q3=pt25*ep12*(d3-ep1) 29 | p4=pt25*aa*xp12*(pt5*xp1-one) 30 | q4=pt25*bb*ep12*(pt5*ep1-one) 31 | dp1=opt5*xp1*(pt5*xp1-one) 32 | dq1=opt5*ep1*(pt5*ep1-one) 33 | dp2=aa*(pt5-xp1+pt375*xp12) 34 | dq2=bb*(pt5-ep1+pt375*ep12) 35 | dp3=opt5*xp1*(one-pt5*xp1) 36 | dq3=opt5*ep1*(one-pt5*ep1) 37 | dp4=pt5*aa*xp1*(pt75*xp1-one) 38 | dq4=pt5*bb*ep1*(pt75*ep1-one) 39 | d2p1=opt5*x 40 | d2p2=pt25*aa*(d3*x-one) 41 | d2p3=-d2p1 42 | d2p4=pt25*aa*(d3*x+one) 43 | d2q1=opt5*e 44 | d2q2=pt25*bb*(d3*e-one) 45 | d2q3=-d2q1 46 | d2q4=pt25*bb*(d3*e+one) 47 | d2x(1)=d2p1*q1 48 | d2x(2)=d2p2*q1 49 | d2x(3)=d2p1*q2 50 | d2x(4)=d2p2*q2 51 | d2x(5)=d2p1*q3 52 | d2x(6)=d2p2*q3 53 | d2x(7)=d2p1*q4 54 | d2x(8)=d2p2*q4 55 | d2x(9)=d2p3*q3 56 | d2x(10)=d2p4*q3 57 | d2x(11)=d2p3*q4 58 | d2x(12)=d2p4*q4 59 | d2x(13)=d2p3*q1 60 | d2x(14)=d2p4*q1 61 | d2x(15)=d2p3*q2 62 | d2x(16)=d2p4*q2 63 | d2y(1)=p1*d2q1 64 | d2y(2)=p2*d2q1 65 | d2y(3)=p1*d2q2 66 | d2y(4)=p2*d2q2 67 | d2y(5)=p1*d2q3 68 | d2y(6)=p2*d2q3 69 | d2y(7)=p1*d2q4 70 | d2y(8)=p2*d2q4 71 | d2y(9)=p3*d2q3 72 | d2y(10)=p4*d2q3 73 | d2y(11)=p3*d2q4 74 | d2y(12)=p4*d2q4 75 | d2y(13)=p3*d2q1 76 | d2y(14)=p4*d2q1 77 | d2y(15)=p3*d2q2 78 | d2y(16)=p4*d2q2 79 | d2xy(1)=dp1*dq1 80 | d2xy(2)=dp2*dq1 81 | d2xy(3)=dp1*dq2 82 | d2xy(4)=dp2*dq2 83 | d2xy(5)=dp1*dq3 84 | d2xy(6)=dp2*dq3 85 | d2xy(7)=dp1*dq4 86 | d2xy(8)=dp2*dq4 87 | d2xy(9)=dp3*dq3 88 | d2xy(10)=dp4*dq3 89 | d2xy(11)=dp3*dq4 90 | d2xy(12)=dp4*dq4 91 | d2xy(13)=dp3*dq1 92 | d2xy(14)=dp4*dq1 93 | d2xy(15)=dp3*dq2 94 | d2xy(16)=dp4*dq2 95 | RETURN 96 | END SUBROUTINE fmplat 97 | -------------------------------------------------------------------------------- /library/main/fmrmat.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE fmrmat(vmfl,dsbar,dlam,dee,rmat) 2 | ! 3 | ! This subroutine forms the rmat matrix. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::vmfl(:),dsbar,dlam,dee(:,:) 8 | REAL(iwp),INTENT(OUT)::rmat(:,:) 9 | REAL(iwp)::acat(4,4),acatc(4,4),qmat(4,4),temp(4,4),con,zero=0.0_iwp, & 10 | pt5=0.5_iwp,one=1.0_iwp,three=3.0_iwp 11 | INTEGER::i,j 12 | temp=zero 13 | temp(1,1)=one 14 | temp(1,2)=-pt5 15 | temp(1,4)=-pt5 16 | temp(2,1)=-pt5 17 | temp(2,2)=one 18 | temp(2,4)=-pt5 19 | temp(3,3)=three 20 | temp(4,1)=-pt5 21 | temp(4,2)=-pt5 22 | temp(4,4)=one 23 | DO i=1,4 24 | DO j=1,4 25 | acat(i,j)=vmfl(i)*vmfl(j) 26 | END DO 27 | END DO 28 | acat=(temp-acat)/dsbar 29 | acatc=matmul(dee,acat) 30 | qmat=acatc*dlam 31 | DO i=1,4 32 | qmat(i,i)=qmat(i,i)+one 33 | END DO 34 | DO i=1,4 35 | con=qmat(i,i) 36 | qmat(i,i)=one 37 | qmat(i,:)=qmat(i,:)/con 38 | DO j=1,4 39 | IF(j/=i)THEN 40 | con=qmat(j,i) 41 | qmat(j,i)=zero 42 | qmat(j,:)=qmat(j,:)-qmat(i,:)*con 43 | END IF 44 | END DO 45 | END DO 46 | rmat=matmul(qmat,dee) 47 | RETURN 48 | END SUBROUTINE fmrmat 49 | -------------------------------------------------------------------------------- /library/main/form_s.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE form_s(gg,ell,kappa,omega,gamma,s) 2 | ! 3 | ! This subroutine forms the s vector in bicgstab(l) 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::gg(:,:),kappa 8 | INTEGER,INTENT(IN)::ell 9 | REAL(iwp),INTENT(OUT)::omega,gamma(:),s(:) 10 | REAL(iwp)::HH(ell-1,ell-1),gamma0(ell+1),p(ell-1),q(ell-1),gamma1(ell+1),& 11 | ngamma0,ngamma1,cosine,zero=0.0_iwp,one=1.0_iwp 12 | hh=-gg(2:ell,2:ell) 13 | CALL invert(hh) 14 | p=matmul(hh,gg(2:ell,1)) 15 | q=matmul(hh,gg(2:ell,ell+1)) 16 | gamma0(1)=one 17 | gamma0(ell+1)=zero 18 | gamma0(2:ell)=p 19 | gamma1(1)=zero 20 | gamma1(ell+1)=one 21 | gamma1(2:ell)=q 22 | ngamma0=DOT_PRODUCT(gamma0,MATMUL(gg,gamma0)) 23 | ngamma1=DOT_PRODUCT(gamma1,MATMUL(gg,gamma1)) 24 | omega=DOT_PRODUCT(gamma0,MATMUL(gg,gamma1)) 25 | cosine=ABS(omega)/SQRT(ABS(ngamma0*ngamma1)) 26 | omega=omega/ngamma1 27 | IF(cosine0)then 13 | do j=1,idof 14 | if(g(j)>0)then 15 | icd=g(j)-g(i)+iw+1 16 | if(icd-iw-1<=0)kb(g(i),icd)=kb(g(i),icd)+km(i,j) 17 | end if 18 | end do 19 | end if 20 | end do 21 | return 22 | end subroutine formkb 23 | -------------------------------------------------------------------------------- /library/main/formkc.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE formkc(bk,km,cm,g,n) 2 | !global stiffness matrix stored as a vector (upper triangle); complex 3 | IMPLICIT NONE 4 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 5 | REAL(iwp),INTENT(in)::km(:,:),cm(:,:);COMPLEX(iwp),INTENT(out)::bk(:) 6 | INTEGER,INTENT(IN)::g(:),n 7 | INTEGER::idof,i,j,icd,ival 8 | idof=SIZE(km,1) 9 | DO i=1,idof 10 | IF(g(i)/=0) THEN 11 | DO j=1,idof 12 | IF(g(j)/=0) THEN 13 | icd=g(j)-g(i)+1 14 | IF(icd-1>=0) THEN 15 | ival=n*(icd-1)+g(i) 16 | bk(ival)=bk(ival)+CMPLX(km(i,j),cm(i,j)) 17 | END IF 18 | END IF 19 | END DO 20 | END IF 21 | END DO 22 | RETURN 23 | END SUBROUTINE FORMKC 24 | -------------------------------------------------------------------------------- /library/main/formke.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE formke(km,kp,c,ke,theta) 2 | ! 3 | ! This subroutine creates the ke matrix for incremental Biot. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::km(:,:),kp(:,:),c(:,:),theta 8 | REAL(iwp),INTENT(OUT)::ke(:,:) 9 | INTEGER::ndof 10 | ndof=UBOUND(km,1) 11 | ke(:ndof,:ndof)=km 12 | ke(:ndof,ndof+1:)=c 13 | ke(ndof+1:,:ndof)=TRANSPOSE(c) 14 | ke(ndof+1:,ndof+1:)=-theta*kp 15 | RETURN 16 | END SUBROUTINE formke 17 | -------------------------------------------------------------------------------- /library/main/formku.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE formku(ku,km,g) 2 | ! 3 | ! This subroutine assembles element matrices into symmetrical 4 | ! global matrix (stored as an upper rectangle). 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::km(:,:) 9 | REAL(iwp),INTENT(OUT)::ku(:,:) 10 | INTEGER,INTENT(IN)::g(:) 11 | INTEGER::i,j,icd,ndof 12 | ndof=UBOUND(km,1) 13 | DO i=1,ndof 14 | IF(g(i)/=0)THEN 15 | DO j=1,ndof 16 | IF(g(j)/=0)THEN 17 | icd=g(j)-g(i)+1 18 | IF(icd>=1)ku(g(i),icd)=ku(g(i),icd)+km(i,j) 19 | END IF 20 | END DO 21 | END IF 22 | END DO 23 | RETURN 24 | END SUBROUTINE formku 25 | -------------------------------------------------------------------------------- /library/main/formlump.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE formlump(diag,emm,g) 2 | ! 3 | ! This subroutine forms the lumped global mass matrix as a vector diag. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::emm(:,:) 8 | REAL(iwp),INTENT(OUT)::diag(0:) 9 | INTEGER,INTENT(IN)::g(:) 10 | INTEGER::i,ndof 11 | ndof=UBOUND(emm,1) 12 | DO i=1,ndof 13 | diag(g(i))=diag(g(i))+emm(i,i) 14 | END DO 15 | RETURN 16 | END SUBROUTINE formlump 17 | 18 | -------------------------------------------------------------------------------- /library/main/formm.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE formm(stress,m1,m2,m3) 2 | ! 3 | ! This subroutine forms the derivatives of the invariants with respect to 4 | ! stress in 2- or 3-d. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::stress(:) 9 | REAL(iwp),INTENT(OUT)::m1(:,:),m2(:,:),m3(:,:) 10 | REAL(iwp)::sx,sy,txy,tyz,tzx,sz,dx,dy,dz,sigm,zero=0.0_iwp,one=1.0_iwp, & 11 | two=2.0_iwp,three=3.0_iwp,six=6.0_iwp,nine=9.0_iwp 12 | INTEGER::nst,i,j 13 | nst=UBOUND(stress,1) 14 | SELECT CASE(nst) 15 | CASE(4) 16 | sx=stress(1) 17 | sy=stress(2) 18 | txy=stress(3) 19 | sz=stress(4) 20 | dx=(two*sx-sy-sz)/three 21 | dy=(two*sy-sz-sx)/three 22 | dz=(two*sz-sx-sy)/three 23 | sigm=(sx+sy+sz)/three 24 | m1=zero 25 | m2=zero 26 | m3=zero 27 | m1(1,1:2)=one 28 | m1(2,1:2)=one 29 | m1(4,1:2)=one 30 | m1(1,4)=one 31 | m1(4,4)=one 32 | m1(2,4)=one 33 | m1=m1/nine/sigm 34 | m2(1,1)=two/three 35 | m2(2,2)=two/three 36 | m2(4,4)= two/three 37 | m2(2,4)=-one/three 38 | m2(4,2)=-one/three 39 | m2(1,2)=-one/three 40 | m2(2,1)=-one/three 41 | m2(1,4)=-one/three 42 | m2(4,1)=-one/three 43 | m2(3,3)=two 44 | m3(3,3)=-dz 45 | m3(1:2,3)=txy/three 46 | m3(3,1:2)=txy/three 47 | m3(3,4)=-two*txy/three 48 | m3(4,3)=-two*txy/three 49 | m3(1,1)=dx/three 50 | m3(2,4)=dx/three 51 | m3(4,2)=dx/three 52 | m3(2,2)=dy/three 53 | m3(1,4)=dy/three 54 | m3(4,1)=dy/three 55 | m3(4,4)=dz/three 56 | m3(1,2)=dz/three 57 | m3(2,1)=dz/three 58 | CASE(6) 59 | sx=stress(1) 60 | sy=stress(2) 61 | sz=stress(3) 62 | txy=stress(4) 63 | tyz=stress(5) 64 | tzx=stress(6) 65 | sigm=(sx+sy+sz)/three 66 | dx=sx-sigm 67 | dy=sy-sigm 68 | dz=sz-sigm 69 | m1=zero 70 | m2=zero 71 | m1(1:3,1:3)=one/(three*sigm) 72 | DO i=1,3 73 | m2(i,i)=two 74 | m2(i+3,i+3)=six 75 | END DO 76 | m2(1,2)=-one 77 | m2(1,3)=-one 78 | m2(2,3)=-one 79 | m3(1,1)=dx 80 | m3(1,2)=dz 81 | m3(1,3)=dy 82 | m3(1,4)=txy 83 | m3(1,5)=-two*tyz 84 | m3(1,6)=tzx 85 | m3(2,2)=dy 86 | m3(2,3)=dx 87 | m3(2,4)=txy 88 | m3(2,5)=tyz 89 | m3(2,6)=-two*tzx 90 | m3(3,3)=dz 91 | m3(3,4)=-two*txy 92 | m3(3,5)=tyz 93 | m3(3,6)=tzx 94 | m3(4,4)=-three*dz 95 | m3(4,5)=three*tzx 96 | m3(4,6)=three*tyz 97 | m3(5,5)=-three*dx 98 | m3(5,6)=three*txy 99 | m3(6,6)=-three*dy 100 | DO i=1,6 101 | DO j=i+1,6 102 | m1(j,i)=m1(i,j) 103 | m2(j,i)=m2(i,j) 104 | m3(j,i)=m3(i,j) 105 | END DO 106 | END DO 107 | m1=m1/three 108 | m2=m2/three 109 | m3=m3/three 110 | CASE DEFAULT 111 | WRITE(*,*)"nst size not recognised in formm" 112 | END SELECT 113 | RETURN 114 | END SUBROUTINE formm 115 | 116 | -------------------------------------------------------------------------------- /library/main/formm.m: -------------------------------------------------------------------------------- 1 | function [m1,m2,m3]= formm(stress) 2 | % ! This subroutine forms the derivatives of the invariants with respect to 3 | % ! stress in 2- or 3-d. 4 | zero=0.0;small=1.e-10;one=1.0;two=2.0; 5 | three=3.0;six=6.0;nine=9; 6 | nst=size(stress,1); 7 | switch nst 8 | case 4 9 | sx=stress(1); 10 | sy=stress(2); 11 | txy=stress(3); 12 | sz=stress(4); 13 | dx=(two*sx-sy-sz)/three; 14 | dy=(two*sy-sz-sx)/three; 15 | dz=(two*sz-sx-sy)/three; 16 | sigm=(sx+sy+sz)/three; 17 | m1=zeros(nst,nst); 18 | m2=zeros(nst,nst); 19 | m3=zeros(nst,nst); 20 | m1(1,1:2)=one; 21 | m1(2,1:2)=one; 22 | m1(4,1:2)=one; 23 | m1(1,4)=one; 24 | m1(4,4)=one; 25 | m1(2,4)=one; 26 | m1=m1/nine/sigm; 27 | m2(1,1)=two/three; 28 | m2(2,2)=two/three; 29 | m2(4,4)= two/three; 30 | m2(2,4)=-one/three; 31 | m2(4,2)=-one/three; 32 | m2(1,2)=-one/three; 33 | m2(2,1)=-one/three; 34 | m2(1,4)=-one/three; 35 | m2(4,1)=-one/three; 36 | m2(3,3)=two; 37 | m3(3,3)=-dz; 38 | m3(1:2,3)=txy/three; 39 | m3(3,1:2)=txy/three; 40 | m3(3,4)=-two*txy/three; 41 | m3(4,3)=-two*txy/three; 42 | m3(1,1)=dx/three; 43 | m3(2,4)=dx/three; 44 | m3(4,2)=dx/three; 45 | m3(2,2)=dy/three; 46 | m3(1,4)=dy/three; 47 | m3(4,1)=dy/three; 48 | m3(4,4)=dz/three; 49 | m3(1,2)=dz/three; 50 | m3(2,1)=dz/three; 51 | case 6 52 | sx=stress(1); 53 | sy=stress(2); 54 | sz=stress(3); 55 | txy=stress(4); 56 | tyz=stress(5); 57 | tzx=stress(6); 58 | sigm=(sx+sy+sz)/three; 59 | dx=sx-sigm; 60 | dy=sy-sigm; 61 | dz=sz-sigm; 62 | m1=zeros(nst,nst); 63 | m2=zeros(nst,nst); 64 | m3=zeros(nst,nst); 65 | m1(1:3,1:3)=one/(three*sigm); 66 | for i=1:3 67 | m2(i,i)=two ; 68 | m2(i+3,i+3)=six ; 69 | end 70 | m2(1,2)=-one; 71 | m2(1,3)=-one ; 72 | m2(2,3)=-one; 73 | m3(1,1)=dx; 74 | m3(1,2)=dz ; 75 | m3(1,3)=dy ; 76 | m3(1,4)=txy ; 77 | m3(1,5)=-two*tyz; 78 | m3(1,6)=tzx ; 79 | m3(2,2)=dy ; 80 | m3(2,3)=dx ; 81 | m3(2,4)=txy; 82 | m3(2,5)=tyz ; 83 | m3(2,6)=-two*tzx ; 84 | m3(3,3)=dz; 85 | m3(3,4)=-two*txy; 86 | m3(3,5)=tyz ; 87 | m3(3,6)=tzx; 88 | m3(4,4)=-three*dz; 89 | m3(4,5)=three*tzx; 90 | m3(4,6)=three*tyz; 91 | m3(5,5)=-three*dx; 92 | m3(5,6)=three*txy; 93 | m3(6,6)=-three*dy; 94 | for i=1:6 95 | for j=i+1:6 96 | m1(j,i)=m1(i,j) ; 97 | m2(j,i)=m2(i,j) ; 98 | m3(j,i)=m3(i,j); 99 | end 100 | end 101 | m1=m1/three; 102 | m2=m2/three; 103 | m3=m3/three; 104 | otherwise 105 | disp('nst size not recognised in formm'); 106 | end 107 | 108 | end 109 | 110 | -------------------------------------------------------------------------------- /library/main/formtb.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE formtb(pb,km,g) 2 | ! 3 | ! This subroutine assembles an unsymmetrical band matrix pb from 4 | ! element constituent matrices km. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::km(:,:) 9 | INTEGER,INTENT(IN)::g(:) 10 | REAL(iwp),INTENT(OUT)::pb(:,:) 11 | INTEGER::i,j,idof,icd,iw 12 | idof=SIZE(km,1) 13 | iw=(SIZE(pb,2)-1)/2 14 | DO i=1,idof 15 | IF(g(i)/=0)THEN 16 | DO j=1,idof 17 | IF(g(j)/=0)THEN 18 | icd=g(j)-g(i)+iw+1 19 | pb(g(i),icd)=pb(g(i),icd)+km(i,j) 20 | END IF 21 | END DO 22 | END IF 23 | END DO 24 | RETURN 25 | END SUBROUTINE formtb 26 | -------------------------------------------------------------------------------- /library/main/formupv.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE formupv(ke,c11,c12,c21,c23,c32) 2 | ! 3 | ! This subroutine forms the unsymmetrical stiffness matrix 4 | ! for the u-p-v version of the Navier-Stokes equations. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::c11(:,:),c21(:,:),c23(:,:),c32(:,:),c12(:,:) 9 | REAL(iwp),INTENT(OUT)::ke(:,:) 10 | INTEGER::nod,nodf,ntot 11 | nod=UBOUND(c11,1) 12 | nodf=UBOUND(c21,1) 13 | ntot=nod+nodf+nod 14 | ke(1:nod,1:nod)=c11 15 | ke(1:nod,nod+1:nod+nodf)=c12 16 | ke(nod+1:nod+nodf,1:nod)=c21 17 | ke(nod+1:nod+nodf,nod+nodf+1:ntot)=c23 18 | ke(nod+nodf+1:ntot,nod+1:nod+nodf)=c32 19 | ke(nod+nodf+1:ntot,nod+nodf+1:ntot)=c11 20 | RETURN 21 | END SUBROUTINE formupv 22 | -------------------------------------------------------------------------------- /library/main/fsparv.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE fsparv(kv,km,g,kdiag) 2 | ! 3 | ! This subroutine assembles element matrices into a symmetric skyline 4 | ! global matrix. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | INTEGER,INTENT(IN)::g(:),kdiag(:) 9 | REAL(iwp),INTENT(IN)::km(:,:) 10 | REAL(iwp),INTENT(OUT)::kv(:) 11 | INTEGER::i,idof,k,j,iw,ival 12 | idof=UBOUND(g,1) 13 | DO i=1,idof 14 | k=g(i) 15 | IF(k/=0)THEN 16 | DO j=1,idof 17 | IF(g(j)/=0)THEN 18 | iw=k-g(j) 19 | IF(iw>=0)THEN 20 | ival=kdiag(k)-iw 21 | kv(ival)=kv(ival)+km(i,j) 22 | END IF 23 | END IF 24 | END DO 25 | END IF 26 | END DO 27 | RETURN 28 | END SUBROUTINE fsparv -------------------------------------------------------------------------------- /library/main/fsparv.m: -------------------------------------------------------------------------------- 1 | function kv = fsparv(kv,km,g,kdiag) 2 | % Assembles element matrices into a symmetric skyline 3 | idof=length(g); 4 | for i=1:idof 5 | k=g(i); 6 | if k~=0 7 | for j=1:idof 8 | if g(j)~=0 9 | iw=k-g(j); 10 | if iw>=0 11 | ival=kdiag(k)-iw; 12 | kv(ival)=kv(ival)+km(i,j) ; 13 | end 14 | end 15 | end 16 | end 17 | end 18 | end 19 | 20 | -------------------------------------------------------------------------------- /library/main/gauss_band.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE gauss_band(pb,work) 2 | ! 3 | ! This subroutine performs gaussian reduction of an unsymmetric 4 | ! banded matrix pb. Array work used as working space. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN OUT)::pb(:,:),work(:,:) 9 | REAL(iwp)::s,zero=0.0_iwp,small=1.e-10_iwp 10 | INTEGER::n,iwp1,iq,iqp,iwp11,i,j,k,l,ip,k1 11 | n=UBOUND(pb,1) 12 | iwp1=(UBOUND(pb,2)-1)/2+1 13 | iq=2*iwp1-1 14 | iqp=iwp1 15 | iwp11=iwp1-1 16 | DO i=1,iwp11 17 | DO j=1,iq 18 | IF(j>=iwp1+i)THEN 19 | pb(i,j)=zero 20 | pb(n-i+1,j)=zero 21 | ELSE 22 | pb(i,j)=pb(i,j+iwp1-i) 23 | END IF 24 | END DO 25 | END DO 26 | DO k=1,n 27 | l=k+iwp1-1 28 | IF(l>n)l=n 29 | ip=0 30 | s=small 31 | DO i=k,l 32 | IF(ABS(pb(i,1))<=s)CYCLE 33 | s=ABS(pb(i,1)) 34 | ip=i 35 | END DO 36 | IF(ip==0)THEN 37 | WRITE(6,'("singular")') 38 | EXIT 39 | END IF 40 | IF(k==n)EXIT 41 | work(iwp1,k)=ip 42 | iqp=iqp-1 43 | j=iwp1+ip-k 44 | IF(iqpiqp)THEN 57 | pb(i,j-1)=pb(i,j) 58 | ELSE 59 | pb(i,j-1)=pb(i,j)-s*pb(k,j) 60 | END IF 61 | END DO 62 | pb(i,iq)=zero 63 | work(i-k,k)=s 64 | END DO 65 | END DO 66 | RETURN 67 | END SUBROUTINE gauss_band 68 | -------------------------------------------------------------------------------- /library/main/getname.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE getname(argv,nlen) 2 | ! 3 | ! This subroutine reads the base name of data file. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER::narg 7 | INTEGER,INTENT(OUT)::nlen 8 | INTEGER::lnblnk,iargc 9 | CHARACTER(*),INTENT(OUT)::argv 10 | LOGICAL found 11 | narg=IARGC() 12 | IF(narg<1)THEN 13 | WRITE(*,*)'Please enter the base name of data file: ' 14 | READ(*,*)argv 15 | ELSE 16 | CALL getarg(1,argv) 17 | ENDIF 18 | nlen=LNBLNK(argv) 19 | INQUIRE(FILE=argv(1:nlen)//'.dat',EXIST=found) 20 | IF(.NOT.found)THEN 21 | WRITE(*,*)'Data file not found: ',argv(1:nlen)//'.dat' 22 | WRITE(*,*)'Please create or check spelling.' 23 | STOP 24 | ENDIF 25 | RETURN 26 | END SUBROUTINE getname 27 | -------------------------------------------------------------------------------- /library/main/glob_to_axial.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE glob_to_axial(axial,global,coord) 2 | ! 3 | ! This subroutine transforms the global end reactions 4 | ! into an axial force for rod elements (2- or 3-d). 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::global(:),coord(:,:) 9 | REAL(iwp),INTENT(OUT)::axial 10 | REAL(iwp)::add,ell,zero=0.0_iwp 11 | INTEGER::ndim,i 12 | ndim=UBOUND(coord,2) 13 | add=zero 14 | DO i=1,ndim 15 | add=add+(coord(2,i)-coord(1,i))**2 16 | END DO 17 | ell=SQRT(add) 18 | axial=zero 19 | DO i=1,ndim 20 | axial=axial+(coord(2,i)-coord(1,i))/ell*global(ndim+i) 21 | END DO 22 | RETURN 23 | END SUBROUTINE glob_to_axial 24 | -------------------------------------------------------------------------------- /library/main/glob_to_loc.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE glob_to_loc(local,global,gamma,coord) 2 | ! 3 | ! This subroutine transforms the global end reactions and 4 | ! moments into the local system (2- or 3-d). 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::global(:),gamma,coord(:,:) 9 | REAL(iwp),INTENT(OUT)::local(:) 10 | REAL(iwp)::t(12,12),r0(3,3),x1,x2,y1,y2,z1,z2,xl,yl,zl,pi,gamrad,cg,sg, & 11 | den,ell,x,sum,zero=0.0_iwp,one=1.0_iwp,d180=180.0_iwp 12 | INTEGER::i,j,k,ndim 13 | ndim=UBOUND(coord,2) 14 | SELECT CASE(ndim) 15 | CASE(2) 16 | x1=coord(1,1) 17 | y1=coord(1,2) 18 | x2=coord(2,1) 19 | y2=coord(2,2) 20 | ell=SQRT((x2-x1)**2+(y2-y1)**2) 21 | cg=(x2-x1)/ell 22 | sg=(y2-y1)/ell 23 | local(1)=cg*global(1)+sg*global(2) 24 | local(2)=cg*global(2)-sg*global(1) 25 | local(3)=global(3) 26 | local(4)=cg*global(4)+sg*global(5) 27 | local(5)=cg*global(5)-sg*global(4) 28 | local(6)=global(6) 29 | CASE(3) 30 | x1=coord(1,1) 31 | y1=coord(1,2) 32 | z1=coord(1,3) 33 | x2=coord(2,1) 34 | y2=coord(2,2) 35 | z2=coord(2,3) 36 | xl=x2-x1 37 | yl=y2-y1 38 | zl=z2-z1 39 | ell=SQRT(xl*xl+yl*yl+zl*zl) 40 | t=zero 41 | pi=ACOS(-one) 42 | gamrad=gamma*pi/d180 43 | cg=COS(gamrad) 44 | sg=SIN(gamrad) 45 | den=ell*SQRT(xl*xl+zl*zl) 46 | IF(den/=zero)THEN 47 | r0(1,1)=xl/ell 48 | r0(1,2)=yl/ell 49 | r0(1,3)=zl/ell 50 | r0(2,1)=(-xl*yl*cg-ell*zl*sg)/den 51 | r0(2,2)=den*cg/(ell*ell) 52 | r0(2,3)=(-yl*zl*cg+ell*xl*sg)/den 53 | r0(3,1)=(xl*yl*sg-ell*zl*cg)/den 54 | r0(3,2)=-den*sg/(ell*ell) 55 | r0(3,3)=(yl*zl*sg+ell*xl*cg)/den 56 | ELSE 57 | r0(1,1)=zero 58 | r0(1,3)=zero 59 | r0(2,2)=zero 60 | r0(3,2)=zero 61 | r0(1,2)=one 62 | r0(2,1)=-cg 63 | r0(3,3)=cg 64 | r0(2,3)=sg 65 | r0(3,1)=sg 66 | END IF 67 | DO i=1,3 68 | DO j=1,3 69 | x=r0(i,j) 70 | DO k=0,9,3 71 | t(i+k,j+k)=x 72 | END DO 73 | END DO 74 | END DO 75 | DO i=1,12 76 | sum=zero 77 | DO j=1,12 78 | sum=sum+t(i,j)*global(j) 79 | END DO 80 | local(i)=sum 81 | END DO 82 | END SELECT 83 | RETURN 84 | END SUBROUTINE glob_to_loc 85 | -------------------------------------------------------------------------------- /library/main/interp.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE interp(k,dtim,rt,rl,al,nstep) 2 | ! 3 | ! This subroutine forms the load/time functions by interpolation. 4 | ! If dtim is not an exact multiple it stops one short. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::dtim,rt(:),rl(:) 9 | INTEGER,INTENT(IN)::k,nstep 10 | REAL(iwp),INTENT(IN OUT)::al(:,:) 11 | INTEGER::np,i,j 12 | REAL(iwp)::t,val 13 | np=SIZE(rt) 14 | al(1,k)=rl(1) 15 | t=rt(1) 16 | DO j=2,nstep 17 | t=t+dtim 18 | DO i=2,np 19 | IF(t.LE.rt(i))THEN 20 | val=rl(i-1)+((t-rt(i-1))/(rt(i)-rt(i-1)))*(rl(i)-rl(i-1)) 21 | EXIT 22 | END IF 23 | END DO 24 | al(j,k)=val 25 | END DO 26 | RETURN 27 | END SUBROUTINE interp 28 | -------------------------------------------------------------------------------- /library/main/invar.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE invar(stress,sigm,dsbar,theta) 2 | ! 3 | ! This subroutine forms the stress invariants in 2- or 3-d. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::stress(:) 8 | REAL(iwp),INTENT(OUT),OPTIONAL::sigm,dsbar,theta 9 | REAL(iwp)::sx,sy,sz,txy,dx,dy,dz,xj3,sine,s1,s2,s3,s4,s5,s6,ds1,ds2,ds3, & 10 | d2,d3,sq3,zero=0.0_iwp,small=1.e-10_iwp,one=1.0_iwp,two=2.0_iwp, & 11 | three=3.0_iwp,six=6.0_iwp,thpt5=13.5_iwp 12 | INTEGER::nst 13 | nst=UBOUND(stress,1) 14 | SELECT CASE(nst) 15 | CASE(4) 16 | sx=stress(1) 17 | sy=stress(2) 18 | txy=stress(3) 19 | sz=stress(4) 20 | sigm=(sx+sy+sz)/three 21 | dsbar=SQRT((sx-sy)**2+(sy-sz)**2+(sz-sx)**2+six*txy**2)/SQRT(two) 22 | IF(dsbar=one)sine=one 31 | IF(sine<-one)sine=-one 32 | theta=ASIN(sine)/three 33 | END IF 34 | CASE(6) 35 | sq3=SQRT(three) 36 | s1=stress(1) 37 | s2=stress(2) 38 | s3=stress(3) 39 | s4=stress(4) 40 | s5=stress(5) 41 | s6=stress(6) 42 | sigm=(s1+s2+s3)/three 43 | d2=((s1-s2)**2+(s2-s3)**2+(s3-s1)**2)/six+s4*s4+s5*s5+s6*s6 44 | ds1=s1-sigm 45 | ds2=s2-sigm 46 | ds3=s3-sigm 47 | d3=ds1*ds2*ds3-ds1*s5*s5-ds2*s6*s6-ds3*s4*s4+two*s4*s5*s6 48 | dsbar=sq3*SQRT(d2) 49 | IF(dsbar=one)sine=one 54 | IF(sine<-one)sine=-one 55 | theta=ASIN(sine)/three 56 | END IF 57 | CASE DEFAULT 58 | WRITE(*,*)"wrong size for nst in invar" 59 | END SELECT 60 | RETURN 61 | END SUBROUTINE invar 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /library/main/invar.m: -------------------------------------------------------------------------------- 1 | function [sigm,dsbar,theta]=invar(stress) 2 | % ! This subroutine forms the stress invariants in 2- or 3-d. 3 | zero=0.0;small=1.e-10;one=1.0;two=2.0; 4 | three=3.0;six=6.0;thpt5=13.5; 5 | nst=size(stress,1); 6 | switch nst 7 | case 4 8 | sx=stress(1); 9 | sy=stress(2); 10 | txy=stress(3); 11 | sz=stress(4); 12 | sigm=(sx+sy+sz)/three; 13 | dsbar=sqrt((sx-sy)^2+(sy-sz)^2+(sz-sx)^2+six*txy^2)/sqrt(two); 14 | if dsbar=one;sine=one;end 23 | if sine<-one;sine=-one;end 24 | theta=asin(sine)/three ; 25 | end 26 | case 6 27 | sq3=sqrt(three); 28 | s1=stress(1); 29 | s2=stress(2); 30 | s3=stress(3); 31 | s4=stress(4); 32 | s5=stress(5); 33 | s6=stress(6); 34 | sigm=(s1+s2+s3)/three; 35 | d2=((s1-s2)^2+(s2-s3)^2+(s3-s1)^2)/six+s4*s4+s5*s5+s6*s6; 36 | ds1=s1-sigm ; 37 | ds2=s2-sigm ; 38 | ds3=s3-sigm; 39 | d3=ds1*ds2*ds3-ds1*s5*s5-ds2*s6*s6-ds3*s4*s4+two*s4*s5*s6; 40 | dsbar=sq3*SQRT(d2); 41 | if dsbar=one;sine=one;end 46 | if sine<-one;sine=-one;end 47 | theta=asin(sine)/three ; 48 | end 49 | otherwise 50 | disp('wrong size for nst in invar'); 51 | end 52 | 53 | end 54 | 55 | -------------------------------------------------------------------------------- /library/main/invert.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE invert(matrix) 2 | ! 3 | ! This subroutine inverts a small square matrix onto itself. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN OUT)::matrix(:,:) 8 | REAL(iwp)::det,j11,j12,j13,j21,j22,j23,j31,j32,j33,con 9 | INTEGER::ndim,i,k 10 | ndim=UBOUND(matrix,1) 11 | IF(ndim==2)THEN 12 | det=matrix(1,1)*matrix(2,2)-matrix(1,2)*matrix(2,1) 13 | j11=matrix(1,1) 14 | matrix(1,1)=matrix(2,2) 15 | matrix(2,2)=j11 16 | matrix(1,2)=-matrix(1,2) 17 | matrix(2,1)=-matrix(2,1) 18 | matrix=matrix/det 19 | ELSE IF(ndim==3)THEN 20 | det=matrix(1,1)*(matrix(2,2)*matrix(3,3)-matrix(3,2)*matrix(2,3)) 21 | det=det-matrix(1,2)*(matrix(2,1)*matrix(3,3)-matrix(3,1)*matrix(2,3)) 22 | det=det+matrix(1,3)*(matrix(2,1)*matrix(3,2)-matrix(3,1)*matrix(2,2)) 23 | j11=matrix(2,2)*matrix(3,3)-matrix(3,2)*matrix(2,3) 24 | j21=-matrix(2,1)*matrix(3,3)+matrix(3,1)*matrix(2,3) 25 | j31=matrix(2,1)*matrix(3,2)-matrix(3,1)*matrix(2,2) 26 | j12=-matrix(1,2)*matrix(3,3)+matrix(3,2)*matrix(1,3) 27 | j22=matrix(1,1)*matrix(3,3)-matrix(3,1)*matrix(1,3) 28 | j32=-matrix(1,1)*matrix(3,2)+matrix(3,1)*matrix(1,2) 29 | j13=matrix(1,2)*matrix(2,3)-matrix(2,2)*matrix(1,3) 30 | j23=-matrix(1,1)*matrix(2,3)+matrix(2,1)*matrix(1,3) 31 | j33=matrix(1,1)*matrix(2,2)-matrix(2,1)*matrix(1,2) 32 | matrix(1,1)=j11 33 | matrix(1,2)=j12 34 | matrix(1,3)=j13 35 | matrix(2,1)=j21 36 | matrix(2,2)=j22 37 | matrix(2,3)=j23 38 | matrix(3,1)=j31 39 | matrix(3,2)=j32 40 | matrix(3,3)=j33 41 | matrix=matrix/det 42 | ELSE 43 | DO k=1,ndim 44 | con=matrix(k,k) 45 | matrix(k,k)=1.0_iwp 46 | matrix(k,:)=matrix(k,:)/con 47 | DO i=1,ndim 48 | IF(i/=k)THEN 49 | con=matrix(i,k) 50 | matrix(i,k)=0.0_iwp 51 | matrix(i,:)=matrix(i,:)-matrix(k,:)*con 52 | END IF 53 | END DO 54 | END DO 55 | END IF 56 | RETURN 57 | END SUBROUTINE invert 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /library/main/linmul_sky.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE linmul_sky(kv,disps,loads,kdiag) 2 | ! 3 | ! This subroutine forms the product of symmetric matrix stored as 4 | ! a skyline and a vector. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::kv(:),disps(0:) 9 | REAL(iwp),INTENT(OUT)::loads(0:) 10 | INTEGER,INTENT(IN)::kdiag(:) 11 | INTEGER::n,i,j,low,lup,k 12 | REAL(iwp)::x,zero=0.0_iwp 13 | n=UBOUND(disps,1) 14 | DO i=1,n 15 | x=zero 16 | lup=kdiag(i) 17 | IF(i==1)low=lup 18 | IF(i/=1)low=kdiag(i-1)+1 19 | DO j=low,lup 20 | x=x+kv(j)*disps(i+j-lup) 21 | END DO 22 | loads(i)=x 23 | IF(i==1)CYCLE 24 | lup=lup-1 25 | DO j=low,lup 26 | k=i+j-lup-1 27 | loads(k)=loads(k)+kv(j)*disps(i) 28 | END DO 29 | END DO 30 | RETURN 31 | END SUBROUTINE linmul_sky 32 | -------------------------------------------------------------------------------- /library/main/lnblnk.f03: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION lnblnk( str ) 2 | CHARACTER*(*),INTENT(IN)::str 3 | CHARACTER*1 space, tab, null, char 4 | INTEGER j,i 5 | DATA space/' '/, tab/' '/ 6 | null = CHAR(0) 7 | i = LEN( str ) 8 | DO j = i, 1, -1 9 | IF(str(j:j).ne.space.and.str(j:j).ne.null.and.str(j:j).ne.tab)THEN 10 | lnblnk = j 11 | RETURN 12 | ENDIF 13 | ENDDO 14 | lnblnk = 0 15 | RETURN 16 | END FUNCTION lnblnk 17 | -------------------------------------------------------------------------------- /library/main/load_function.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE load_function(lf,dtim,al) 2 | ! 3 | ! This subroutine forms the increment of load at each 4 | ! calculation time step. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::lf(:,:),dtim 9 | REAL(iwp),INTENT(IN OUT)::al(:) 10 | REAL(iwp)::time,aold,anew 11 | INTEGER::nlfp,nincs,i,j 12 | nincs=SIZE(al) 13 | nlfp=UBOUND(lf,2) 14 | aold=lf(2,1) 15 | time=lf(1,1) 16 | DO i=1,nincs 17 | time=time+dtim 18 | DO j=1,nlfp 19 | IF(timexmax)xmax=g_coord(1,i) 27 | IF(g_coord(2,i)ymax)ymax=g_coord(2,i) 29 | END DO 30 | width =xmax-xmin 31 | height=ymax-ymin 32 | ! 33 | ! allow 1.5" margin minimum on each side of figure 34 | ! 35 | IF(height.GE.d11/ept5*width)THEN 36 | ! 37 | ! height governs the scale 38 | ! 39 | sxy=scale*d8/height 40 | xo=scale*pt5*(ept5-d8*width/height) 41 | yo=scale*opt5 42 | ELSE 43 | ! 44 | ! width governs the scale 45 | ! 46 | sxy=scale*fpt5/width 47 | xo=scale*opt5 48 | yo=scale*pt5*(d11-fpt5*height/width) 49 | END IF 50 | ! 51 | ! start PostScript output 52 | ! 53 | WRITE(ips,'(a)')'%!PS-Adobe-1.0' 54 | WRITE(ips,'(a)')'%%DocumentFonts: none' 55 | WRITE(ips,'(a)')'%%Pages: 1' 56 | WRITE(ips,'(a)')'%%EndComments' 57 | WRITE(ips,'(a)')'/m {moveto} def' 58 | WRITE(ips,'(a)')'/l {lineto} def' 59 | WRITE(ips,'(a)')'/s {stroke} def' 60 | WRITE(ips,'(a)')'/c {closepath} def' 61 | WRITE(ips,'(a)')'%%EndProlog' 62 | WRITE(ips,'(a)')'%%Page: 0 1' 63 | WRITE(ips,'(a)')'gsave' 64 | WRITE(ips,'(2f9.2,a)') xo, yo, ' translate' 65 | WRITE(ips,'(f9.2,a)') 0.5, ' setlinewidth' 66 | ! 67 | ! draw the mesh 68 | ! 69 | nod=UBOUND(g_num,1) 70 | nel=UBOUND(g_num,2) 71 | IF(nod==5)nod=4 72 | IF(nod==9)nod=8 73 | IF(nod==10)nod=9 74 | IF(nod==15)nod=12 75 | DO i=1,nel 76 | ii=g_num(1,i) 77 | IF(ii==0)CYCLE 78 | x=sxy*(g_coord(1,ii)-xmin) 79 | y=sxy*(g_coord(2,ii)-ymin) 80 | WRITE(ips,'(2f9.2,a)')x,y,' m' 81 | DO j=2,nod 82 | jj=g_num(j,i) 83 | x=sxy*(g_coord(1,jj)-xmin) 84 | y=sxy*(g_coord(2,jj)-ymin) 85 | WRITE(ips,'(2f9.2,a)') x, y,' l' 86 | END DO 87 | WRITE(ips,'(a)')'c s' 88 | END DO 89 | ! 90 | ! close output file 91 | ! 92 | WRITE(ips,'(a)')'grestore' 93 | WRITE(ips,'(a)')'showpage' 94 | CLOSE(ips) 95 | ! 96 | RETURN 97 | END SUBROUTINE mesh 98 | -------------------------------------------------------------------------------- /library/main/mocouf.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE mocouf(phi,c,sigm,dsbar,theta,f) 2 | ! 3 | ! This subroutine calculates the value of the yield function 4 | ! for a Mohr-Coulomb material (phi in degrees). 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::phi,c,sigm,dsbar,theta 9 | REAL(iwp),INTENT(OUT)::f 10 | REAL(iwp)::phir,snph,csph,csth,snth,one=1.0_iwp,d3=3.0_iwp,d4=4.0_iwp, & 11 | d180=180.0_iwp 12 | phir=phi*d4*ATAN(one)/d180 13 | snph=SIN(phir) 14 | csph=COS(phir) 15 | csth=COS(theta) 16 | snth=SIN(theta) 17 | f=snph*sigm+dsbar*(csth/SQRT(d3)-snth*snph/d3)-c*csph 18 | RETURN 19 | END SUBROUTINE mocouf 20 | -------------------------------------------------------------------------------- /library/main/mocouf.m: -------------------------------------------------------------------------------- 1 | function f = mocouf(phi,c,sigm,dsbar,theta) 2 | % ! This subroutine calculates the value of the yield function 3 | % ! for a Mohr-Coulomb material (phi in degrees). 4 | one=1.0;d3=3.0;d4=4.0; 5 | d180=180.0; 6 | phir=phi*d4*atan(one)/d180; 7 | snph=sin(phir) ; 8 | csph=cos(phir) ; 9 | csth=cos(theta); 10 | snth=sin(theta); 11 | f=snph*sigm+dsbar*(csth/sqrt(d3)-snth*snph/d3)-c*csph; 12 | 13 | end 14 | 15 | -------------------------------------------------------------------------------- /library/main/mocouq.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE mocouq(psi,dsbar,theta,dq1,dq2,dq3) 2 | ! 3 | ! This subroutine forms the derivatives of a Mohr-Coulomb potential 4 | ! function with respect to the three invariants (psi in degrees). 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::psi,dsbar,theta 9 | REAL(iwp),INTENT(OUT)::dq1,dq2,dq3 10 | REAL(iwp)::psir,snth,snps,sq3,c1,csth,cs3th,tn3th,tnth,zero=0.0_iwp, & 11 | pt49=0.49_iwp,pt5=0.5_iwp,one=1.0_iwp,d3=3.0_iwp,d4=4.0_iwp, & 12 | d180=180.0_iwp 13 | psir=psi*d4*ATAN(one)/d180 14 | snth=SIN(theta) 15 | snps=SIN(psir) 16 | sq3=SQRT(d3) 17 | dq1=snps 18 | if(ABS(snth).GT.pt49)THEN 19 | c1=one 20 | IF(snth.LT.zero)c1=-one 21 | dq2=(sq3*pt5-c1*snps*pt5/sq3)*sq3*pt5/dsbar 22 | dq3=zero 23 | ELSE 24 | csth=COS(theta) 25 | cs3th=COS(d3*theta) 26 | tn3th=TAN(d3*theta) 27 | tnth=snth/csth 28 | dq2=sq3*csth/dsbar*((one+tnth*tn3th)+snps*(tn3th-tnth)/sq3)*pt5 29 | dq3=pt5*d3*(sq3*snth+snps*csth)/(cs3th*dsbar*dsbar) 30 | END IF 31 | RETURN 32 | END SUBROUTINE mocouq 33 | -------------------------------------------------------------------------------- /library/main/mocouq.m: -------------------------------------------------------------------------------- 1 | function [dq1,dq2,dq3]=mocouq(psi,dsbar,theta) 2 | % ! This subroutine forms the derivatives of a Mohr-Coulomb potential 3 | % ! function with respect to the three invariants (psi in degrees). 4 | pt49=0.49;pt5=0.5;one=1.0;d3=3.0;d4=4.0;zero=0; 5 | d180=180.0; 6 | psir=psi*d4*atan(one)/d180 ; 7 | snth=sin(theta) ; 8 | snps=sin(psir); 9 | sq3=sqrt(d3) ; 10 | dq1=snps; 11 | if abs(snth) > pt49 12 | c1=one; 13 | if snth < zero 14 | c1=-one; 15 | end 16 | dq2=(sq3*pt5-c1*snps*pt5/sq3)*sq3*pt5/dsbar ; 17 | dq3=zero; 18 | else 19 | csth=cos(theta); 20 | cs3th=cos(d3*theta); 21 | tn3th=tan(d3*theta); 22 | tnth=snth/csth; 23 | dq2=sq3*csth/dsbar*((one+tnth*tn3th)+snps*(tn3th-tnth)/sq3)*pt5; 24 | dq3=pt5*d3*(sq3*snth+snps*csth)/(cs3th*dsbar*dsbar); 25 | end 26 | end 27 | 28 | -------------------------------------------------------------------------------- /library/main/norm.f03: -------------------------------------------------------------------------------- 1 | FUNCTION norm(x)RESULT(l2n) 2 | ! 3 | ! THis function calculates the l2 norm of vector x 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::x(:) 8 | REAL(iwp)::l2n 9 | l2n=SQRT(SUM(x**2)) 10 | RETURN 11 | END FUNCTION norm 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /library/main/num_to_g.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE num_to_g(num,nf,g) 2 | ! 3 | ! This subroutine finds the g vector from num and nf. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,INTENT(IN)::num(:),nf(:,:) 7 | INTEGER,INTENT(OUT)::g(:) 8 | INTEGER::i,k,nod,nodof 9 | nod=UBOUND(num,1) 10 | nodof=UBOUND(nf,1) 11 | DO i=1,nod 12 | k=i*nodof 13 | g(k-nodof+1:k)=nf(:,num(i)) 14 | END DO 15 | RETURN 16 | END SUBROUTINE num_to_g 17 | -------------------------------------------------------------------------------- /library/main/num_to_g.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GeoGroup/Programming_FEM/77f992256423e38274fd4da6c3418b72f3877492/library/main/num_to_g.m -------------------------------------------------------------------------------- /library/main/out_tecplot.m: -------------------------------------------------------------------------------- 1 | function out_tecplot( fn ) 2 | % out the data ro tecplot 3 | % Output 4 | 5 | fn='newtec'; 6 | ft=['tec',fn,'.dat']; 7 | ftec=fopen(ft,'wt'); 8 | fprintf(ftec,'%s\n','TITLE = "Fortran to Tecplot "'); 9 | fprintf(ftec,'%s\n','VARIABLES = "X" "Y" "Z" "H" "PORE" '); % "HM" 10 | fprintf(ftec,'ZONE T="GLOBAL", N=%d, E=%d, ZONETYPE=FEBrick\n', nn, nels); 11 | fprintf(ftec,'DATAPACKING=BLOCK\n'); 12 | fprintf(ftec,'VARLOCATION=([1-5]=NODAL)\n'); 13 | for i=1:nn 14 | fprintf(ftec,'%f\n',g_coord(i,1)); 15 | end 16 | for i=1:nn 17 | fprintf(ftec,'%f\n',g_coord(i,2)); 18 | end 19 | for i=1:nn 20 | fprintf(ftec,'%f\n',g_coord(i,3)); 21 | end 22 | 23 | for i=1:nn 24 | if disps(i)-g_coord(i,3)>0 25 | fprintf(ftec,'%f\n',disps(i)); 26 | else 27 | fprintf(ftec,'%f\n',disps(i)); 28 | end 29 | end 30 | 31 | for i=1:nn 32 | fprintf(ftec,'%f\n',10000*(disps(i)-g_coord(i,3))); 33 | end 34 | 35 | for i=1:nels 36 | fprintf(ftec,'%d %d %d %d %d %d %d %d\n',g_num(i,1),g_num(i,4),g_num(i,8),g_num(i,5),g_num(i,2),g_num(i,3),g_num(i,7),g_num(i,6)); 37 | end 38 | fclose(ftec); 39 | 40 | 41 | 42 | end 43 | 44 | -------------------------------------------------------------------------------- /library/main/pin_jointed.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE pin_jointed(km,ea,coord) 2 | ! 3 | ! This subroutine forms the stiffness matrix of a 4 | ! general rod element (1-, 2- or 3-d). 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::ea,coord(:,:) 9 | REAL(iwp),INTENT(OUT)::km(:,:) 10 | INTEGER::ndim 11 | REAL(iwp)::ell,cs,sn,x1,x2,y1,y2,z1,z2,a,b,c,d,e,f,xl,yl,zl,one=1.0_iwp 12 | ndim=UBOUND(coord,2) 13 | SELECT CASE(ndim) 14 | CASE(1) 15 | ell=coord(2,1)-coord(1,1) 16 | km(1,1)=one 17 | km(1,2)=-one 18 | km(2,1)=-one 19 | km(2,2)=one 20 | CASE(2) 21 | x1=coord(1,1) 22 | y1=coord(1,2) 23 | x2=coord(2,1) 24 | y2=coord(2,2) 25 | ell=SQRT((y2-y1)**2+(x2-x1)**2) 26 | cs=(x2-x1)/ell 27 | sn=(y2-y1)/ell 28 | a=cs*cs 29 | b=sn*sn 30 | c=cs*sn 31 | km(1,1)=a 32 | km(3,3)=a 33 | km(1,3)=-a 34 | km(3,1)=-a 35 | km(2,2)=b 36 | km(4,4)=b 37 | km(2,4)=-b 38 | km(4,2)=-b 39 | km(1,2)=c 40 | km(2,1)=c 41 | km(3,4)=c 42 | km(4,3)=c 43 | km(1,4)=-c 44 | km(4,1)=-c 45 | km(2,3)=-c 46 | km(3,2)=-c 47 | CASE(3) 48 | x1=coord(1,1) 49 | y1=coord(1,2) 50 | z1=coord(1,3) 51 | x2=coord(2,1) 52 | y2=coord(2,2) 53 | z2=coord(2,3) 54 | xl=x2-x1 55 | yl=y2-y1 56 | zl=z2-z1 57 | ell=SQRT(xl*xl+yl*yl+zl*zl) 58 | xl=xl/ell 59 | yl=yl/ell 60 | zl=zl/ell 61 | a=xl*xl 62 | b=yl*yl 63 | c=zl*zl 64 | d=xl*yl 65 | e=yl*zl 66 | f=zl*xl 67 | km(1,1)=a 68 | km(4,4)=a 69 | km(2,2)=b 70 | km(5,5)=b 71 | km(3,3)=c 72 | km(6,6)=c 73 | km(1,2)=d 74 | km(2,1)=d 75 | km(4,5)=d 76 | km(5,4)=d 77 | km(2,3)=e 78 | km(3,2)=e 79 | km(5,6)=e 80 | km(6,5)=e 81 | km(1,3)=f 82 | km(3,1)=f 83 | km(4,6)=f 84 | km(6,4)=f 85 | km(1,4)=-a 86 | km(4,1)=-a 87 | km(2,5)=-b 88 | km(5,2)=-b 89 | km(3,6)=-c 90 | km(6,3)=-c 91 | km(1,5)=-d 92 | km(5,1)=-d 93 | km(2,4)=-d 94 | km(4,2)=-d 95 | km(2,6)=-e 96 | km(6,2)=-e 97 | km(3,5)=-e 98 | km(5,3)=-e 99 | km(1,6)=-f 100 | km(6,1)=-f 101 | km(3,4)=-f 102 | km(4,3)=-f 103 | END SELECT 104 | km=km*ea/ell 105 | RETURN 106 | END SUBROUTINE pin_jointed 107 | -------------------------------------------------------------------------------- /library/main/pmsh_ensi.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE pmsh_ensi(argv,nlen,step,loads) 2 | ! 3 | ! This subroutine outputs pressure in the Ensight gold format for 4 | ! visualization in ParaView. ParaView also requires the output of subroutine 5 | ! mesh_ensi for the geometry. 6 | ! 7 | IMPLICIT none 8 | 9 | INTEGER,PARAMETER :: iwp=SELECTED_REAL_KIND(15) 10 | INTEGER, INTENT(IN) :: nlen,step 11 | INTEGER :: i 12 | REAL(iwp), INTENT(IN) :: loads(:) 13 | CHARACTER(LEN=15), INTENT(IN) :: argv 14 | CHARACTER(LEN=5) :: ch 15 | 16 | WRITE(ch,'(I5.5)') step ! convert integer to string using internal file 17 | 18 | OPEN(17,FILE=argv(1:nlen)//'.ensi.PRESSURE-'//ch) 19 | 20 | WRITE(17,'(A)') "Alya Ensight Gold --- Scalar per-node variable file" 21 | WRITE(17,'(A/A/A)') "part", " 1","coordinates" 22 | 23 | DO i=1,UBOUND(loads,1) 24 | WRITE(17,'(E12.5)') loads(i) 25 | END DO 26 | 27 | CLOSE(17) 28 | 29 | RETURN 30 | 31 | END SUBROUTINE pmsh_ensi 32 | 33 | -------------------------------------------------------------------------------- /library/main/rod_km.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE rod_km(km,ea,length) 2 | ! 3 | ! This subroutine forms the stiffness matrix of a 1-d "rod" element. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),INTENT(IN)::ea,length 8 | REAL(iwp),INTENT(OUT)::km(:,:) 9 | REAL(iwp)::one=1.0_iwp 10 | km(1,1)=one 11 | km(2,2)=one 12 | km(1,2)=-one 13 | km(2,1)=-one 14 | km=km*ea/length 15 | RETURN 16 | END SUBROUTINE rod_km 17 | -------------------------------------------------------------------------------- /library/main/rod_mm.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE rod_mm(mm,length) 2 | ! 3 | ! This subroutine forms the consistent mass matrix of a 1-d "rod" element. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | REAL(iwp),intent(in)::length 8 | REAL(iwp),intent(out)::mm(:,:) 9 | REAL(iwp)::one=1.0_iwp,d3=3.0_iwp,d6=6.0_iwp 10 | mm(1,1)=one/d3 11 | mm(1,2)=one/d6 12 | mm(2,1)=one/d6 13 | mm(2,2)=one/d3 14 | mm=mm*length 15 | RETURN 16 | END SUBROUTINE rod_mm 17 | -------------------------------------------------------------------------------- /library/main/solve_band.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE solve_band(pb,work,loads) 2 | ! 3 | ! This subroutine performs Gaussian forward and back-substitution 4 | ! on the reduced unsymmetric band matrix pb. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::pb(:,:),work(:,:) 9 | REAL(iwp),INTENT(OUT)::loads(0:) 10 | INTEGER::iwp1,n,n1,i,iv,l,iq,iv1 11 | REAL(iwp)::s,pt5=0.5_iwp 12 | iwp1=(UBOUND(pb,2)-1)/2+1 13 | n=UBOUND(pb,1) 14 | iq=2*iwp1-1 15 | n1=n-1 16 | DO iv=1,n1 17 | i=INT(work(iwp1,iv)+pt5) 18 | IF(i/=iv)THEN 19 | s=loads(iv) 20 | loads(iv)=loads(i) 21 | loads(i)=s 22 | END IF 23 | l=iv+iwp1-1 24 | IF(l>n)l=n 25 | iv1=iv+1 26 | DO i=iv1,l 27 | loads(i)=loads(i)-work(i-iv,iv)*loads(iv) 28 | END DO 29 | END DO 30 | loads(n)=loads(n)/pb(n,1) 31 | iv=n-1 32 | DO WHILE(iv/=0) 33 | s=loads(iv) 34 | l=iq 35 | IF(iv+l-1>n)l=n-iv+1 36 | DO i=2,l 37 | s=s-pb(iv,i)*loads(iv+i-1) 38 | loads(iv)=s/pb(iv,1) 39 | END DO 40 | iv=iv-1 41 | END DO 42 | RETURN 43 | END SUBROUTINE solve_band 44 | -------------------------------------------------------------------------------- /library/main/spabac.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE spabac(kv,loads,kdiag) 2 | ! 3 | ! This subroutine performs Cholesky forward and back-substitution 4 | ! on a symmetric skyline global matrix. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::kv(:) 9 | REAL(iwp),INTENT(IN OUT)::loads(0:) 10 | INTEGER,INTENT(IN)::kdiag(:) 11 | INTEGER::n,i,ki,l,m,j,it,k 12 | REAL(iwp)::x 13 | n=UBOUND(kdiag,1) 14 | loads(1)=loads(1)/kv(1) 15 | DO i=2,n 16 | ki=kdiag(i)-i 17 | l=kdiag(i-1)-ki+1 18 | x=loads(i) 19 | IF(l/=i)THEN 20 | m=i-1 21 | DO j=l,m 22 | x=x-kv(ki+j)*loads(j) 23 | END DO 24 | END IF 25 | loads(i)=x/kv(ki+i) 26 | END DO 27 | DO it=2,n 28 | i=n+2-it 29 | ki=kdiag(i)-i 30 | x=loads(i)/kv(ki+i) 31 | loads(i)=x 32 | l=kdiag(i-1)-ki+1 33 | IF(l/=i)THEN 34 | m=i-1 35 | DO k=l,m 36 | loads(k)=loads(k)-x*kv(ki+k) 37 | END DO 38 | END IF 39 | END DO 40 | loads(1)=loads(1)/kv(1) 41 | RETURN 42 | END SUBROUTINE spabac 43 | -------------------------------------------------------------------------------- /library/main/spabac.m: -------------------------------------------------------------------------------- 1 | function loads = spabac(kv,loads,kdiag) 2 | % This subroutine performs Cholesky forward and back-substitution 3 | % on a symmetric skyline global matrix. 4 | n=size(kdiag,1); 5 | loads(1)=loads(1)/kv(1); 6 | for i=2:n 7 | ki=kdiag(i)-i; 8 | l=kdiag(i-1)-ki+1 ; 9 | x=loads(i); 10 | if (l~=i) 11 | m=i-1; 12 | for j=l:m 13 | x=x-kv(ki+j)*loads(j); 14 | end 15 | end 16 | loads(i)=x/kv(ki+i); 17 | end 18 | for it=2:n 19 | i=n+2-it; 20 | ki=kdiag(i)-i; 21 | x=loads(i)/kv(ki+i); 22 | loads(i)=x; 23 | l=kdiag(i-1)-ki+1; 24 | if (l~=i) 25 | m=i-1; 26 | for k=l:m 27 | loads(k)=loads(k)-x*kv(ki+k); 28 | end 29 | end 30 | end 31 | loads(1)=loads(1)/kv(1); 32 | 33 | 34 | end 35 | 36 | -------------------------------------------------------------------------------- /library/main/spabac_gauss.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE spabac_gauss(kv,loads,kdiag) 2 | ! 3 | ! This subroutine performs Gaussian forwrad and back-substitution on a 4 | ! skyline matrix. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN)::kv(:) 9 | REAL(iwp),INTENT(IN OUT)::loads(0:) 10 | INTEGER,INTENT(IN)::kdiag(:) 11 | REAL(iwp)::num,den,fac,asum,zero=0.0_iwp 12 | INTEGER::i,j,l,n,ii,jj,l1,l2 13 | n=UBOUND(kdiag,1) 14 | DO j=1,n-1 15 | den=kv(kdiag(j)) 16 | ii=0 17 | DO i=j+1,n 18 | ii=ii+1 19 | l=kdiag(i)-ii 20 | IF(l-kdiag(i-1)>zero)THEN 21 | num=kv(l) 22 | fac=num/den 23 | loads(i)=loads(i)-fac*loads(j) 24 | END IF 25 | END DO 26 | END DO 27 | loads(n)=loads(n)/kv(kdiag(n)) 28 | DO i=n-1,1,-1 29 | jj=0 30 | asum=zero 31 | DO j=i+1,n 32 | jj=jj+1 33 | l1=kdiag(i+jj)-jj 34 | l2=kdiag(i+jj-1) 35 | IF(l1-l2>zero)asum=asum+kv(l1)*loads(j) 36 | END DO 37 | loads(i)=(loads(i)-asum)/kv(kdiag(i)) 38 | END DO 39 | RETURN 40 | END SUBROUTINE spabac_gauss 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /library/main/sparin.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE sparin(kv,kdiag) 2 | ! 3 | ! This subroutine performs Cholesky factorisation on a symmetric 4 | ! skyline global matrix. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | REAL(iwp),INTENT(IN OUT)::kv(:) 9 | INTEGER,INTENT(IN)::kdiag(:) 10 | INTEGER::n,i,ki,l,kj,j,ll,m,k 11 | REAL(iwp)::x 12 | n=UBOUND(kdiag,1) 13 | kv(1)=SQRT(kv(1)) 14 | DO i=2,n 15 | ki=kdiag(i)-i 16 | l=kdiag(i-1)-ki+1 17 | DO j=l,i 18 | x=kv(ki+j) 19 | kj=kdiag(j)-j 20 | IF(j/=1)THEN 21 | ll=kdiag(j-1)-kj+1 22 | ll=max(l,ll) 23 | IF(ll/=j)THEN 24 | m=j-1 25 | DO k=ll,m 26 | x=x-kv(ki+k)*kv(kj+k) 27 | END DO 28 | END IF 29 | END IF 30 | kv(ki+j)=x/kv(kj+j) 31 | END DO 32 | kv(ki+i)=SQRT(x) 33 | END DO 34 | RETURN 35 | END SUBROUTINE sparin 36 | -------------------------------------------------------------------------------- /library/main/sparin.m: -------------------------------------------------------------------------------- 1 | function kv = sparin( kv,kdiag ) 2 | % Cholesky factorisation on a symmetric skyline global matrix 3 | n=size(kdiag,1) ; 4 | kv(1)=sqrt(kv(1)); 5 | 6 | for i=2:n 7 | ki=kdiag(i)-i; 8 | l=kdiag(i-1)-ki+1; 9 | for j=l:i 10 | x=kv(ki+j); 11 | kj=kdiag(j)-j; 12 | if j~=1 13 | ll=kdiag(j-1)-kj+1; 14 | ll=max(l,ll); 15 | if (ll~=j) 16 | m=j-1; 17 | for k=ll:m 18 | x=x-kv(ki+k)*kv(kj+k) ; 19 | end 20 | end 21 | end 22 | kv(ki+j)=x/kv(kj+j); 23 | end 24 | kv(ki+i)=sqrt(x); 25 | end 26 | end 27 | 28 | -------------------------------------------------------------------------------- /library/main/sparin_gauss.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE sparin_gauss(kv,kdiag) 2 | ! 3 | ! This subroutine performs Gaussian factorisation of a skyline matrix. 4 | ! 5 | IMPLICIT NONE 6 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 7 | INTEGER,INTENT(IN)::kdiag(:) 8 | REAL(iwp),INTENT(OUT)::kv(:) 9 | REAL(iwp)::num,den,fac,zero=0.0_iwp 10 | INTEGER::n,ii,i,j,k,l,kk,l1,l2,l3 11 | n=UBOUND(kdiag,1) 12 | DO j=1,n-1 13 | den=kv(kdiag(j)) 14 | ii=0 15 | DO i=j+1,n 16 | ii=ii+1 17 | l=kdiag(i)-ii 18 | IF(l-kdiag(i-1)>zero)THEN 19 | num=kv(l) 20 | fac=num/den 21 | kk=-1 22 | DO k=i,n 23 | kk=kk+1 24 | l1=kdiag(i+kk)-kk 25 | l2=l1-ii 26 | l3=kdiag(i+kk-1) 27 | IF(l2-l3>zero)kv(l1)=kv(l1)-fac*kv(l2) 28 | END DO 29 | END IF 30 | END DO 31 | END DO 32 | RETURN 33 | END SUBROUTINE sparin_gauss 34 | -------------------------------------------------------------------------------- /library/main/stability.f03: -------------------------------------------------------------------------------- 1 | SUBROUTINE stability(kv,gv,kdiag,tol,limit,iters,evec,eval) 2 | ! 3 | ! This subroutine computes the smallest eigenvalue in a beam 4 | ! stability analysis. 5 | ! 6 | IMPLICIT NONE 7 | INTEGER,PARAMETER::iwp=SELECTED_REAL_KIND(15) 8 | INTEGER,INTENT(IN)::limit,kdiag(:) 9 | INTEGER,INTENT(OUT)::iters 10 | INTEGER::neq 11 | REAL(iwp),INTENT(IN OUT)::kv(:),gv(:),tol,eval 12 | REAL(iwp),INTENT(OUT)::evec(:) 13 | REAL(iwp)::big,zero=0.0_iwp,one=1.0_iwp 14 | LOGICAL::converged 15 | REAL(iwp),ALLOCATABLE::x0(:),x1(:) 16 | neq=UBOUND(kdiag,1) 17 | ALLOCATE(x0(0:neq),x1(0:neq)) 18 | CALL sparin(kv,kdiag) 19 | iters=0 20 | x0=zero 21 | x0(1)=1.0_iwp 22 | DO 23 | iters=iters+1 24 | CALL linmul_sky(gv,x0,x1,kdiag) 25 | CALL spabac(kv,x1,kdiag) 26 | big=MAXVAL(x1(1:)) 27 | IF(ABS(MINVAL(x1(1:)))>big)big=MINVAL(x1(1:)) 28 | x1=x1/big 29 | converged=(MAXVAL(ABS(x1(1:)-x0(1:)))/MAXVAL(ABS(x1(1:)))