gpamela/gpfield/gufld.F

*
* $Id$
*
* $Log$
*
*CMZ :  2.01/00 06/03/2000  13.07.03  by  Francesco Cafagna
*CMZ :  2.00/00 03/03/2000  15.39.05  by  Francesco Cafagna
*CMZU:  1.01/00 26/04/96  15.12.30  by  Paolo (The Magic) Papini
*-- Author :
      SUBROUTINE GUFLD(V,F)
************************************************************************
*                                                                      *
* To map Pamela magnetic field                                         *
* A bit of housekeeping: delete print statement etc. etc., by F. Caf.  *
*                                                                      *
* Variables definition:                                                *
* IN:                                                                  *
*  V , vector with coordinates in MARS                                 *
* OUT:                                                                 *
*  F , Magnetic field components along X, Y and Z                      *
*                                                                      *
* Called by: GHELIX, GRKUTA                                            *
* Author: Paolo Papini   16/02/96                                      *
*                                                                      *
************************************************************************
#include "gpfield.inc"
*
      INTEGER II,III
      REAL DISM,F0X,F0Y,F0Z,F1X,F1Y,F1Z,F2X,F2Y,F2Z,
     +     F3X,F3Y,F3Z
      REAL V(3),F(3),AV(3)
*
* Transform coordinates to Spectrometer frame
*
      CALL GPMASPE(V)
*
* Take just the absolute value for the coordinates
*
      DO I=1,3
         AV(I) = ABS( V(I) )
      ENDDO
      F(1)=0.
      F(2)=0.
      F(3)=0.
*
* Check if we are outside the map
*
      IF( (AV(1).GE.20).OR.(AV(2).GE.20).OR.(AV(3).GE.60.) )
     +    GOTO 10
      IV(1)=INT(AV(1)*2.)+1
      IV(2)=INT(AV(2)*2.)+1
      IV(3)=INT(AV(3)/2.)+1
      DO I1=0,1
         DO I2=0,1
            DO I3=0,1
               II=I1*4+I2*2+I3+1
               VV(II,1)=FLOAT(IV(1)+I1-1)*0.5
               VV(II,2)=FLOAT(IV(2)+I2-1)*0.5
               VV(II,3)=FLOAT(IV(3)+I3-1)*2.
               IVV(II,1)=IV(1)+I1
               IVV(II,2)=IV(2)+I2
               IVV(II,3)=IV(3)+I3
               DD(II)=(VV(II,1)-AV(1))**2 + (VV(II,2)-AV(2))**2 +
     +         (VV(II,3)-AV(3))**2
            ENDDO
         ENDDO
      ENDDO
* --- v0
      DISM=1.E9
      II=0
      DO I=1,8
         IF(DD(I).LT.DISM) THEN
            DISM=DD(I)
            II=I
         END IF
      END DO
      DO I=1,3
         V0(I)=VV(II,I)
      END DO
      F0X=FX(IVV(II,1),IVV(II,2),IVV(II,3))
      F0Y=FY(IVV(II,1),IVV(II,2),IVV(II,3))
      F0Z=FZ(IVV(II,1),IVV(II,2),IVV(II,3))
* --- v1
      V1(2)=V0(2)
      V1(3)=V0(3)
      IF(AV(1).GE.V0(1)) THEN
         III=IVV(II,1)+1
         V1(1)=V0(1)+0.5
      ELSE
         III=IVV(II,1)-1
         V1(1)=V0(1)-0.5
      END IF
      F1X=FX(III,IVV(II,2),IVV(II,3))
      F1Y=FY(III,IVV(II,2),IVV(II,3))
      F1Z=FZ(III,IVV(II,2),IVV(II,3))
* --- v2
      V2(1)=V0(1)
      V2(3)=V0(3)
      IF(AV(2).GE.V0(2)) THEN
         III=IVV(II,2)+1
         V2(2)=V0(2)+0.5
      ELSE
         III=IVV(II,2)-1
         V2(2)=V0(2)-0.5
      END IF
      F2X=FX(IVV(II,1),III,IVV(II,3))
      F2Y=FY(IVV(II,1),III,IVV(II,3))
      F2Z=FZ(IVV(II,1),III,IVV(II,3))
* --- v3
      V3(1)=V0(1)
      V3(2)=V0(2)
      IF(AV(3).GE.V0(3)) THEN
         III=IVV(II,3)+1
         V3(3)=V0(3)+2.
      ELSE
         III=IVV(II,3)-1
         V3(3)=V0(3)-2.
      END IF
      F3X=FX(IVV(II,1),IVV(II,2),III)
      F3Y=FY(IVV(II,1),IVV(II,2),III)
      F3Z=FZ(IVV(II,1),IVV(II,2),III)
* --- linear interpolation, magnetic field calculation
      CALL FLIN3(V0,V1,V2,V3,F0X,F1X,F2X,F3X,AV,F(1))
      CALL FLIN3(V0,V1,V2,V3,F0Y,F1Y,F2Y,F3Y,AV,F(2))
      CALL FLIN3(V0,V1,V2,V3,F0Z,F1Z,F2Z,F3Z,AV,F(3))
* --- mirroing
      IF(V(2).LT.0.) THEN
         F(1)=-1.*F(1)
         F(3)=-1.*F(3)
      END IF
      IF(V(1).LT.0.) F(1)=-1.*F(1)
      IF(V(3).LT.0.) F(3)=-1.*F(3)
*
* Transform coordinates back to MARS
*
   10 CALL GPSPEMA(V)
      RETURN
      END
