1!$Id:$ 2 subroutine pblendm(isd,blend,ndm,nen1,prt,prth,eflag,nflag) 3 4! * * F E A P * * A Finite Element Analysis Program 5 6!.... Copyright (c) 1984-2017: Regents of the University of California 7! All rights reserved 8 9!-----[--.----+----.----+----.-----------------------------------------] 10 11! Purpose: Construct interpolation using blending functions 12 13! Inputs: 14! isd - Dimension for sides array 15! blend - Dimension for blending array 16! ndm - Spatial dimension of mesh 17! nen1 - Dimension of ix array 18! prt - Print control 19! prth - Print header control 20! eflag - Element generation flag 21! nflag - Nodal generation flag 22 23! Outputs stored by pointer for: 24! x(ndm,*) - Nodal coordinates for blended patch 25! ix(nen1,*)- Element connections 26 27!-----[--.----+----.----+----.-----------------------------------------] 28 29 implicit none 30 31 include 'cblend.h' 32 include 'cdata.h' 33 include 'iofile.h' 34 include 'p_int.h' 35 include 'pointer.h' 36 include 'region.h' 37 include 'comblk.h' 38 39 logical prt,prth,eflag,nflag, setvar,palloc 40 integer n,n1,isd,blend,ndm,nen1 41 integer iside(4),tblend(21) 42 43 save 44 45 do n = 1,numbd 46 47! Pointer to transformtion and surface type 48 49 fp(1) = np(164) + blend*(n-1) - 1 50 51! Surface generations 52 53 do n1 = 1,blend 54 tblend(n1) = mr(fp(1)+n1) 55 end do 56 57 netyp = tblend(21) 58 59! Surface generations 60 61 if(tblend(19).eq.1) then 62 63 if(np(162).eq.0) then 64 setvar = palloc(162,'BSIDE',2,1) 65 endif 66 call pblend2a(tblend,iside,isd) 67 fp(1) = np(166) + mxilr*(n-1) 68 fp(2) = np(163) + 12*(n-1) 69 call pblend2b(n,hr(np(161)),mr(np(162)),hr(fp(2)),tblend, 70 & mr(fp(1)),hr(np(43)),mr(np(33)), 71 & iside,isd,ndm,nen1,prt,prth,eflag,nflag) 72 73! Solid generations 74 75 elseif(tblend(19).eq.2) then 76 77 fp(1) = np(166) + mxilr*(n-1) 78 fp(2) = np(163) + 12*(n-1) 79 call pblend3(n,hr(fp(2)),tblend,mr(fp(1)),isd,ndm,nen1, 80 & prt,prth,eflag,nflag) 81 82! Line generations 83 84 elseif(tblend(19).eq.3) then 85 86 if(np(162).eq.0) then 87 setvar = palloc(162,'BSIDE',2,1) 88 endif 89 call pblend1a(mr(np(162)),tblend,iside,isd) 90 fp(1) = np(166) + mxilr*(n-1) 91 fp(2) = np(163) + 12*(n-1) 92 call pblend1b(hr(np(161)),mr(np(162)),hr(fp(2)),tblend, 93 & mr(fp(1)),hr(np(43)),mr(np(33)), 94 & iside(1),isd,ndm,nen1,prt,prth,eflag,nflag) 95 endif 96 97 end do ! n 98 99 end 100