41
42
43
44 USE elbufdef_mod
46
47
48
49#include "implicit_f.inc"
50
51
52
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "vect01_c.inc"
56#include "param_c.inc"
57#include "task_c.inc"
58
59
60
61 INTEGER IXS(NIXS,NUMELS), IXQ(NIXQ,NUMELQ)
62 my_real x(3,numnod),grad(*), veul(*)
63 INTEGER IPARG(NPARG,NGROUP),ITASK
64 TYPE (ELBUF_STRUCT_), DIMENSION (NGROUP), TARGET :: ELBUF_STR
65 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
66
67
68
69 INTEGER NG,NEL
70 TYPE(G_BUFEL_) ,POINTER :: GBUF
71
72
73
74 DO ng=itask+1,ngroup,nthread
75 gbuf => elbuf_str(ng)%GBUF
76 jtur=iparg(12,ng)
77 jthe=iparg(13,ng)
78 ity =iparg(5,ng)
79 IF((jtur == 1 .OR. jthe == 1) .AND. ity /= 51 .AND. iparg(8,ng) /= 1) THEN
80 mtn=iparg(1,ng)
81 jale=iparg(7,ng)
82 jeul=iparg(11,ng)
83 jlag=iparg(14,ng)
84 llt=iparg(2,ng)
85 nft=iparg(3,ng)
86 lft=1
87 nel = llt
88 IF(n2d == 0)THEN
89 IF(jale+jlag /= 0)THEN
90 CALL agrad3(ixs,x,ale_connect,grad(6*nft+1))
91 ELSEIF(jeul == 1)THEN
92 CALL egrad3(ixs,x,ale_connect,grad(6*nft+1),veul)
93 ELSE
94 CALL tgrad3(gbuf%SIG,grad(6*nft+1),nel)
95 ENDIF
96 ELSE
97 IF(jlag+jale /= 0)THEN
98 CALL agrad2(ixq,x,ale_connect,grad(4*nft+1))
99 ELSEIF(jeul == 1)THEN
100 CALL egrad2(ixq,x,ale_connect,grad(4*nft+1))
101 ELSE
102 CALL tgrad2(gbuf%SIG,grad(4*nft+1),nel)
103 ENDIF
104 ENDIF
105 ENDIF
106 enddo
107
109
110 RETURN
subroutine egrad2(ixq, x, ale_connect, grad)
subroutine egrad3(ixs, x, ale_connect, grad, veul)
subroutine agrad2(ixq, x, ale_connectivity, grad, nel)
subroutine agrad3(ixs, x, ale_connectivity, grad, nel)
subroutine tgrad2(grd, grad, nel)
subroutine tgrad3(grd, grad, nel)