/[PAMELA software]/DarthVader/OrbitalInfo/src/igrf_sub.for
ViewVC logotype

Diff of /DarthVader/OrbitalInfo/src/igrf_sub.for

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by mocchiut, Tue Aug 11 12:58:22 2009 UTC revision 1.7 by mocchiut, Tue May 15 15:00:51 2012 UTC
# Line 191  C                          APPROXIMATION Line 191  C                          APPROXIMATION
191  C          B0           MAGNETIC FIELD STRENGTH IN GAUSS  C          B0           MAGNETIC FIELD STRENGTH IN GAUSS
192  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
193        DIMENSION         V(3),U(3,3),P(8,100),SP(3)        DIMENSION         V(3),U(3,3),P(8,100),SP(3)
194        COMMON            X(3),H(144)        COMMON            X(3),H(196)
195        COMMON/FIDB0/     SP        COMMON/FIDB0/     SP
196        SAVE /FIDB0/        SAVE /FIDB0/
197        COMMON/GENER/     UMR,ERA,AQUAD,BQUAD        COMMON/GENER/     UMR,ERA,AQUAD,BQUAD
# Line 394  C* SUBROUTINE USED FOR FIELD LINE TRACIN Line 394  C* SUBROUTINE USED FOR FIELD LINE TRACIN
394  C* CALLS ENTRY POINT FELDI IN GEOMAGNETIC FIELD SUBROUTINE FELDG   *  C* CALLS ENTRY POINT FELDI IN GEOMAGNETIC FIELD SUBROUTINE FELDG   *
395  C*******************************************************************  C*******************************************************************
396        DIMENSION         P(7),U(3,3)        DIMENSION         P(7),U(3,3)
397        COMMON            XI(3),H(144)        COMMON            XI(3),H(196)
398  C*****XM,YM,ZM  ARE GEOMAGNETIC CARTESIAN INVERSE CO-ORDINATES            C*****XM,YM,ZM  ARE GEOMAGNETIC CARTESIAN INVERSE CO-ORDINATES          
399        ZM=P(3)                                                                  ZM=P(3)                                                          
400        FLI=P(1)*P(1)+P(2)*P(2)+1E-15        FLI=P(1)*P(1)+P(2)*P(2)+1E-15
# Line 476  C                 TO THE LOCAL GEODETIC Line 476  C                 TO THE LOCAL GEODETIC
476  C                 POINTING IN THE TANGENTIAL PLANE TO THE NORTH, EAST  C                 POINTING IN THE TANGENTIAL PLANE TO THE NORTH, EAST
477  C                 AND DOWNWARD.    C                 AND DOWNWARD.  
478  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
479        DIMENSION         V(3),B(3),G(144)        DIMENSION         V(3),B(3),G(196)
480        CHARACTER*258      NAME        CHARACTER*258      NAME
481        INTEGER NMAX        INTEGER NMAX
482        REAL TIME        REAL TIME
483        COMMON            XI(3),H(144)        COMMON            XI(3),H(196)
484        COMMON/MODEL/     G,NMAX,TIME,NAME        COMMON/MODEL/     G,NMAX,TIME,NAME
485        SAVE/MODEL/        SAVE/MODEL/
486        COMMON/GENER/     UMR,ERA,AQUAD,BQUAD        COMMON/GENER/     UMR,ERA,AQUAD,BQUAD
# Line 581  C--------------------------------------- Line 581  C---------------------------------------
581        CHARACTER*258    FIL1, FIL2                  CHARACTER*258    FIL1, FIL2          
582        CHARACTER*258    FILMOD        CHARACTER*258    FILMOD
583  C     ### FILMOD, DTEMOD arrays +1  C     ### FILMOD, DTEMOD arrays +1
584  c     DIMENSION       GH1(144),GH2(120),GHA(144),FILMOD(14),DTEMOD(14)  c     DIMENSION       GH1(144),GH2(120),GHA(144),FILMOD(14),DTEMOD(14)
585        DIMENSION       GH1(144),GH2(120),GHA(144),FILMOD(3),DTEMOD(3)        DIMENSION       GH1(196),GH2(196),GHA(196),FILMOD(3),DTEMOD(3)
586        DOUBLE PRECISION X,F0,F        DOUBLE PRECISION X,F0,F
587        INTEGER L1,L2,L3        INTEGER L1,L2,L3
588        INTEGER NMAX        INTEGER NMAX
# Line 615  c      print *, "qua" Line 615  c      print *, "qua"
615  c     FILMOD(1) = 'OrbitalInfo/src/dgrf00.dat'  c     FILMOD(1) = 'OrbitalInfo/src/dgrf00.dat'
616  c     FILMOD(2) = 'OrbitalInfo/src/igrf05.dat'  c     FILMOD(2) = 'OrbitalInfo/src/igrf05.dat'
617  c     FILMOD(3) = 'OrbitalInfo/src/igrf05s.dat'  c     FILMOD(3) = 'OrbitalInfo/src/igrf05s.dat'
618  c     WRITE(*,*) FILMOD(1)  c      WRITE(*,*) FILMOD(1)
619  c     WRITE(*,*) FILMOD(2)  c      WRITE(*,*) FILMOD(2)
620  c     WRITE(*,*) FILMOD(3)  c      WRITE(*,*) FILMOD(3)
621  c      DATA   FILMOD / 'dgrf00.dat', 'igrf05.dat', 'igrf05s.dat'/  c      DATA   FILMOD / 'dgrf00.dat', 'igrf05.dat', 'igrf05s.dat'/
622        DATA   DTEMOD / 2000., 2005., 2010./        DATA   DTEMOD / 2005., 2010., 2015./
623  c      c    
624  c     DATA            FILMOD /'dgrf45.dat', 'dgrf50.dat',              c     DATA            FILMOD /'dgrf45.dat', 'dgrf50.dat',            
625  c     1                  'dgrf55.dat', 'dgrf60.dat', 'dgrf65.dat',        c     1                  'dgrf55.dat', 'dgrf60.dat', 'dgrf65.dat',      
# Line 652  c     L = (IYEA - 1945)/5 + 1 Line 652  c     L = (IYEA - 1945)/5 + 1
652        FIL1 = FILMOD(L)          FIL1 = FILMOD(L)  
653        DTE2 = DTEMOD(L+1)        DTE2 = DTEMOD(L+1)
654        FIL2 = FILMOD(L+1)        FIL2 = FILMOD(L+1)
655    c      WRITE(*,*) FIL1
656    c      WRITE(*,*) FIL2
657  c      print *, "que"  c      print *, "que"
658  C--   GET IGRF COEFFICIENTS FOR THE BOUNDARY YEARS  C--   GET IGRF COEFFICIENTS FOR THE BOUNDARY YEARS
659        CALL GETSHC (IU, FIL1, NMAX1, ERAD, GH1, IER)          CALL GETSHC (IU, FIL1, NMAX1, ERAD, GH1, IER)  
660        IF (IER .NE. 0) STOP                                  IF (IER .NE. 0) STOP                          
661    c      print *, "quessss"
662        CALL GETSHC (IU, FIL2, NMAX2, ERAD, GH2, IER)          CALL GETSHC (IU, FIL2, NMAX2, ERAD, GH2, IER)  
663        IF (IER .NE. 0) STOP                            IF (IER .NE. 0) STOP                    
664  c      print *, "quj"  c      print *, "quj"
# Line 944  C ERA, EREQU and ERPOL as recommended by Line 947  C ERA, EREQU and ERPOL as recommended by
947  C ASTRONOMICAL UNION .  C ASTRONOMICAL UNION .
948  C-----------------------------------------------------------------  C-----------------------------------------------------------------
949          INTEGER TL1,TL2,TL3          INTEGER TL1,TL2,TL3
950          CHARACTER *258 TP1,TP2,TP3          CHARACTER (len=258) TP1,TP2,TP3
951          INTEGER L1,L2,L3          INTEGER L1,L2,L3
952          CHARACTER *258 P1,P2,P3          CHARACTER *258 P1,P2,P3
953          COMMON/PPATH/ L1,L2,L3,P1, P2, P3          COMMON/PPATH/ L1,L2,L3,P1, P2, P3
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.23