1	cafagna	3.1	*
2			* $Id$
3			*
4			* $Log$
5			*
6			*CMZ : 2.01/00 06/03/2000 13.07.03 by Francesco Cafagna
7			*CMZ : 2.00/00 03/03/2000 15.39.05 by Francesco Cafagna
8			*CMZU: 1.01/00 26/04/96 15.12.30 by Paolo (The Magic) Papini
9			*-- Author :
10			SUBROUTINE GUFLD(V,F)
11			************************************************************************
12			* *
13			* To map Pamela magnetic field *
14			* A bit of housekeeping: delete print statement etc. etc., by F. Caf. *
15			* *
16			* Variables definition: *
17			* IN: *
18			* V , vector with coordinates in MARS *
19			* OUT: *
20			* F , Magnetic field components along X, Y and Z *
21			* *
22			* Called by: GHELIX, GRKUTA *
23			* Author: Paolo Papini 16/02/96 *
24			* *
25			************************************************************************
26			#include "gpfield.inc"
27			*
28			INTEGER II,III
29			REAL DISM,F0X,F0Y,F0Z,F1X,F1Y,F1Z,F2X,F2Y,F2Z,
30			+ F3X,F3Y,F3Z
31			REAL V(3),F(3),AV(3)
32			*
33			* Transform coordinates to Spectrometer frame
34			*
35			CALL GPMASPE(V)
36			*
37			* Take just the absolute value for the coordinates
38			*
39			DO I=1,3
40			AV(I) = ABS( V(I) )
41			ENDDO
42			F(1)=0.
43			F(2)=0.
44			F(3)=0.
45			*
46			* Check if we are outside the map
47			*
48			IF( (AV(1).GE.20).OR.(AV(2).GE.20).OR.(AV(3).GE.60.) )
49			+ GOTO 10
50			IV(1)=INT(AV(1)*2.)+1
51			IV(2)=INT(AV(2)*2.)+1
52			IV(3)=INT(AV(3)/2.)+1
53			DO I1=0,1
54			DO I2=0,1
55			DO I3=0,1
56			II=I14+I22+I3+1
57			VV(II,1)=FLOAT(IV(1)+I1-1)*0.5
58			VV(II,2)=FLOAT(IV(2)+I2-1)*0.5
59			VV(II,3)=FLOAT(IV(3)+I3-1)*2.
60			IVV(II,1)=IV(1)+I1
61			IVV(II,2)=IV(2)+I2
62			IVV(II,3)=IV(3)+I3
63			DD(II)=(VV(II,1)-AV(1))2 + (VV(II,2)-AV(2))2 +
64			+ (VV(II,3)-AV(3))**2
65			ENDDO
66			ENDDO
67			ENDDO
68			* --- v0
69			DISM=1.E9
70			II=0
71			DO I=1,8
72			IF(DD(I).LT.DISM) THEN
73			DISM=DD(I)
74			II=I
75			END IF
76			END DO
77			DO I=1,3
78			V0(I)=VV(II,I)
79			END DO
80			F0X=FX(IVV(II,1),IVV(II,2),IVV(II,3))
81			F0Y=FY(IVV(II,1),IVV(II,2),IVV(II,3))
82			F0Z=FZ(IVV(II,1),IVV(II,2),IVV(II,3))
83			* --- v1
84			V1(2)=V0(2)
85			V1(3)=V0(3)
86			IF(AV(1).GE.V0(1)) THEN
87			III=IVV(II,1)+1
88			V1(1)=V0(1)+0.5
89			ELSE
90			III=IVV(II,1)-1
91			V1(1)=V0(1)-0.5
92			END IF
93			F1X=FX(III,IVV(II,2),IVV(II,3))
94			F1Y=FY(III,IVV(II,2),IVV(II,3))
95			F1Z=FZ(III,IVV(II,2),IVV(II,3))
96			* --- v2
97			V2(1)=V0(1)
98			V2(3)=V0(3)
99			IF(AV(2).GE.V0(2)) THEN
100			III=IVV(II,2)+1
101			V2(2)=V0(2)+0.5
102			ELSE
103			III=IVV(II,2)-1
104			V2(2)=V0(2)-0.5
105			END IF
106			F2X=FX(IVV(II,1),III,IVV(II,3))
107			F2Y=FY(IVV(II,1),III,IVV(II,3))
108			F2Z=FZ(IVV(II,1),III,IVV(II,3))
109			* --- v3
110			V3(1)=V0(1)
111			V3(2)=V0(2)
112			IF(AV(3).GE.V0(3)) THEN
113			III=IVV(II,3)+1
114			V3(3)=V0(3)+2.
115			ELSE
116			III=IVV(II,3)-1
117			V3(3)=V0(3)-2.
118			END IF
119			F3X=FX(IVV(II,1),IVV(II,2),III)
120			F3Y=FY(IVV(II,1),IVV(II,2),III)
121			F3Z=FZ(IVV(II,1),IVV(II,2),III)
122			* --- linear interpolation, magnetic field calculation
123			CALL FLIN3(V0,V1,V2,V3,F0X,F1X,F2X,F3X,AV,F(1))
124			CALL FLIN3(V0,V1,V2,V3,F0Y,F1Y,F2Y,F3Y,AV,F(2))
125			CALL FLIN3(V0,V1,V2,V3,F0Z,F1Z,F2Z,F3Z,AV,F(3))
126			* --- mirroing
127			IF(V(2).LT.0.) THEN
128			F(1)=-1.*F(1)
129			F(3)=-1.*F(3)
130			END IF
131			IF(V(1).LT.0.) F(1)=-1.*F(1)
132			IF(V(3).LT.0.) F(3)=-1.*F(3)
133			*
134			* Transform coordinates back to MARS
135			*
136			10 CALL GPSPEMA(V)
137			RETURN
138			END