c c -------------------------------------------------------------------- c SUBROUTINE Mead_Tsyganenko(xGEO,Kp,BGEO) REAL*8 xGEO(3),xDMAG(3) c REAL*8 Kp REAL*8 BGEO(3), BMAG(3) REAL*8 rMAG, thetaMAG, Lmc, phiMAG REAL*8 Bsph(3), Bval, lati, longi real*8 density,speed,dst_nt,Pdyn_nPa,BxIMF_nt,ByIMF_nt,BzIMF_nt real*8 G1_tsy01,G2_tsy01,fkp,G3_tsy01,W1_tsy04,W2_tsy04 real*8 W3_tsy04,W4_tsy04,W5_tsy04,W6_tsy04,Al COMMON /drivers/density,speed,dst_nt,Pdyn_nPa,BxIMF_nt,ByIMF_nt & ,BzIMF_nt,G1_tsy01,G2_tsy01,fkp,G3_tsy01,W1_tsy04,W2_tsy04 & ,W3_tsy04,W4_tsy04,W5_tsy04,W6_tsy04,Al CALL GEO_DMAG(xGEO,xDMAG) rMAG = sqrt(xDMAG(1)**2+xDMAG(2)**2+xDMAG(3)**2) thetaMAG = acos(xDMAG(3)/rMAG) phiMAG = acos(xDMAG(1)/sqrt(xDMAG(1)**2+xDMAG(2)**2)) C Approx pour se placer a peut pret au niveau de l'equateur magnetique de la ligne de champ consideree... C Car S et A calcules dans equateur magnetique. C A VOIR CE QUE CA VAUT... (idee de Daniel) Lmc = rMAG/sin(thetaMAG)/sin(thetaMAG) CALL get_Mead_Tsyganenko_coeffs(Lmc,fKp,S,A) Bsph(1) = -S*cos(thetaMAG) - A*rMAG*sin(2.*thetaMAG)*cos(phiMAG) Bsph(2) = S*sin(thetaMAG) - A*rMAG*cos(2.*thetaMAG)*cos(phiMAG) Bsph(3) = A*rMAG*cos(thetaMAG)*sin(phiMAG) Bval = sqrt(Bsph(1)**2+Bsph(2)**2+Bsph(3)**2) lati = (3.1416/2-thetaMAG) * 180./3.1416 longi = phiMAG * 180./3.1416 CALL SPH2CAR(Bval,lati,longi,BMAG) CALL MAG_GEO(BMAG,BGEO) end C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C SUBROUTINE get_Mead_Tsyganenko_coeffs(Lmc,Kp,S,A) REAL*8 S, A, Lmc, Kp REAL*8 tab_Rmag(29) REAL*8 tab_S(29,7) REAL*8 tab_A(29,7) INTEGER*4 iKp, pente, cste DATA tab_Rmag/ * 1.0000, 1.2500, 1.5000, 1.7500, 2.0000, 2.2500, 2.5000, * 2.7500, 3.0000, 3.2500, 3.5000, 3.7500, 4.0000, 4.2500, * 4.5000, 4.7500, 5.0000, 5.2500, 5.5000, 5.7500, 6.0000, * 6.2500, 6.5000, 6.7500, 7.0000, 7.2500, 7.5000, 7.7500, * 8.0000 * / DATA tab_S/ * 30.770000, 30.239000, 29.604000, 28.872000, 28.050000, * 27.147000, 26.174000, 25.139000, 24.052000, 22.922000, * 21.759000, 20.571000, 19.3660001, 8.151000, 16.935000, * 15.722000, 14.518000, 13.329000, 12.157000, 11.006000, * 9.880200, 8.780500, 7.709100, 6.667200, 5.655900, * 4.675700, 3.726900, 2.809700, 1.923900, * * 38.796000, 38.160000, 37.396000, 36.512000, 35.519000, * 34.424000, 33.240000, 31.977000, 30.646000, 29.259000, * 27.825000, 26.357000, 24.864000, 23.355000, 21.839000, * 20.324000, 18.817000, 17.325000, 15.853000, 14.405000, * 12.986000, 11.598000, 10.245000, 8.927500, 7.648300, * 6.408000, 5.207300, 4.046500, 2.925500, * * 48.179000, 47.503000, 46.684000, 45.727000, 44.637000, * 43.422000, 42.091000, 40.655000, 39.124000, 37.510000, * 35.826000, 34.085000, 32.300000, 30.481000, 28.642000, * 26.793000, 24.944000, 23.105000, 21.284000, 19.487000, * 17.721000, 15.991000, 14.302000, 12.657000, 11.059000, * 9.509900, 8.010800, 6.562800, 5.166300, * * 56.082000, 55.465000, 54.707000, 53.806000, 52.763000, * 51.580000, 50.260000, 48.810000, 47.239000, 45.555000, * 43.770000, 41.897000, 39.948000, 37.937000, 35.877000, * 33.782000, 31.665000, 29.536000, 27.408000, 25.291000, * 23.193000, 21.123000, 19.087000, 17.092000, 15.143000, * 13.244000, 11.398000, 9.606700, 7.873400, * * 75.411000, 74.561000, 73.510000, 72.258000, 70.805000, * 69.152000, 67.307000, 65.278000, 63.079000, 60.725000, * 58.233000, 55.624000, 52.918000, 50.137000, 47.300000, * 44.429000, 41.543000, 38.659000, 35.793000, 32.960000, * 30.172000, 27.440000, 24.773000, 22.179000, 19.662000, * 17.228000, 14.879000, 12.618000, 10.445000, * * 100.230000, 98.928000, 97.326000, 95.420000, 93.213000, * 90.713000, 87.932000, 84.891000, 81.612000, 78.126000, * 74.462000, 70.657000, 66.744000, 62.759000, 58.735000, * 54.704000, 50.695000, 46.734000, 42.845000, 39.045000, * 35.351000, 31.776000, 28.329000, 25.018000, 21.848000, * 18.819000, 15.934000, 13.192000, 10.590000, * * 150.990000, 148.600000, 145.700000, 142.310000, 138.440000, * 134.140000, 129.440000, 124.390000, 119.040000, 113.440000, * 107.640000, 101.720000, 95.719000, 89.694000, 83.693000, * 77.762000, 71.940000, 66.259000, 60.748000, 55.429000, * 50.320000, 45.432000, 40.773000, 36.349000, 32.160000, * 28.204000, 24.478000, 20.977000, 17.693000 * / DATA tab_A/ * -3.192900, -3.183100, -3.171000, -3.156400, -3.139400, * -3.119900, -3.098000, -3.073800, -3.047300, -3.018800, * -2.988400, -2.956300, -2.922700, -2.887800, -2.851900, * -2.815100, -2.777700, -2.739700, -2.701500, -2.663000, * -2.624500, -2.586100, -2.547900, -2.509800, -2.472100, * -2.434800, -2.397900, -2.361400, -2.325500, * * -5.455500, -5.375700, -5.282400, -5.178000, -5.064600, * -4.944500, -4.819800, -4.692400, -4.564200, -4.436500, * -4.310700, -4.187700, -4.068300, -3.953200, -3.842700, * -3.737000, -3.636300, -3.540600, -3.449800, -3.363800, * -3.282300, -3.205100, -3.132100, -3.062900, -2.997300, * -2.935000, -2.875800, -2.819500, -2.765800, * * -8.840200, -8.648900, -8.425600, -8.175900, -7.905400, * -7.619700, -7.324300, -7.024100, -6.723700, -6.427100, * -6.137400, -5.857200, -5.588800, -5.333400, -5.092000, * -4.865300, -4.653300, -4.455900, -4.272800, -4.103400, * -3.947100, -3.803000, -3.670400, -3.548300, -3.436100, * -3.332800, -3.237800, -3.150100, -3.069200, * * -12.010000, -11.744000, -11.432000, -11.081000, -10.699000, * -10.292000, -9.869000, -9.436200, -9.000300, -8.567100, * -8.141500, -7.727700, -7.329100, -6.948400, -6.587200, * -6.247000, -5.928200, -5.631200, -5.355600, -5.101000, * -4.866600, -4.651300, -4.454200, -4.274100, -4.109700, * -3.960000, -3.823600, -3.699600, -3.586800, * * -15.798000, -15.390000, -14.912000, -14.375000, -13.791000, * -13.170000, -12.526000, -11.869000, -11.210000, -10.558000, * -9.920700, -9.305300, -8.716700, -8.159000, -7.635000, * -7.146400, -6.693700, -6.277100, -5.895800, -5.548600, * -5.234000, -4.950000, -4.694600, -4.465900, -4.261500, * -4.079500, -3.917800, -3.774300, -3.647300, * * -20.581000, -19.951000, -19.215000, -18.389000, -17.492000, * -16.544000, -15.564000, -14.570000, -13.578000, -12.604000, * -11.660000, -10.756000, -9.900300, -9.098000, -8.352900, * -7.666800, -7.040100, -6.471800, -5.959800, -5.501600, * -5.093900, -4.733100, -4.415600, -4.137500, -3.895100, * -3.684900, -3.503300, -3.347300, -3.213900, * * -24.524000, -23.657000, -22.649000, -21.528000, -20.319000, * -19.053000, -17.756000, -16.452000, -15.164000, -13.912000, * -12.710000, -11.571000, -10.504000, -9.514600, -8.605700, * -7.778000, -7.030500, -6.360600, -5.764500, -5.237600, * -4.774900, -4.371300, -4.021200, -3.719400, -3.460800, * -3.240600, -3.054200, -2.897600, -2.766900 * / write(6,*) tab_A(20,2) read(5,*) iKp=1 if (Kp.ge.1) iKp=2 if (Kp.ge.2) iKp=3 if (Kp.ge.3) iKp=4 if (Kp.ge.4) iKp=5 if (Kp.ge.5) iKp=6 if (Kp.ge.6) iKp=7 do i = 2,29 if (tab_rMAG(i).ge. Lmc) goto 10 enddo 10 CONTINUE if (i.gt.29) i=29 pente = (tab_S(i,iKp)-tab_S(i-1,iKp)) * /(tab_rMAG(i)-tab_rMAG(i-1)) cste = tab_S(i,iKp) - pente*tab_rMAG(i) S = pente*Lmc + cste pente = (tab_A(i,iKp)-tab_A(i-1,iKp)) * /(tab_rMAG(i)-tab_rMAG(i-1)) cste = tab_A(i,iKp) - pente*tab_rMAG(i) A = pente*Lmc + cste RETURN end C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C