--- DarthVader/OrbitalInfo/src/igrf_sub.for 2014/01/16 15:29:26 1.8 +++ DarthVader/OrbitalInfo/src/igrf_sub.for 2014/08/29 07:06:41 1.10 @@ -55,8 +55,6 @@ C C SUBROUTINE FINDB0(STPS,BDEL,VALUE,BEQU,RR0) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) C-------------------------------------------------------------------- C FINDS SMALLEST MAGNETIC FIELD STRENGTH ON FIELD LINE C @@ -72,7 +70,6 @@ C RR0 EQUATORIAL RADIUS NORMALIZED TO EARTH RADIUS C BDEL FINAL ACHIEVED ACCURACY C-------------------------------------------------------------------- - REAL(8) P DIMENSION P(8,4),SP(3) LOGICAL VALUE COMMON/FIDB0/ SP @@ -157,8 +154,6 @@ C C SUBROUTINE SHELLG(GLAT,GLON,ALT,DIMO,FL,ICODE,B0) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) C-------------------------------------------------------------------- C CALCULATES L-VALUE FOR SPECIFIED GEODAETIC COORDINATES, ALTITUDE C AND GEMAGNETIC FIELD MODEL. @@ -195,13 +190,11 @@ C APPROXIMATION IS USED. C B0 MAGNETIC FIELD STRENGTH IN GAUSS C----------------------------------------------------------------------- - REAL(8) AQUAD,BQUAD,ERA - REAL(8) CT,ST,D,ALT,X,RQ,P,U,STEP DIMENSION V(3),U(3,3),P(8,100),SP(3) COMMON X(3),H(196) COMMON/FIDB0/ SP SAVE /FIDB0/ - COMMON/GENER/ ERA,AQUAD,BQUAD,UMR + COMMON/GENER/ UMR,ERA,AQUAD,BQUAD SAVE /GENER/ C C-- RMIN, RMAX ARE BOUNDARIES FOR IDENTIFICATION OF ICODE=2 AND 3 @@ -356,8 +349,8 @@ C-- Correct dipole moment is used here. D. Bilitza, Nov 87. C DIMOB0=DIMO/B0 - arg1=dlog(FI) - arg2=dlog(DIMOB0) + arg1=alog(FI) + arg2=alog(DIMOB0) c arg = FI*FI*FI/DIMOB0 c if(abs(arg).gt.88.0) arg=88.0 XX=3*arg1-arg2 @@ -385,7 +378,7 @@ 1E-3)*XX+1.2038224E-1)*XX-1.8461796E-1)*XX+2.0007187E0 GOTO777 776 GG=XX-3.0460681E0 - 777 FL=EXP(dLOG((1.+EXP(GG))*DIMOB0)/3.0) + 777 FL=EXP(ALOG((1.+EXP(GG))*DIMOB0)/3.0) RETURN C*****APPROXIMATION FOR HIGH VALUES OF L. 30 ICODE=3 @@ -396,14 +389,10 @@ C C SUBROUTINE STOER(P,BQ,R) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) - C******************************************************************* C* SUBROUTINE USED FOR FIELD LINE TRACING IN SHELLG * C* CALLS ENTRY POINT FELDI IN GEOMAGNETIC FIELD SUBROUTINE FELDG * C******************************************************************* - REAL(8) P,ZM,FLI,WR,XM,R,YM,XI,DR DIMENSION P(7),U(3,3) COMMON XI(3),H(196) C*****XM,YM,ZM ARE GEOMAGNETIC CARTESIAN INVERSE CO-ORDINATES @@ -445,8 +434,6 @@ C C SUBROUTINE FELDG(GLAT,GLON,ALT,BNORTH,BEAST,BDOWN,BABS) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) C------------------------------------------------------------------- C CALCULATES EARTH MAGNETIC FIELD FROM SPHERICAL HARMONICS MODEL C REF: G. KLUGE, EUROPEAN SPACE OPERATIONS CENTRE, INTERNAL NOTE 61, @@ -489,18 +476,14 @@ C POINTING IN THE TANGENTIAL PLANE TO THE NORTH, EAST C AND DOWNWARD. C----------------------------------------------------------------------- - REAL(8) G,H,X,Z,F,S,T,XI,Y,XXX,BXXX,BYYY,BZZZ,B - REAL(8) YYY,ZZZ,BABS,BEAST,BRHO,BNORTH,BDOWN,ST,CT,CP,SP - REAL(8) ERA, AQUAD, BQUAD,ALT,RHO,RQ,D DIMENSION V(3),B(3),G(196) CHARACTER*258 NAME INTEGER NMAX REAL TIME COMMON XI(3),H(196) - COMMON/MODEL/ G,NMAX,TIME,NAME SAVE/MODEL/ - COMMON/GENER/ ERA,AQUAD,BQUAD,UMR + COMMON/GENER/ UMR,ERA,AQUAD,BQUAD SAVE/GENER/ C C-- IS RECORDS ENTRY POINT @@ -583,8 +566,6 @@ C C SUBROUTINE FELDCOF(YEAR,DIMO) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) C------------------------------------------------------------------------ C DETERMINES COEFFICIENTS AND DIPOL MOMENT FROM IGRF MODELS C @@ -601,21 +582,17 @@ CHARACTER*258 FILMOD C ### FILMOD, DTEMOD arrays +1 c DIMENSION GH1(144),GH2(120),GHA(144),FILMOD(14),DTEMOD(14) - REAL(8) GH1, GH2, GHA DIMENSION GH1(196),GH2(196),GHA(196),FILMOD(3),DTEMOD(3) DOUBLE PRECISION X,F0,F - DOUBLE PRECISION DIMO INTEGER L1,L2,L3 INTEGER NMAX - REAL YEAR REAL TIME CHARACTER *258 P1,P2,P3 - REAL(8) AQUAD,BQUAD,ERAD COMMON/PPATH/ L1,L2,L3,P1, P2, P3 SAVE/PPATH/ COMMON/MODEL/ GH1,NMAX,TIME,FIL1 SAVE/MODEL/ - COMMON/GENER/ ERAD,AQUAD,BQUAD,UMR + COMMON/GENER/ UMR,ERAD,AQUAD,BQUAD SAVE/GENER/ C ### updated to 2005 C CHARACTER COEFPATH*80, COEF1*80, COEF2*80, COEF3*80 @@ -700,7 +677,7 @@ F = GHA(J) * 1.D-5 F0 = F0 + F * F 1234 CONTINUE - DIMO = DSQRT(F0) + DIMO = REAL(DSQRT(F0)) GH1(1) = 0.0 I=2 @@ -716,13 +693,13 @@ IF(IS.EQ.0) F0 = F0 * (2.D0 * X - 1.D0) / X F = F0 * 0.5D0 IF(IS.EQ.0) F = F * SQRT2 - GH1(I) = GHA(I-1) * F0 + GH1(I) = GHA(I-1) * REAL(F0) I = I+1 DO 9 M=1,N F = F * (X + M) / (X - M + 1.D0) IF(IS.EQ.0) F = F * DSQRT((X - M + 1.D0) / (X + M)) - GH1(I) = GHA(I-1) * F - GH1(I+1) = GHA(I) * F + GH1(I) = GHA(I-1) * REAL(F) + GH1(I+1) = GHA(I) * REAL(F) I=I+2 9 CONTINUE RETURN @@ -730,8 +707,7 @@ C C SUBROUTINE GETSHC (IU, FSPEC, NMAX, ERAD, GH, IER) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) + C =============================================================== C C Version 1.01 @@ -760,7 +736,6 @@ C =============================================================== CHARACTER FSPEC*(*), FOUT*258 - REAL(8) GH,ERAD DIMENSION GH(*) C --------------------------------------------------------------- C Open coefficient file. Read past first header record. @@ -824,9 +799,7 @@ C SUBROUTINE INTERSHC (DATE, DTE1, NMAX1, GH1, DTE2, 1 NMAX2, GH2, NMAX, GH) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) - REAL DATE + C =============================================================== C C Version 1.01 @@ -854,7 +827,6 @@ C C =============================================================== - REAL(8) GH1, GH2, GH DIMENSION GH1(*), GH2(*), GH(*) C --------------------------------------------------------------- @@ -894,9 +866,6 @@ C SUBROUTINE EXTRASHC (DATE, DTE1, NMAX1, GH1, NMAX2, 1 GH2, NMAX, GH) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) - REAL DATE C =============================================================== C @@ -925,7 +894,6 @@ C C =============================================================== - REAL(8) GH1, GH2, GH DIMENSION GH1(*), GH2(*), GH(*) C --------------------------------------------------------------- @@ -964,8 +932,6 @@ C C SUBROUTINE INITIZE(TP1,TL1,TP2,TL2,TP3,TL3) - IMPLICIT REAL(8)(A-H) - IMPLICIT REAL(8)(O-Z) C---------------------------------------------------------------- C Initializes the parameters in COMMON/GENER/ C @@ -981,15 +947,13 @@ C ASTRONOMICAL UNION . C----------------------------------------------------------------- INTEGER TL1,TL2,TL3 - CHARACTER (len=258) TP1,TP2,TP3 + CHARACTER (len=*) :: TP1,TP2,TP3 INTEGER L1,L2,L3 CHARACTER *258 P1,P2,P3 - REAL(8) AQUAD,BQUAD,ERA - COMMON/PPATH/ L1,L2,L3,P1, P2, P3 SAVE/PPATH/ - COMMON/GENER/ERA,AQUAD,BQUAD,UMR + COMMON/GENER/UMR,ERA,AQUAD,BQUAD SAVE/GENER/ L1 = TL1