/[PAMELA software]/gpamela/gptrd/gptrdv.F
ViewVC logotype

Annotation of /gpamela/gptrd/gptrdv.F

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3.2 - (hide annotations) (download)
Tue Jun 21 02:42:34 2005 UTC (19 years, 5 months ago) by cafagna
Branch: MAIN
CVS Tags: v4r4, v4r5, v4r6, v4r7, v4r2, v4r3, v4r8, v4r9, v4r14, v4r12, v4r13, v4r10, v4r11, HEAD
Changes since 3.1: +317 -52 lines
Major modification to the geometry and to the random number chain

1 cafagna 3.1 *
2 cafagna 3.2 * $Id: gptrdv.F,v 3.1.1.1 2002/07/11 16:02:01 cafagna Exp $
3     *
4     * $Log: gptrdv.F,v $
5     * Revision 3.1.1.1 2002/07/11 16:02:01 cafagna
6     * First GPAMELA release on CVS
7 cafagna 3.1 *
8     *
9     *CMZ : 2.01/00 05/04/2000 14.35.18 by Marialuigia Ambriola
10     *CMZ : 2.00/00 03/03/2000 15.39.05 by Francesco Cafagna
11     *CMZ : 1.02/00 09/02/2000 13.11.57 by Francesco Cafagna
12     *CMZ : 1.00/02 15/03/96 16.04.21 by Francesco Cafagna
13     *-- Author : Francesco Cafagna 05/12/95
14     SUBROUTINE GPTRDV
15     ************************************************************************
16     * *
17     * Volume definition for TRD *
18     * Called by: GPGEO *
19     * Author: Francesco Cafagna, 05/12/95 17.25.32 *
20     * *
21     ************************************************************************
22     #include "gpgeo.inc"
23     #include "gpmed.inc"
24     *
25     INTEGER IROT,IVOLU,N,NMED,NUM,NAN
26     REAL X,Y,Z
27     *
28     * Define the TRDB volume
29     *
30     NMED=MN2
31     CALL GSVOLU('TRDB','BOX ',NMED,TRDB, 3,IVOLU)
32     *
33     * Define the TRAN volume
34     *
35     NMED=MAL
36     CALL GSVOLU('TRAN','BOX ',NMED,TRAN, 3,IVOLU)
37     *
38     * Define the TRAI volume
39     *
40     NMED=MN2
41     CALL GSVOLU('TRAI','BOX ',NMED,TRAI, 3,IVOLU)
42     *
43     * Define the TRBS volumes
44     *
45     NMED=MN2
46     CALL GSVOLU('TRBS','BOX ',NMED,TRBS, 3,IVOLU)
47 cafagna 3.2 *ml: 10/11/66:
48     *
49     * Define the TRAL volumes
50     *
51     NMED=MAL
52     CALL GSVOLU('TRAL','BOX ',NMED,TRAL, 3,IVOLU)
53     *end ml.
54 cafagna 3.1 *
55     * Define the TRSO volumes
56     *
57     NMED=MKAP
58     CALL GSVOLU('TRSO','TUBE',NMED,TRSO, 3,IVOLU)
59     *
60     * Define the TRSI volumes
61     *
62     NMED=MXE
63     CALL GSVOLU('TRSI','TUBE',NMED,TRSI, 3,IVOLU)
64     *
65     * Define the TRRA volumes
66     *
67     NMED=MTRAD
68     CALL GSVOLU('TRRA','BOX ',NMED,TRRA, 3,IVOLU)
69 cafagna 3.2 c ml: 11/11/04:
70     *
71     * Define the TRR2 volumes
72     *
73     NMED=MTRAD
74     CALL GSVOLU('TRR2','BOX ',NMED,TRR2, 3,IVOLU)
75     *
76     * Define the TRR0 volumes
77     *
78     NMED=MCF
79     CALL GSVOLU('TRR0','BOX ',NMED,TRR0, 3,IVOLU)
80     *
81     * Define the TRI0 volumes
82     *
83     NMED=MN2
84     CALL GSVOLU('TRI0','BOX ',NMED,TRI0, 3,IVOLU)
85     *
86     * Define the TRRF volumes
87     *
88     NMED=MMAG
89     CALL GSVOLU('TRRF','BOX ',NMED,TRRF, 3,IVOLU)
90     *
91     * Define the TRRI volumes
92     *
93     NMED=MN2
94     CALL GSVOLU('TRRI','BOX ',NMED,TRRI, 3,IVOLU)
95     c end ml.
96 cafagna 3.1 *
97     * Define the TRFR volumes
98     *
99     NMED=MCF
100     CALL GSVOLU('TRFR','BOX ',NMED,TRFR, 3,IVOLU)
101 cafagna 3.2 c ml: 12/11/04:
102     c*
103     c* Define the TRFI volumes
104     c*
105     c NMED=MN2
106     c CALL GSVOLU('TRFI','BOX ',NMED,TRFI, 3,IVOLU)
107     *
108     * Define the TRFD volumes
109     *
110     NMED=MCF
111     CALL GSVOLU('TRFD','BOX ',NMED,TRFD, 3,IVOLU)
112 cafagna 3.1 *
113 cafagna 3.2 * Define the TRFU volumes
114 cafagna 3.1 *
115 cafagna 3.2 NMED=MCF
116     CALL GSVOLU('TRFU','BOX ',NMED,TRFU, 3,IVOLU)
117     *
118     * Define the TRFM volumes
119     *
120     NMED=MCF
121     CALL GSVOLU('TRFM','BOX ',NMED,TRFM, 3,IVOLU)
122     *
123     * Define the TRFL volumes
124     *
125     NMED=MCF
126     CALL GSVOLU('TRFL','BOX ',NMED,TRFL, 3,IVOLU)
127     c end ml.
128 cafagna 3.1 *
129     * Define the TRDT volumes
130     *
131     NMED=MAL
132     CALL GSVOLU('TRDT','BOX ',NMED,TRDT, 3,IVOLU)
133 cafagna 3.2 *ml: 10/11/04:
134     *
135     * Positioning the volumes TRAL into mothers TRBS
136     *
137     X=0.
138     Z=0.
139     DO I=1,2
140     Y=(-1)**I*(TRBS(2)-TRAL(2))
141     C # print*,'gptrdv.F: tral: y=',y
142     CALL GSPOS('TRAL',I,'TRBS',X,Y,Z,0,'ONLY')
143     ENDDO
144     *end ml.
145    
146 cafagna 3.1 *
147     * Positioning volumes TRSI into mothers TRSO
148     *
149     N= 1
150     X= 0.
151     Y= 0.
152     Z= 0.
153     * CALL GSPOS('TRSI',N,'TRSO',X,Y,Z,0,'ONLY')
154     *Positioning volumes TRSO into mothers TRSI, because now TRSO is included in
155     *TRSI and TRSI is included in TRBS
156     CALL GSPOS('TRSO',N,'TRSI',X,Y,Z,0,'ONLY')
157     *
158     *
159     * Positioning volumes TRSO into mothers TRBS. Remember we have to put
160     * tubes one over each other
161     *
162     Y=0.
163     NUM = 0
164     DO II=1,2
165     #if defined(GPAMELA_UNIX)
166     Z= TRSO(2) * COS(30./180.*ACOS(-1.)) * (-1)**II
167     #endif
168     #if !defined(GPAMELA_UNIX)
169     Z= TRSO(2) * COSD(30.) * (-1)**II
170     #endif
171     DO I=1, 16
172     NUM = NUM + 1
173     X= -TRBS(1) + II*TRSO(2) + (I-1)*2.*TRSO(2)
174     * CALL GSPOS('TRSO',NUM,'TRBS',X,Y,Z,2,'ONLY')
175     *now TRSI is into TRBS (I don't change TRSO(2) in TRSI(2) because they
176     *are equal and the velue of X does not change:
177     CALL GSPOS('TRSI',NUM,'TRBS',X,Y,Z,2,'ONLY')
178     ENDDO
179     ENDDO
180 cafagna 3.2 c ml: 11/11/04:
181     C*
182     C* Positioning volumes TRFI into mothers TRFR
183     C*
184     C N= 1
185     C X= 0.
186     C Y= 0.
187     C Z= 0.
188     C CALL GSPOS('TRFI',N,'TRFR',X,Y,Z,0,'ONLY')
189 cafagna 3.1 *
190 cafagna 3.2 * Positioning volume TRI0 into mother TRR0
191     *
192     N= 1
193     X= 0.
194     Y= 0.
195     c Z= 0.
196     c CALL GSPOS('TRI0',N,'TRR0',X,Y,Z,0,'ONLY')
197     ZTRI0=TRR0(3)-TRI0(3)
198     CALL GSPOS('TRI0',N,'TRR0',X,Y,ZTRI0,0,'MANY')
199     *
200     * Positioning volume TRRI into mother TRRF
201 cafagna 3.1 *
202     N= 1
203     X= 0.
204     Y= 0.
205     Z= 0.
206 cafagna 3.2 CALL GSPOS('TRRI',N,'TRRF',X,Y,Z,0,'ONLY')
207     *
208     * Positioning volume TRRF into mother TRR0
209     *
210     N= 1
211     X= 0.
212     Y= 0.
213     C Z= 0.
214     Z=-TRR0(3)+TRRF(3)
215     CALL GSPOS('TRRF',N,'TRR0',X,Y,Z,0,'ONLY')
216     c end ml.
217 cafagna 3.1 *
218     * Positioning volumes TRAI into mothers TRAN
219     *
220 cafagna 3.2 c ml: 17/11/04:
221 cafagna 3.1 N= 1
222 cafagna 3.2 c X= 0.
223     c Y= TRAN(2)-TRAI(2)
224     X=0.8
225     Y=0.8
226 cafagna 3.1 Z= 0.
227     CALL GSPOS('TRAI',N,'TRAN',X,Y,Z,0,'ONLY')
228 cafagna 3.2 *end ml.
229 cafagna 3.1 *
230     * Positioning volumes TRAI, TRFR, TRBS&TRRA into the mother TRDB
231     *
232     NAN = 0
233 cafagna 3.2 c ml: 12/11/04:
234     c positioning TRRO (frame 0 del TRD)
235     X=0.
236     Y=0.
237     c Z= -TRDB(3) + TRAN(3)
238     Z= -TRDB(3) + TRR0(3)
239     C CALL GSPOS('TRR0',1,'TRDB',X,Y,Z,0,'ONLY')
240     CALL GSPOS('TRR0',1,'TRDB',X,Y,Z,0,'MANY')
241     C Z=Z+TRR0(3)
242     Z=Z+TRR0(3)-0.1
243     M=3
244     num=0
245     DO I=1,4
246     C # print*,'z,ztrfu=',z,ztrfu
247     Z=Z+TRAN(3)
248     ZTRBS=Z
249     c positioning TRAN:
250     c ml:17/11/04:
251     c DO III = 1,2
252     c X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
253     c Y = -TRAN(2)+ TRDB(2)
254     c NAN = NAN + 1
255     c CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
256     c Y = +TRAN(2)- TRDB(2)
257     c NAN = NAN + 1
258     c CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
259     c ENDDO
260     X = -TRFR(1)+TRAN(1)
261     Y = -TRFR(2)+ TRAN(2)
262 cafagna 3.1 NAN = NAN + 1
263     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
264 cafagna 3.2 X = -TRFR(1)+TRAN(1)
265     Y = +TRFR(2)- TRAN(2)
266     NAN = NAN + 1
267     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,6,'ONLY')
268     X = TRFR(1)-TRAN(1)
269     Y = +TRFR(2)- TRAN(2)
270 cafagna 3.1 NAN = NAN + 1
271     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
272 cafagna 3.2 X = TRFR(1)-TRAN(1)
273     Y = -TRFR(2)+ TRAN(2)
274     NAN = NAN + 1
275     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,1,'ONLY')
276     Z= Z + TRAN(3)
277     c positioning TRBS (the modules):
278     Y=0.
279 cafagna 3.1 DO II=1, M
280     NUM = NUM + 1
281 cafagna 3.2 * shift of modules to have the right overlap:
282 cafagna 3.1 X= (II-1)*2.*TRBS(1) - ( M*TRBS(1) - TRBS(1) ) -
283     + (II-2)*TRSI(2)
284 cafagna 3.2 * now there two different volumes interested at same time:
285     * CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'ONLY')
286     CALL GSPOS('TRBS',NUM,'TRDB',X,Y,ZTRBS,0,'MANY')
287 cafagna 3.1 ENDDO
288 cafagna 3.2 c end ml.
289     c positioning TRFD:
290     X=0.
291     ZTRFD=Z-TRFD(3)
292     CALL GSPOS('TRFD',I,'TRDB',X,Y,ZTRFD,0,'MANY')
293     C # print*,'gptrdv: n. of trfd: i=',i
294     c positioning TRFR:
295     Z= Z + TRFR(3)
296     ZRAD=Z
297     CALL GSPOS('TRFR',I,'TRDB',X,Y,Z,0,'MANY')
298     C Z= Z + TRFR(3) + TRBS(3)
299     Z=Z+TRFR(3)
300     c positioning TRFU:
301     ZTRFU= Z + TRFU(3)
302     CALL GSPOS('TRFU',I,'TRDB',X,Y,ZTRFU,0,'MANY')
303     X = 0.
304     Y = 0.
305     cc Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
306     cc print*,'z del radiatore=',z
307     C # print*,'cos(1+....)=',1 + COS(30./180.*ACOS(-1.))
308     C # Z= Z + 2*TRSO(2) + TRRA(3)
309     c CALL GSPOS('TRRA',I,'TRDB',X,Y,Z,0,'ONLY')
310     CALL GSPOS('TRRA',I,'TRDB',X,Y,ZRAD,0,'ONLY')
311     C # Z= Z - (2*TRSO(2) + TRRA(3)) + TRBS(3)
312     CC Z = Z - ( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3))
313     CC + + TRBS(3)
314     cc GOTO 151
315     cc DO III = 1,2
316     cc X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
317     cc Y = -TRAN(2)+ TRDB(2)
318     cc NAN = NAN + 1
319     cc CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
320     cc Y = TRAN(2) - TRDB(2)
321     cc NAN = NAN + 1
322     cc CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
323     cc ENDDO
324     cc X = 0.
325     cc Y = 0.
326     cc Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
327     C # Z= Z + 2*TRSO(2) + TRRA(3)
328     cc CALL GSPOS('TRRA',I,'TRDB',X,Y,Z,0,'ONLY')
329     C # Z= Z - (2*TRSO(2) + TRRA(3)) + TRBS(3)
330     cc Z = Z - ( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3))
331     cc + + TRBS(3)
332     ENDDO
333     M=4
334     DO I=1,5
335     Z=Z+TRAN(3)
336     ZTRBS=Z
337     c positioning TRAN:
338     c ml:17/11/04:
339     c DO III = 1,2
340     c X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
341     c Y = -TRAN(2)+ TRDB(2)
342     c NAN = NAN + 1
343     c CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
344     c Y = +TRAN(2)- TRDB(2)
345     c NAN = NAN + 1
346     c CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
347     c ENDDO
348     X = -TRFR(1)+TRAN(1)
349     Y = -TRFR(2)+ TRAN(2)
350 cafagna 3.1 NAN = NAN + 1
351     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
352 cafagna 3.2 X = -TRFR(1)+TRAN(1)
353     Y = +TRFR(2)- TRAN(2)
354     NAN = NAN + 1
355     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,6,'ONLY')
356     X = TRFR(1)-TRAN(1)
357     Y = +TRFR(2)- TRAN(2)
358 cafagna 3.1 NAN = NAN + 1
359     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
360 cafagna 3.2 X = TRFR(1)-TRAN(1)
361     Y = -TRFR(2)+ TRAN(2)
362     NAN = NAN + 1
363     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,1,'ONLY')
364     Z=Z+TRAN(3)
365     c positioning TRBS (the modules):
366     Y=0.
367     DO II=1, M
368     NUM = NUM + 1
369     * shift of modules to have the right overlap:
370     X= (II-1)*2.*TRBS(1) - ( M*TRBS(1) - TRBS(1) ) -
371     + (II-2)*TRSI(2)
372     * now there two different volumes interested at same time:
373     * CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'ONLY')
374     CALL GSPOS('TRBS',NUM,'TRDB',X,Y,ZTRBS,0,'MANY')
375     ENDDO
376     c end ml.
377     c IF((I+4).LE.8)THEN
378     c positioning TRFD:
379     X=0.
380     ZTRFD=Z-TRFD(3)
381     CALL GSPOS('TRFD',I+4,'TRDB',X,Y,ZTRFD,0,'MANY')
382     C # print*,'gptrdv: n. of trfd: i+4=',i+4,ztrfd
383     IF((I+4).LE.8)THEN
384     c positioning TRFR:
385     Z= Z + TRFR(3)
386     ZRAD=Z
387     CALL GSPOS('TRFR',I+4,'TRDB',X,Y,Z,0,'MANY')
388     C Z= Z + TRFR(3) + TRBS(3)
389     Z=Z+TRFR(3)
390     c positioning TRFU:
391     ZTRFU= Z + TRFU(3)
392     CALL GSPOS('TRFU',I+4,'TRDB',X,Y,ZTRFU,0,'MANY')
393     ELSE
394     ZRAD=Z-TRFD(3)+TRFM(3)+TRFL(3)
395     c positioning TRFD:
396     c X=0.
397     c ZTRFD=Z-TRFD(3)
398     c CALL GSPOS('TRFD',I+4,'TRDB',X,Y,ZTRFD,0,'MANY')
399     c print*,'gptrdv: n. of trfd: i+4=',i+4,ztrfd
400     c positioning TRFM:
401     Z= Z + TRFM(3)
402     C ZRAD=Z
403     CALL GSPOS('TRFM',I+4,'TRDB',X,Y,Z,0,'MANY')
404     C Z= Z + TRFR(3) + TRBS(3)
405     Z=Z+TRFM(3)
406     c positioning TRFL:
407     ZTRFL= Z + TRFL(3)
408     CALL GSPOS('TRFL',I+4,'TRDB',X,Y,ZTRFL,0,'MANY')
409     ENDIF
410 cafagna 3.1 X = 0.
411     Y = 0.
412 cafagna 3.2 cc Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
413     cc print*,'z del radiatore=',z
414     C # print*,'cos(1+....)=',1 + COS(30./180.*ACOS(-1.))
415     C # Z= Z + 2*TRSO(2) + TRRA(3)
416     c CALL GSPOS('TRRA',I,'TRDB',X,Y,Z,0,'ONLY')
417     IF((I+4).LE.8) THEN
418     CALL GSPOS('TRRA',I+4,'TRDB',X,Y,ZRAD,0,'ONLY')
419     ELSE
420     CALL GSPOS('TRR2',I+4,'TRDB',X,Y,ZRAD,0,'ONLY')
421     ENDIF
422 cafagna 3.1 ENDDO
423 cafagna 3.2 goto 151
424 cafagna 3.1 M=4
425     DO I=1,5
426     X= 0.
427     Z= Z + TRFR(3)
428     CALL GSPOS('TRFR',(I+4),'TRDB',X,Y,Z,0,'ONLY')
429     Z= Z + TRFR(3) + TRBS(3)
430     DO II=1, M
431     NUM = NUM + 1
432     *shift of modules to have the right overlap:
433     X= (II-1)*2.*TRBS(1) - ( M*TRBS(1) - TRBS(1) )
434     + + (3/2 -(II-1))*TRSI(2)
435     *now there two different volumes interested at same time:
436     * CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'ONLY')
437     CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'MANY')
438     ENDDO
439     DO III = 1,2
440     X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
441     Y = -TRAN(2)+ TRDB(2)
442     NAN = NAN + 1
443     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
444     Y = TRAN(2) - TRDB(2)
445     NAN = NAN + 1
446     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
447     ENDDO
448     X= 0.
449     Y= 0.
450 cafagna 3.2 c ml: 12/11/04:
451     IF((I+4).LE.8) THEN
452     c end ml.
453     Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
454     CALL GSPOS('TRRA',(I+4),'TRDB',X,Y,Z,0,'ONLY')
455     Z = Z - (TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3) )
456     + + TRBS(3)
457     c ml:
458     ELSE
459 cafagna 3.1 *
460     * Positioning an extra radiator plane on top
461     *
462 cafagna 3.2 Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRR2(3)
463     NUM=1
464     CALL GSPOS('TRR2',NUM,'TRDB',X,Y,Z,0,'ONLY')
465     Z = Z + TRBS(3) -( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.)))
466     + + 3*TRR2(3) )
467     ENDIF
468     C end ml.
469     ENDDO
470     c ml: 12/11/04:
471     C*
472     C* Positioning an extra radiator plane on top
473     C*
474     C Z = Z - TRBS(3) + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.)))
475     C + + 3*TRRA(3)
476     C CALL GSPOS('TRRA',NUM,'TRDB',X,Y,Z,0,'ONLY')
477     C Z = Z + TRBS(3) -( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.)))
478     C + + 3*TRRA(3) )
479     C end ml.
480 cafagna 3.1 *
481     * Positioning the TOP frame
482     *
483     X = 0.
484     Y = 0.
485     Z = Z + TRFR(3)
486     CALL GSPOS('TRFR',10,'TRDB',X,Y,Z,0,'ONLY')
487     *
488     * Positioning the angular pieces to hold the TOF. TRAN & TRDT
489     *
490     Z = Z + TRFR(3) + TRAN(3)
491     DO I = 1,2
492     X = (-1)**(I-1)*TRAN(1)+ (-1)**I*TRDB(1)
493     Y = -TRAN(2)+ TRDB(2)
494     NAN = NAN + 1
495     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
496     Y = +TRAN(2)- TRDB(2)
497     NAN = NAN + 1
498     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
499     ENDDO
500     Z = Z + TRAN(3) + TRDT(3)
501     NDT = 0
502     DO I = 1,2
503     X = (-1)**(I-1)*(2*TRAN(1)-TRDT(1))+ (-1)**I*TRDB(1)
504     Y = -(2*TRAN(2)-TRDT(2)) + TRDB(2)
505     NDT = NDT + 1
506     CALL GSPOS('TRDT',NDT,'TRDB',X,Y,Z,0,'ONLY')
507     Y = +(2*TRAN(2)-TRDT(2)) - TRDB(2)
508     NDT = NDT + 1
509     CALL GSPOS('TRDT',NDT,'TRDB',X,Y,Z,0,'ONLY')
510     ENDDO
511 cafagna 3.2 151 continue
512 cafagna 3.1 RETURN
513     END

  ViewVC Help
Powered by ViewVC 1.1.23