| 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=I1*4+I2*2+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 |