43
44
45
46
47#include "implicit_f.inc"
48
49
50
51#include "mvsiz_p.inc"
52
53
54
55 INTEGER IGAP, IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),ISTF
56 INTEGER, INTENT(IN) :: LAST
57
59 . gap, gapmin, gapmax,drad
60 my_real ,
INTENT(IN) :: dgapload
62 . x(3,*), stf(*), stfn(*), gapv(*), gap_s(*), gap_m(*),
63 . gap_s_l(*), gap_m_l(*)
64 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
65 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: x1,x2,x3,x4
66 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: y1,y2,y3,y4
67 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: z1,z2,z3,z4
68 my_real,
DIMENSION(MVSIZ),
INTENT(OUT) :: xi,yi,zi
69 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: stif
70
71
72
73 INTEGER I, IL, L, NN, IG
74
75
76
77 DO i=1,last
78 ig = nsv(cand_n(i))
79 nsvg(i) = ig
80 xi(i) = x(1,ig)
81 yi(i) = x(2,ig)
82 zi(i) = x(3,ig)
83 ENDDO
84
85 IF(igap==0)THEN
86 DO i=1,last
87 gapv(i) =
max(gap+dgapload,drad)
88 ENDDO
89 ELSE
90 DO i=1,last
91 gapv(i) = gap_s(cand_n(i))+gap_m(cand_e(i))
92 IF(igap == 3)
93 . gapv(i)=
min(gap_s_l(cand_n(i))+gap_m_l(cand_e(i)),gapv(i))
94 gapv(i) =
min(gapmax,gapv(i))
95 gapv(i) =
max(gapmin,gapv(i))
96
97 gapv(i) =
max(drad,gapv(i)+dgapload)
98 ENDDO
99 ENDIF
100
101 IF(istf/=0)THEN
102 DO i=1,last
103 stif(i)=stf(cand_e(i))*stfn(cand_n(i))
104 ENDDO
105 ENDIF
106
107 DO i=1,last
108
109 l = cand_e(i)
110
111 ix1(i)=irect(1,l)
112 ix2(i)=irect(2,l)
113 ix3(i)=irect(3,l)
114 ix4(i)=irect(4,l)
115
116 ENDDO
117
118 DO i=1,last
119
120 nn=ix1(i)
121 x1(i)=x(1,nn)
122 y1(i)=x(2,nn)
123 z1(i)=x(3,nn)
124
125 nn=ix2(i)
126 x2(i)=x(1,nn)
127 y2(i)=x(2,nn)
128 z2(i)=x(3,nn)
129
130 nn=ix3(i)
131 x3(i)=x(1,nn)
132 y3(i)=x(2,nn)
133 z3(i)=x(3,nn)
134
135 nn=ix4(i)
136 x4(i)=x(1,nn)
137 y4(i)=x(2,nn)
138 z4(i)=x(3,nn)
139
140 ENDDO
141
142 RETURN