41 use element_mod , only : nixs,nixc,nixtg,nixt,nixp
42
43
44
45#include "implicit_f.inc"
46
47
48
49#include "param_c.inc"
50#include "units_c.inc"
51
52
53
54 INTEGER FXBELM(*), NELS, NELC, NELTG, IPARG(NPARG,*), NML,
55 . NSN, IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), NFX, IFILE,
56 . LVSIG, NSNI, NME, IRCS, IRCM0, NELT, NELP, IXT(NIXT,*),
57 . IXP(NIXP,*)
58 INTEGER, INTENT (IN ) :: IBEAM_VECTOR(NELP)
60 . fxbsig(*), x(3,*), pm(npropm,*), fxbmod(*),
61 . geo(npropg,*), fxbrpm(*)
62 my_real,
INTENT (IN ) :: rbeam_vector(3,nelp)
63
64
65
66 INTEGER I,II,IM,IADMOD,IADEL,IADSIG, IADM, IADS, IRCM, IAD, J
68 . rini(3,3), vmod(nsn*6), vsig(lvsig), vv(6)
69
70 ircm=ircm0
71 ircm=ircm+nme*(nsn-nsni)
72
73 DO i=1,3
74 DO ii=1,3
75 rini(i,ii)=fxbrpm(1+(i-1)*3+ii)
76 ENDDO
77 ENDDO
78
79 iadsig=1
80 DO im=1,nml
81 IF (ifile==0) THEN
82 iadmod=nsn*6*(im-1)+1
83 DO i=1,nsn*6
84 vmod(i)=fxbmod(iadmod+i-1)
85 ENDDO
86 ELSEIF (ifile==1) THEN
87 iadmod=nsni*6*(im-1)+1
88 DO i=1,nsni*6
89 vmod(i)=fxbmod(iadmod+i-1)
90 ENDDO
91 iadm=nsni*6
92 DO i=1,nsn-nsni
93 ircm=ircm+1
94 READ(ifxm,rec=ircm) (vv(ii),ii=1,6)
95 DO ii=1,6
96 vmod(iadm+ii)=vv(ii)
97 ENDDO
98 iadm=iadm+6
99 ENDDO
100 ENDIF
101
102 iadel=1
103 iads=1
105 . fxbelm(iadel), iparg, x, pm, ixs,
106 . geo, vmod, vsig(iads), rini, nels)
107
108 iadel=iadel+nels*13
109 iads=iads+nels*7
111 . fxbelm(iadel), iparg, x, pm, ixc,
112 . geo, vmod, vsig(iads), rini, nelc)
113
114 iadel=iadel+nelc*10
115 iads=iads+nelc*10
117 . fxbelm(iadel), iparg, x, pm, ixt,
118 . geo, vmod, vsig(iads),nelt)
119
120 iadel=iadel+nelt*7
121 iads=iads+nelt*2
123 . fxbelm(iadel), iparg, x, pm, ixp,
124 . geo, vmod, vsig(iads), rini, nelp,
125 . ibeam_vector ,rbeam_vector)
126
127 iadel=iadel+nelp*9
128 iads=iads+nelp*8
130 . fxbelm(iadel), iparg, x, pm, ixtg,
131 . geo, vmod, vsig(iads), rini, neltg)
132 IF (ifile==0) THEN
133 DO i=1,lvsig
134 fxbsig(iadsig+i-1)=vsig(i)
135 ENDDO
136 ELSE
137 iad=0
138 DO i=1,lvsig/6
139 ircs=ircs+1
140 WRITE(ifxs,rec=ircs) (vsig(iad+j),j=1,6)
141 iad=iad+6
142 ENDDO
143 ii=lvsig-(lvsig/6)*6
144 IF (ii/=0) THEN
145 ircs=ircs+1
146 WRITE(ifxs,rec=ircs) (vsig(iad+j),j=1,ii),(zero,j=ii+1,6)
147 ENDIF
148 ENDIF
149 iadsig=iadsig+nels*7+nelc*10+nelt*2+nelp*8+neltg*10
150 ENDDO
151
152 RETURN
subroutine fsigcini(fxbelm, iparg, x, pm, ixc, geo, fxbmod, fxbsig, r, nelc)
subroutine fsigpini(fxbelm, iparg, x, pm, ixp, geo, fxbmod, fxbsig, r, nelp, ibeam_vector, rbeam_vector)
subroutine fsigsini(fxbelm, iparg, x, pm, ixs, geo, fxbmod, fxbsig, r, nels)
subroutine fsigtini(fxbelm, iparg, x, pm, ixtg, geo, fxbmod, fxbsig, r, neltg)
subroutine fsigtrini(fxbelm, iparg, x, pm, ixt, geo, fxbmod, fxbsig, nelt)