function get_flux_c_(me,v,year,e,imname) result(flux)
+ function get_flux_c_(me, v, year, e, imname) result(flux)
- class(radbelt_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(radbelt_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- real(wp) :: xl !! l value
- real(wp) :: bbx
+ real(wp) :: xl !! l value
+ real(wp) :: bbx
- call me%igrf%igrfc(v,year,xl,bbx)
- call me%trm%aep8(e,xl,bbx,imname,flux)
+ call me%igrf%igrfc(v, year, xl, bbx)
+ call me%trm%aep8(e, xl, bbx, imname, flux)
- end function get_flux_c_
+ end function get_flux_c_
Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -180,7 +180,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -195,7 +195,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -210,7 +210,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -226,7 +226,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -241,7 +241,7 @@ Arguments
|
-
+
integer,
|
intent(in) |
@@ -265,7 +265,7 @@ Arguments
Return Value
-
+
real(kind=wp)
@@ -870,27 +870,27 @@ Graph Key
Source Code
- function get_flux_g(lon,lat,height,year,e,imname) result(flux)
+ function get_flux_g(lon, lat, height, year, e, imname) result(flux)
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type) :: radbelt
+ type(radbelt_type) :: radbelt
- flux = radbelt%get_flux(lon,lat,height,year,e,imname)
+ flux = radbelt%get_flux(lon, lat, height, year, e, imname)
- end function get_flux_g
+ end function get_flux_g
Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -191,7 +191,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -206,7 +206,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -221,7 +221,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -237,7 +237,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -252,7 +252,7 @@ Arguments
|
-
+
integer,
|
intent(in) |
@@ -276,7 +276,7 @@ Arguments
Return Value
-
+
real(kind=wp)
@@ -837,30 +837,30 @@ Graph Key
Source Code
- function get_flux_g_(me,lon,lat,height,year,e,imname) result(flux)
+ function get_flux_g_(me, lon, lat, height, year, e, imname) result(flux)
- class(radbelt_type),intent(inout) :: me
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(radbelt_type), intent(inout) :: me
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- real(wp) :: xl !! l value
- real(wp) :: bbx
+ real(wp) :: xl !! l value
+ real(wp) :: bbx
- call me%igrf%igrf(lon,lat,height,year,xl,bbx)
- call me%trm%aep8(e,xl,bbx,imname,flux)
+ call me%igrf%igrf(lon, lat, height, year, xl, bbx)
+ call me%trm%aep8(e, xl, bbx, imname, flux)
- end function get_flux_g_
+ end function get_flux_g_
Arguments
|
-
+
real(kind=c_double),
|
intent(in) |
@@ -189,7 +189,7 @@ Arguments
|
-
+
real(kind=c_double),
|
intent(in) |
@@ -204,7 +204,7 @@ Arguments
|
-
+
real(kind=c_double),
|
intent(in) |
@@ -219,7 +219,7 @@ Arguments
|
-
+
real(kind=c_double),
|
intent(in) |
@@ -235,7 +235,7 @@ Arguments
|
-
+
real(kind=c_double),
|
intent(in) |
@@ -250,7 +250,7 @@ Arguments
|
-
+
integer(kind=c_int),
|
intent(in) |
@@ -271,7 +271,7 @@ Arguments
|
-
+
real(kind=c_double),
|
intent(out) |
@@ -784,36 +784,36 @@ Graph Key
Source Code
- subroutine get_flux_g_c(ipointer,lon,lat,height,year,e,imname,flux) bind(C, name="get_flux_g_c")
+ subroutine get_flux_g_c(ipointer, lon, lat, height, year, e, imname, flux) bind(C, name="get_flux_g_c")
- integer(c_intptr_t),intent(in) :: ipointer
- real(c_double),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(c_double),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(c_double),intent(in) :: height !! altitude in km above sea level
- real(c_double),intent(in) :: year !! decimal year for which geomagnetic field is to
+ integer(c_intptr_t), intent(in) :: ipointer
+ real(c_double), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(c_double), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(c_double), intent(in) :: height !! altitude in km above sea level
+ real(c_double), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(c_double),intent(in) :: e !! minimum energy
- integer(c_int),intent(in) :: imname !! which method to use:
+ real(c_double), intent(in) :: e !! minimum energy
+ integer(c_int), intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(c_double),intent(out) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(c_double), intent(out) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type),pointer :: p
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
+ if (associated(p)) then
- flux = p%get_flux(lon,lat,height,year,e,imname)
+ flux = p%get_flux(lon, lat, height, year, e, imname)
- else
- error stop 'error in get_flux_g_c: class is not associated'
- end if
+ else
+ error stop 'error in get_flux_g_c: class is not associated'
+ end if
-end subroutine get_flux_g_c
+ end subroutine get_flux_g_c
Graph Key
Source Code
- subroutine getshc(Fspec,Nmax,Erad,Gh,Ier)
+ subroutine getshc(Fspec, Nmax, Erad, Gh, Ier)
- character(len=*),intent(in) :: Fspec !! File specification
- integer,intent(out) :: Nmax !! Maximum degree and order of model
- real(wp),intent(out) :: Erad !! Earth's radius associated with the spherical
+ character(len=*), intent(in) :: Fspec !! File specification
+ integer, intent(out) :: Nmax !! Maximum degree and order of model
+ real(wp), intent(out) :: Erad !! Earth's radius associated with the spherical
!! harmonic coefficients, in the same units as
!! elevation
- real(wp),dimension(*),intent(out) :: Gh !! Schmidt quasi-normal internal spherical
+ real(wp), dimension(*), intent(out) :: Gh !! Schmidt quasi-normal internal spherical
!! harmonic coefficients
- integer,intent(out) :: Ier !! Error number:
+ integer, intent(out) :: Ier !! Error number:
!!
!! * 0, no error
!! * -2, records out of order
!! * FORTRAN run-time error number
- integer :: iu !! logical unit number
- real(wp) :: g , h
- integer :: i , m , mm , n , nn
-
- read_file : block
- ! ---------------------------------------------------------------
- ! Open coefficient file. Read past first header record.
- ! Read degree and order of model and Earth's radius.
- ! ---------------------------------------------------------------
- OPEN (newunit=Iu,FILE=Fspec,STATUS='OLD',IOSTAT=Ier)
- if (Ier/=0) then
- write(*,*) 'Error opening file: '//trim(fspec)
- exit read_file
- end if
- READ (Iu,*,IOSTAT=Ier)
- if (Ier/=0) exit read_file
- READ (Iu,*,IOSTAT=Ier) Nmax , Erad
- if (Ier/=0) exit read_file
-
- ! ---------------------------------------------------------------
- ! Read the coefficient file, arranged as follows:
- !
- ! N M G H
- ! ----------------------
- ! / 1 0 GH(1) -
- ! / 1 1 GH(2) GH(3)
- ! / 2 0 GH(4) -
- ! / 2 1 GH(5) GH(6)
- ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8)
- ! records \ 3 0 GH(9) -
- ! \ . . . .
- ! \ . . . .
- ! NMAX*(NMAX+2) \ . . . .
- ! elements in GH \ NMAX NMAX . .
- !
- ! N and M are, respectively, the degree and order of the
- ! coefficient.
- ! ---------------------------------------------------------------
- i = 0
- main: DO nn = 1 , Nmax
- DO mm = 0 , nn
- READ (Iu,*,IOSTAT=Ier) n , m , g , h
- if (Ier/=0) exit main
- IF ( nn/=n .OR. mm/=m ) THEN
- Ier = -2
- EXIT main
- ENDIF
- i = i + 1
- Gh(i) = g
- IF ( m/=0 ) THEN
- i = i + 1
- Gh(i) = h
- ENDIF
- ENDDO
- ENDDO main
-
- end block read_file
-
- CLOSE (Iu)
-
-END subroutine getshc
+ integer :: iu !! logical unit number
+ real(wp) :: g, h
+ integer :: i, m, mm, n, nn
+
+ read_file: block
+ ! ---------------------------------------------------------------
+ ! Open coefficient file. Read past first header record.
+ ! Read degree and order of model and Earth's radius.
+ ! ---------------------------------------------------------------
+ open (newunit=Iu, FILE=Fspec, STATUS='OLD', IOSTAT=Ier)
+ if (Ier /= 0) then
+ write (*, *) 'Error opening file: '//trim(fspec)
+ exit read_file
+ end if
+ read (Iu, *, IOSTAT=Ier)
+ if (Ier /= 0) exit read_file
+ read (Iu, *, IOSTAT=Ier) Nmax, Erad
+ if (Ier /= 0) exit read_file
+
+ ! ---------------------------------------------------------------
+ ! Read the coefficient file, arranged as follows:
+ !
+ ! N M G H
+ ! ----------------------
+ ! / 1 0 GH(1) -
+ ! / 1 1 GH(2) GH(3)
+ ! / 2 0 GH(4) -
+ ! / 2 1 GH(5) GH(6)
+ ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8)
+ ! records \ 3 0 GH(9) -
+ ! \ . . . .
+ ! \ . . . .
+ ! NMAX*(NMAX+2) \ . . . .
+ ! elements in GH \ NMAX NMAX . .
+ !
+ ! N and M are, respectively, the degree and order of the
+ ! coefficient.
+ ! ---------------------------------------------------------------
+ i = 0
+ main: do nn = 1, Nmax
+ do mm = 0, nn
+ read (Iu, *, IOSTAT=Ier) n, m, g, h
+ if (Ier /= 0) exit main
+ if (nn /= n .or. mm /= m) then
+ Ier = -2
+ exit main
+ end if
+ i = i + 1
+ Gh(i) = g
+ if (m /= 0) then
+ i = i + 1
+ Gh(i) = h
+ end if
+ end do
+ end do main
+
+ end block read_file
+
+ close (Iu)
+
+ end subroutine getshc
Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -191,7 +191,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -206,7 +206,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -221,7 +221,7 @@ Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -764,44 +764,44 @@ Graph Key
Source Code
- subroutine igrf(me,lon,lat,height,year,xl,bbx)
+ subroutine igrf(me, lon, lat, height, year, xl, bbx)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: xl !! l-value
- real(wp),intent(out) :: bbx !! b_total / b_equatorial ratio
-
- real(wp) :: bab1 , babs , bdel , bdown , beast , &
- beq , bequ , bnorth , dimo , rr0
- integer :: icode
- logical :: val
-
- real(wp),parameter :: stps = 0.05_wp
-
- ! JW : do we need to reset some or all of these ?
- me%sp = 0.0_wp
- me%xi = 0.0_wp
- me%h = 0.0_wp
- me%step = 0.20_wp
- me%steq = 0.03_wp
-
- call me%feldcof(year,dimo)
- call me%feldg(lat,lon,height,bnorth,beast,bdown,babs)
- call me%shellg(lat,lon,height,dimo,xl,icode,bab1)
-
- bequ = dimo/(xl*xl*xl)
- if ( icode==1 ) then
- bdel = 1.0e-3_wp
- call me%findb0(stps,bdel,val,beq,rr0)
- if ( val ) bequ = beq
- endif
- bbx = babs/bequ
-
- end subroutine igrf
+ real(wp), intent(out) :: xl !! l-value
+ real(wp), intent(out) :: bbx !! b_total / b_equatorial ratio
+
+ real(wp) :: bab1, babs, bdel, bdown, beast, &
+ beq, bequ, bnorth, dimo, rr0
+ integer :: icode
+ logical :: val
+
+ real(wp), parameter :: stps = 0.05_wp
+
+ ! JW : do we need to reset some or all of these ?
+ me%sp = 0.0_wp
+ me%xi = 0.0_wp
+ me%h = 0.0_wp
+ me%step = 0.20_wp
+ me%steq = 0.03_wp
+
+ call me%feldcof(year, dimo)
+ call me%feldg(lat, lon, height, bnorth, beast, bdown, babs)
+ call me%shellg(lat, lon, height, dimo, xl, icode, bab1)
+
+ bequ = dimo / (xl * xl * xl)
+ if (icode == 1) then
+ bdel = 1.0e-3_wp
+ call me%findb0(stps, bdel, val, beq, rr0)
+ if (val) bequ = beq
+ end if
+ bbx = babs / bequ
+
+ end subroutine igrf
Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -752,45 +752,45 @@ Graph Key
Source Code
- subroutine igrfc(me,v,year,xl,bbx)
+ subroutine igrfc(me, v, year, xl, bbx)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! x-axis pointing to equator at 0 longitude
!! y-axis pointing to equator at 90 long.
!! z-axis pointing to north pole
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: xl !! l-value
- real(wp),intent(out) :: bbx !! b_total / b_equatorial ratio
-
- real(wp) :: bab1 , bdel , beq , bequ , dimo , rr0
- integer :: icode
- logical :: val
- real(wp),dimension(3) :: b
-
- real(wp),parameter :: stps = 0.05_wp
-
- ! JW : do we need to reset some or all of these ?
- me%sp = 0.0_wp
- me%xi = 0.0_wp
- me%h = 0.0_wp
- me%step = 0.20_wp
- me%steq = 0.03_wp
-
- call me%feldcof(year,dimo)
- call me%feldc(v,b)
- call me%shellc(v,dimo,xl,icode,bab1)
-
- bequ = dimo/(xl*xl*xl)
- if ( icode==1 ) then
- bdel = 1.0e-3_wp
- call me%findb0(stps,bdel,val,beq,rr0)
- if ( val ) bequ = beq
- endif
- bbx = norm2(b)/bequ
-
- end subroutine igrfc
+ real(wp), intent(out) :: xl !! l-value
+ real(wp), intent(out) :: bbx !! b_total / b_equatorial ratio
+
+ real(wp) :: bab1, bdel, beq, bequ, dimo, rr0
+ integer :: icode
+ logical :: val
+ real(wp), dimension(3) :: b
+
+ real(wp), parameter :: stps = 0.05_wp
+
+ ! JW : do we need to reset some or all of these ?
+ me%sp = 0.0_wp
+ me%xi = 0.0_wp
+ me%h = 0.0_wp
+ me%step = 0.20_wp
+ me%steq = 0.03_wp
+
+ call me%feldcof(year, dimo)
+ call me%feldc(v, b)
+ call me%shellc(v, dimo, xl, icode, bab1)
+
+ bequ = dimo / (xl * xl * xl)
+ if (icode == 1) then
+ bdel = 1.0e-3_wp
+ call me%findb0(stps, bdel, val, beq, rr0)
+ if (val) bequ = beq
+ end if
+ bbx = norm2(b) / bequ
+
+ end subroutine igrfc
Arguments
Source Code
- subroutine initialize_c(ipointer) bind(C, name="initialize_c")
+ subroutine initialize_c(ipointer) bind(C, name="initialize_c")
- integer(c_intptr_t),intent(out) :: ipointer
- type(radbelt_type),pointer :: p
- type(c_ptr) :: cp
+ integer(c_intptr_t), intent(out) :: ipointer
+ type(radbelt_type), pointer :: p
+ type(c_ptr) :: cp
- allocate(p)
- cp = c_loc(p)
- ipointer = transfer(cp, 0_c_intptr_t)
+ allocate (p)
+ cp = c_loc(p)
+ ipointer = transfer(cp, 0_c_intptr_t)
-end subroutine initialize_c
+ end subroutine initialize_c
Arguments
|
-
+
type(radbelt_type),
|
|
@@ -383,21 +383,21 @@ Graph Key
Source Code
- subroutine int_pointer_to_f_pointer(ipointer, p)
+ subroutine int_pointer_to_f_pointer(ipointer, p)
- integer(c_intptr_t),intent(in) :: ipointer !! integer pointer from C
- type(radbelt_type),pointer :: p !! fortran pointer
+ integer(c_intptr_t), intent(in) :: ipointer !! integer pointer from C
+ type(radbelt_type), pointer :: p !! fortran pointer
- type(c_ptr) :: cp
+ type(c_ptr) :: cp
- cp = transfer(ipointer, c_null_ptr)
- if (c_associated(cp)) then
- call c_f_pointer(cp, p)
- else
- p => null()
- end if
+ cp = transfer(ipointer, c_null_ptr)
+ if (c_associated(cp)) then
+ call c_f_pointer(cp, p)
+ else
+ p => null()
+ end if
-end subroutine int_pointer_to_f_pointer
+ end subroutine int_pointer_to_f_pointer
Graph Key
Source Code
- subroutine intershc(date,dte1,nmax1,gh1,dte2,nmax2,gh2,nmax,gh)
-
- real(wp),intent(in) :: date !! Date of resulting model (in decimal year)
- real(wp),intent(in) :: dte1 !! Date of earlier model
- integer,intent(in) :: nmax1 !! Maximum degree and order of earlier model
- real(wp),intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model
- real(wp),intent(in) :: dte2 !! Date of later model
- integer,intent(in) :: nmax2 !! Maximum degree and order of later model
- real(wp),intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model
- real(wp),intent(out) :: gh(*) !! Coefficients of resulting model
- integer,intent(out) :: nmax !! Maximum degree and order of resulting model
-
- real(wp) :: factor
- integer :: i , k , l
-
- factor = (date-dte1)/(dte2-dte1)
-
- if ( nmax1==nmax2 ) then
- k = nmax1*(nmax1+2)
- nmax = nmax1
- elseif ( nmax1>nmax2 ) then
- k = nmax2*(nmax2+2)
- l = nmax1*(nmax1+2)
- do i = k + 1 , l
- gh(i) = gh1(i) + factor*(-gh1(i))
- enddo
- nmax = nmax1
- else
- k = nmax1*(nmax1+2)
- l = nmax2*(nmax2+2)
- do i = k + 1 , l
- gh(i) = factor*gh2(i)
- enddo
- nmax = nmax2
- endif
-
- do i = 1 , k
- gh(i) = gh1(i) + factor*(gh2(i)-gh1(i))
- enddo
-
-end subroutine intershc
+ subroutine intershc(date, dte1, nmax1, gh1, dte2, nmax2, gh2, nmax, gh)
+
+ real(wp), intent(in) :: date !! Date of resulting model (in decimal year)
+ real(wp), intent(in) :: dte1 !! Date of earlier model
+ integer, intent(in) :: nmax1 !! Maximum degree and order of earlier model
+ real(wp), intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model
+ real(wp), intent(in) :: dte2 !! Date of later model
+ integer, intent(in) :: nmax2 !! Maximum degree and order of later model
+ real(wp), intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model
+ real(wp), intent(out) :: gh(*) !! Coefficients of resulting model
+ integer, intent(out) :: nmax !! Maximum degree and order of resulting model
+
+ real(wp) :: factor
+ integer :: i, k, l
+
+ factor = (date - dte1) / (dte2 - dte1)
+
+ if (nmax1 == nmax2) then
+ k = nmax1 * (nmax1 + 2)
+ nmax = nmax1
+ elseif (nmax1 > nmax2) then
+ k = nmax2 * (nmax2 + 2)
+ l = nmax1 * (nmax1 + 2)
+ do i = k + 1, l
+ gh(i) = gh1(i) + factor * (-gh1(i))
+ end do
+ nmax = nmax1
+ else
+ k = nmax1 * (nmax1 + 2)
+ l = nmax2 * (nmax2 + 2)
+ do i = k + 1, l
+ gh(i) = factor * gh2(i)
+ end do
+ nmax = nmax2
+ end if
+
+ do i = 1, k
+ gh(i) = gh1(i) + factor * (gh2(i) - gh1(i))
+ end do
+
+ end subroutine intershc
Graph Key
Source Code
- subroutine set_data_file_dir(me,dir)
- class(trm_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
- me%aep8_dir = trim(dir)
- end subroutine set_data_file_dir
+ subroutine set_data_file_dir(me, dir)
+ class(trm_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
+ me%aep8_dir = trim(dir)
+ end subroutine set_data_file_dir
Graph Key
Source Code
- subroutine set_data_file_dir(me,dir)
- class(shellig_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
- me%igrf_dir = trim(dir)
- end subroutine set_data_file_dir
+ subroutine set_data_file_dir(me, dir)
+ class(shellig_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
+ me%igrf_dir = trim(dir)
+ end subroutine set_data_file_dir
Arguments
|
-
+
character(len=*),
|
intent(in) |
@@ -193,7 +193,7 @@ Arguments
|
-
+
character(len=*),
|
intent(in) |
@@ -509,16 +509,16 @@ Graph Key
Source Code
- subroutine set_data_files_paths(me, aep8_dir, igrf_dir)
+ subroutine set_data_files_paths(me, aep8_dir, igrf_dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: aep8_dir
- character(len=*),intent(in) :: igrf_dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: aep8_dir
+ character(len=*), intent(in) :: igrf_dir
- call me%set_trm_file_path(trim(aep8_dir))
- call me%set_igrf_file_path(trim(igrf_dir))
+ call me%set_trm_file_path(trim(aep8_dir))
+ call me%set_igrf_file_path(trim(igrf_dir))
- end subroutine set_data_files_paths
+ end subroutine set_data_files_paths
Arguments
|
-
+
character(kind=c_char, len=1),
|
intent(in), |
@@ -189,7 +189,7 @@ Arguments
|
-
+
character(kind=c_char, len=1),
|
intent(in), |
@@ -204,7 +204,7 @@ Arguments
|
-
+
integer(kind=c_int),
|
intent(in) |
@@ -219,7 +219,7 @@ Arguments
|
-
+
integer(kind=c_int),
|
intent(in) |
@@ -462,31 +462,31 @@ Graph Key
Source Code
- subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name="set_data_files_paths_c")
+ subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name="set_data_files_paths_c")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `aep8_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: aep8_dir
- integer(c_int),intent(in) :: m !! size of `igrf_dir`
- character(kind=c_char,len=1),dimension(m),intent(in) :: igrf_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `aep8_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: aep8_dir
+ integer(c_int), intent(in) :: m !! size of `igrf_dir`
+ character(kind=c_char, len=1), dimension(m), intent(in) :: igrf_dir
- character(len=:),allocatable :: aep8_dir_, igrf_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: aep8_dir_, igrf_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
+ if (associated(p)) then
- aep8_dir_ = c2f_str(aep8_dir)
- igrf_dir_ = c2f_str(igrf_dir)
+ aep8_dir_ = c2f_str(aep8_dir)
+ igrf_dir_ = c2f_str(igrf_dir)
- call p%set_data_files_paths(aep8_dir_, igrf_dir_)
+ call p%set_data_files_paths(aep8_dir_, igrf_dir_)
- else
- error stop 'error in set_data_files_paths_c: class is not associated'
- end if
+ else
+ error stop 'error in set_data_files_paths_c: class is not associated'
+ end if
- end subroutine set_data_files_paths_c
+ end subroutine set_data_files_paths_c
Graph Key
Source Code
- subroutine set_igrf_file_path(me, dir)
+ subroutine set_igrf_file_path(me, dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
- call me%igrf%set_data_file_dir(trim(dir))
+ call me%igrf%set_data_file_dir(trim(dir))
- end subroutine set_igrf_file_path
+ end subroutine set_igrf_file_path
Arguments
|
-
+
character(kind=c_char, len=1),
|
intent(in), |
@@ -189,7 +189,7 @@ Arguments
|
-
+
integer(kind=c_int),
|
intent(in) |
@@ -387,25 +387,25 @@ Graph Key
Source Code
- subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name="set_igrf_file_path")
+ subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name="set_igrf_file_path")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `igrf_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: igrf_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `igrf_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: igrf_dir
- character(len=:),allocatable :: igrf_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: igrf_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
- igrf_dir_ = c2f_str(igrf_dir)
- call p%set_igrf_file_path(igrf_dir_)
- else
- error stop 'error in set_igrf_file_path: class is not associated'
- end if
+ if (associated(p)) then
+ igrf_dir_ = c2f_str(igrf_dir)
+ call p%set_igrf_file_path(igrf_dir_)
+ else
+ error stop 'error in set_igrf_file_path: class is not associated'
+ end if
- end subroutine set_igrf_file_path_c
+ end subroutine set_igrf_file_path_c
Graph Key
Source Code
- subroutine set_trm_file_path(me, dir)
+ subroutine set_trm_file_path(me, dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
- call me%trm%set_data_file_dir(trim(dir))
+ call me%trm%set_data_file_dir(trim(dir))
- end subroutine set_trm_file_path
+ end subroutine set_trm_file_path
Arguments
|
-
+
character(kind=c_char, len=1),
|
intent(in), |
@@ -189,7 +189,7 @@ Arguments
|
-
+
integer(kind=c_int),
|
intent(in) |
@@ -387,25 +387,25 @@ Graph Key
Source Code
- subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name="set_trm_file_path_c")
+ subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name="set_trm_file_path_c")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `aep8_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: aep8_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `aep8_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: aep8_dir
- character(len=:),allocatable :: aep8_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: aep8_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
- aep8_dir_ = c2f_str(aep8_dir)
- call p%set_trm_file_path(aep8_dir_)
- else
- error stop 'error in set_trm_file_path_c: class is not associated'
- end if
+ if (associated(p)) then
+ aep8_dir_ = c2f_str(aep8_dir)
+ call p%set_trm_file_path(aep8_dir_)
+ else
+ error stop 'error in set_trm_file_path_c: class is not associated'
+ end if
- end subroutine set_trm_file_path_c
+ end subroutine set_trm_file_path_c
Graph Key
Source Code
- subroutine shellc(me,v,dimo,fl,icode,b0)
+ subroutine shellc(me, v, dimo, fl, icode, b0)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
!! * z-axis pointing to north pole
- real(wp),intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
- real(wp),intent(out) :: fl !! l-value
- integer,intent(out) :: icode !! * =1 normal completion
+ real(wp), intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
+ real(wp), intent(out) :: fl !! l-value
+ integer, intent(out) :: icode !! * =1 normal completion
!! * =2 unphysical conjugate point (fl meaningless)
!! * =3 shell parameter greater than limit up to
!! which accurate calculation is required;
!! approximation is used.
- real(wp),intent(out) :: b0 !! magnetic field strength in gauss
- real(wp) :: glat,glon,alt !! not used
+ real(wp), intent(out) :: b0 !! magnetic field strength in gauss
+ real(wp) :: glat, glon, alt !! not used
- call me%shellg(glat,glon,alt,dimo,fl,icode,b0,v)
+ call me%shellg(glat, glon, alt, dimo, fl, icode, b0, v)
- end subroutine shellc
+ end subroutine shellc
Graph Key
Source Code
- subroutine shellg(me,glat,glon,alt,dimo,fl,icode,b0,v)
+ subroutine shellg(me, glat, glon, alt, dimo, fl, icode, b0, v)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: glat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: glon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: alt !! altitude in km above sea level
- real(wp),intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
- real(wp),intent(out) :: fl !! l-value
- integer,intent(out) :: icode !! * =1 normal completion
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: glat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: glon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: alt !! altitude in km above sea level
+ real(wp), intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
+ real(wp), intent(out) :: fl !! l-value
+ integer, intent(out) :: icode !! * =1 normal completion
!! * =2 unphysical conjugate point (fl meaningless)
!! * =3 shell parameter greater than limit up to
!! which accurate calculation is required;
!! approximation is used.
- real(wp),intent(out) :: b0 !! magnetic field strength in gauss
- real(wp),dimension(3),intent(in),optional :: v !! cartesian coordinates in earth radii (6371.2 km)
+ real(wp), intent(out) :: b0 !! magnetic field strength in gauss
+ real(wp), dimension(3), intent(in), optional :: v !! cartesian coordinates in earth radii (6371.2 km)
!!
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
@@ -782,200 +782,200 @@ Source Code
!! If this argument is present, it is used
!! instead of glat,glon,alt. See [[shellc]].
- real(wp) :: arg1 , arg2 , bequ , bq1 , bq2 , bq3 , c0 , c1 , c2 , c3 , &
- d0 , d1 , d2, dimob0 , e0 , e1 , e2 , ff , fi , gg , &
- hli , oradik , oterm , r , r1 , r2 , r3 , r3h , radik , &
- rq , step12 , step2 , stp , t , term , xx , z , zq , zz
- integer :: i , iequ , n
+ real(wp) :: arg1, arg2, bequ, bq1, bq2, bq3, c0, c1, c2, c3, &
+ d0, d1, d2, dimob0, e0, e1, e2, ff, fi, gg, &
+ hli, oradik, oterm, r, r1, r2, r3, r3h, radik, &
+ rq, step12, step2, stp, t, term, xx, z, zq, zz
+ integer :: i, iequ, n
- real(wp),parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3`
- real(wp),parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3`
+ real(wp), parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3`
+ real(wp), parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3`
- if (.not. allocated(me%p)) allocate(me%p(8,max_loop_index+1)) ! because `p(:,n+1)` in the loop
+ if (.not. allocated(me%p)) allocate (me%p(8, max_loop_index + 1)) ! because `p(:,n+1)` in the loop
- bequ = 1.0e10_wp
+ bequ = 1.0e10_wp
- if (present(v)) then
- me%xi(1) = v(1)
- me%xi(2) = v(2)
- me%xi(3) = v(3)
- else
- me%xi = geo_to_cart(glat,glon,alt)
- end if
+ if (present(v)) then
+ me%xi(1) = v(1)
+ me%xi(2) = v(2)
+ me%xi(3) = v(3)
+ else
+ me%xi = geo_to_cart(glat, glon, alt)
+ end if
- associate (p => me%p)
+ associate (p => me%p)
- ! convert to dipol-oriented co-ordinates
- rq = 1.0_wp/(me%xi(1)*me%xi(1)+me%xi(2)*me%xi(2)+me%xi(3)*me%xi(3))
- r3h = sqrt(rq*sqrt(rq))
- p(1,2) = (me%xi(1)*u(1,1)+me%xi(2)*u(2,1)+me%xi(3)*u(3,1))*r3h
- p(2,2) = (me%xi(1)*u(1,2)+me%xi(2)*u(2,2))*r3h
- p(3,2) = (me%xi(1)*u(1,3)+me%xi(2)*u(2,3)+me%xi(3)*u(3,3))*rq
- ! first three points of field line
- me%step = -sign(me%step,p(3,2))
- call me%stoer(p(1,2),bq2,r2)
- b0 = sqrt(bq2)
- p(1,3) = p(1,2) + 0.5_wp*me%step*p(4,2)
- p(2,3) = p(2,2) + 0.5_wp*me%step*p(5,2)
- p(3,3) = p(3,2) + 0.5_wp*me%step
- call me%stoer(p(1,3),bq3,r3)
- p(1,1) = p(1,2) - me%step*(2.0_wp*p(4,2)-p(4,3))
- p(2,1) = p(2,2) - me%step*(2.0_wp*p(5,2)-p(5,3))
- p(3,1) = p(3,2) - me%step
- call me%stoer(p(1,1),bq1,r1)
- p(1,3) = p(1,2) + me%step*(20.0_wp*p(4,3)-3.*p(4,2)+p(4,1))/18.0_wp
- p(2,3) = p(2,2) + me%step*(20.0_wp*p(5,3)-3.*p(5,2)+p(5,1))/18.0_wp
- p(3,3) = p(3,2) + me%step
- call me%stoer(p(1,3),bq3,r3)
- ! invert sense if required
- if ( bq3>bq1 ) then
- me%step = -me%step
- r3 = r1
- bq3 = bq1
- do i = 1 , 7
- zz = p(i,1)
- p(i,1) = p(i,3)
- p(i,3) = zz
- enddo
- endif
- ! search for lowest magnetic field strength
- if ( bq1<bequ ) then
- bequ = bq1
- iequ = 1
- endif
- if ( bq2<bequ ) then
- bequ = bq2
- iequ = 2
- endif
- if ( bq3<bequ ) then
- bequ = bq3
- iequ = 3
- endif
- ! initialization of integration loops
- step12 = me%step/12.0_wp
- step2 = me%step + me%step
- me%steq = sign(me%steq,me%step)
- fi = 0.0_wp
- icode = 1
- oradik = 0.0_wp
- oterm = 0.0_wp
- stp = r2*me%steq
- z = p(3,2) + stp
- stp = stp/0.75_wp
- p(8,1) = step2*(p(1,1)*p(4,1)+p(2,1)*p(5,1))
- p(8,2) = step2*(p(1,2)*p(4,2)+p(2,2)*p(5,2))
- ! main loop (field line tracing)
- main: do n = 3 , max_loop_index
- ! corrector (field line tracing)
- p(1,n) = p(1,n-1) + step12*(5.0_wp*p(4,n)+8.0_wp*p(4,n-1)-p(4,n-2))
- p(2,n) = p(2,n-1) + step12*(5.0_wp*p(5,n)+8.0_wp*p(5,n-1)-p(5,n-2))
- ! prepare expansion coefficients for interpolation
- ! of slowly varying quantities
- p(8,n) = step2*(p(1,n)*p(4,n)+p(2,n)*p(5,n))
- c0 = p(1,n-1)**2 + p(2,n-1)**2
- c1 = p(8,n-1)
- c2 = (p(8,n)-p(8,n-2))*0.25_wp
- c3 = (p(8,n)+p(8,n-2)-c1-c1)/6.0_wp
- d0 = p(6,n-1)
- d1 = (p(6,n)-p(6,n-2))*0.5_wp
- d2 = (p(6,n)+p(6,n-2)-d0-d0)*0.5_wp
- e0 = p(7,n-1)
- e1 = (p(7,n)-p(7,n-2))*0.5_wp
- e2 = (p(7,n)+p(7,n-2)-e0-e0)*0.5_wp
- inner: do
- ! inner loop (for quadrature)
- t = (z-p(3,n-1))/me%step
- if ( t>1.0_wp ) then
- ! predictor (field line tracing)
- p(1,n+1) = p(1,n) + step12*(23.0_wp*p(4,n)-16.0_wp*p(4,n-1)+5.0_wp*p(4,n-2))
- p(2,n+1) = p(2,n) + step12*(23.0_wp*p(5,n)-16.0_wp*p(5,n-1)+5.0_wp*p(5,n-2))
- p(3,n+1) = p(3,n) + me%step
- call me%stoer(p(1,n+1),bq3,r3)
- ! search for lowest magnetic field strength
- if ( bq3<bequ ) then
- iequ = n + 1
- bequ = bq3
- endif
- exit inner
- else
- hli = 0.5_wp*(((c3*t+c2)*t+c1)*t+c0)
- zq = z*z
- r = hli + sqrt(hli*hli+zq)
- if ( r<=rmin ) then
- ! approximation for high values of l.
- icode = 3
- t = -p(3,n-1)/me%step
- fl = 1.0_wp/(abs(((c3*t+c2)*t+c1)*t+c0)+1.0e-15_wp)
- return
- endif
- rq = r*r
- ff = sqrt(1.0_wp+3.0_wp*zq/rq)
- radik = b0 - ((d2*t+d1)*t+d0)*r*rq*ff
- if ( r>rmax ) then
- icode = 2
- radik = radik - 12.0_wp*(r-rmax)**2
- endif
- if ( radik+radik<=oradik ) exit main
- term = sqrt(radik)*ff*((e2*t+e1)*t+e0)/(rq+zq)
- fi = fi + stp*(oterm+term)
- oradik = radik
- oterm = term
- stp = r*me%steq
- z = z + stp
- endif
- enddo inner
- enddo main
- if ( iequ<2 ) iequ = 2
- me%sp(1) = p(1,iequ-1)
- me%sp(2) = p(2,iequ-1)
- me%sp(3) = p(3,iequ-1)
- if ( oradik>=1.0e-15_wp ) fi = fi + stp/0.75_wp*oterm*oradik/(oradik-radik)
+ ! convert to dipol-oriented co-ordinates
+ rq = 1.0_wp / (me%xi(1) * me%xi(1) + me%xi(2) * me%xi(2) + me%xi(3) * me%xi(3))
+ r3h = sqrt(rq * sqrt(rq))
+ p(1, 2) = (me%xi(1) * u(1, 1) + me%xi(2) * u(2, 1) + me%xi(3) * u(3, 1)) * r3h
+ p(2, 2) = (me%xi(1) * u(1, 2) + me%xi(2) * u(2, 2)) * r3h
+ p(3, 2) = (me%xi(1) * u(1, 3) + me%xi(2) * u(2, 3) + me%xi(3) * u(3, 3)) * rq
+ ! first three points of field line
+ me%step = -sign(me%step, p(3, 2))
+ call me%stoer(p(1, 2), bq2, r2)
+ b0 = sqrt(bq2)
+ p(1, 3) = p(1, 2) + 0.5_wp * me%step * p(4, 2)
+ p(2, 3) = p(2, 2) + 0.5_wp * me%step * p(5, 2)
+ p(3, 3) = p(3, 2) + 0.5_wp * me%step
+ call me%stoer(p(1, 3), bq3, r3)
+ p(1, 1) = p(1, 2) - me%step * (2.0_wp * p(4, 2) - p(4, 3))
+ p(2, 1) = p(2, 2) - me%step * (2.0_wp * p(5, 2) - p(5, 3))
+ p(3, 1) = p(3, 2) - me%step
+ call me%stoer(p(1, 1), bq1, r1)
+ p(1, 3) = p(1, 2) + me%step * (20.0_wp * p(4, 3) - 3.*p(4, 2) + p(4, 1)) / 18.0_wp
+ p(2, 3) = p(2, 2) + me%step * (20.0_wp * p(5, 3) - 3.*p(5, 2) + p(5, 1)) / 18.0_wp
+ p(3, 3) = p(3, 2) + me%step
+ call me%stoer(p(1, 3), bq3, r3)
+ ! invert sense if required
+ if (bq3 > bq1) then
+ me%step = -me%step
+ r3 = r1
+ bq3 = bq1
+ do i = 1, 7
+ zz = p(i, 1)
+ p(i, 1) = p(i, 3)
+ p(i, 3) = zz
+ end do
+ end if
+ ! search for lowest magnetic field strength
+ if (bq1 < bequ) then
+ bequ = bq1
+ iequ = 1
+ end if
+ if (bq2 < bequ) then
+ bequ = bq2
+ iequ = 2
+ end if
+ if (bq3 < bequ) then
+ bequ = bq3
+ iequ = 3
+ end if
+ ! initialization of integration loops
+ step12 = me%step / 12.0_wp
+ step2 = me%step + me%step
+ me%steq = sign(me%steq, me%step)
+ fi = 0.0_wp
+ icode = 1
+ oradik = 0.0_wp
+ oterm = 0.0_wp
+ stp = r2 * me%steq
+ z = p(3, 2) + stp
+ stp = stp / 0.75_wp
+ p(8, 1) = step2 * (p(1, 1) * p(4, 1) + p(2, 1) * p(5, 1))
+ p(8, 2) = step2 * (p(1, 2) * p(4, 2) + p(2, 2) * p(5, 2))
+ ! main loop (field line tracing)
+ main: do n = 3, max_loop_index
+ ! corrector (field line tracing)
+ p(1, n) = p(1, n - 1) + step12 * (5.0_wp * p(4, n) + 8.0_wp * p(4, n - 1) - p(4, n - 2))
+ p(2, n) = p(2, n - 1) + step12 * (5.0_wp * p(5, n) + 8.0_wp * p(5, n - 1) - p(5, n - 2))
+ ! prepare expansion coefficients for interpolation
+ ! of slowly varying quantities
+ p(8, n) = step2 * (p(1, n) * p(4, n) + p(2, n) * p(5, n))
+ c0 = p(1, n - 1)**2 + p(2, n - 1)**2
+ c1 = p(8, n - 1)
+ c2 = (p(8, n) - p(8, n - 2)) * 0.25_wp
+ c3 = (p(8, n) + p(8, n - 2) - c1 - c1) / 6.0_wp
+ d0 = p(6, n - 1)
+ d1 = (p(6, n) - p(6, n - 2)) * 0.5_wp
+ d2 = (p(6, n) + p(6, n - 2) - d0 - d0) * 0.5_wp
+ e0 = p(7, n - 1)
+ e1 = (p(7, n) - p(7, n - 2)) * 0.5_wp
+ e2 = (p(7, n) + p(7, n - 2) - e0 - e0) * 0.5_wp
+ inner: do
+ ! inner loop (for quadrature)
+ t = (z - p(3, n - 1)) / me%step
+ if (t > 1.0_wp) then
+ ! predictor (field line tracing)
+ p(1, n + 1) = p(1, n) + step12 * (23.0_wp * p(4, n) - 16.0_wp * p(4, n - 1) + 5.0_wp * p(4, n - 2))
+ p(2, n + 1) = p(2, n) + step12 * (23.0_wp * p(5, n) - 16.0_wp * p(5, n - 1) + 5.0_wp * p(5, n - 2))
+ p(3, n + 1) = p(3, n) + me%step
+ call me%stoer(p(1, n + 1), bq3, r3)
+ ! search for lowest magnetic field strength
+ if (bq3 < bequ) then
+ iequ = n + 1
+ bequ = bq3
+ end if
+ exit inner
+ else
+ hli = 0.5_wp * (((c3 * t + c2) * t + c1) * t + c0)
+ zq = z * z
+ r = hli + sqrt(hli * hli + zq)
+ if (r <= rmin) then
+ ! approximation for high values of l.
+ icode = 3
+ t = -p(3, n - 1) / me%step
+ fl = 1.0_wp / (abs(((c3 * t + c2) * t + c1) * t + c0) + 1.0e-15_wp)
+ return
+ end if
+ rq = r * r
+ ff = sqrt(1.0_wp + 3.0_wp * zq / rq)
+ radik = b0 - ((d2 * t + d1) * t + d0) * r * rq * ff
+ if (r > rmax) then
+ icode = 2
+ radik = radik - 12.0_wp * (r - rmax)**2
+ end if
+ if (radik + radik <= oradik) exit main
+ term = sqrt(radik) * ff * ((e2 * t + e1) * t + e0) / (rq + zq)
+ fi = fi + stp * (oterm + term)
+ oradik = radik
+ oterm = term
+ stp = r * me%steq
+ z = z + stp
+ end if
+ end do inner
+ end do main
+ if (iequ < 2) iequ = 2
+ me%sp(1) = p(1, iequ - 1)
+ me%sp(2) = p(2, iequ - 1)
+ me%sp(3) = p(3, iequ - 1)
+ if (oradik >= 1.0e-15_wp) fi = fi + stp / 0.75_wp * oterm * oradik / (oradik - radik)
- ! the minimal allowable value of fi was changed from 1e-15 to 1e-12,
- ! because 1e-38 is the minimal allowable arg. for alog in our envir.
- ! d. bilitza, nov 87.
- fi = 0.5_wp*abs(fi)/sqrt(b0) + 1.0e-12_wp
+ ! the minimal allowable value of fi was changed from 1e-15 to 1e-12,
+ ! because 1e-38 is the minimal allowable arg. for alog in our envir.
+ ! d. bilitza, nov 87.
+ fi = 0.5_wp * abs(fi) / sqrt(b0) + 1.0e-12_wp
- ! compute l from b and i. same as carmel in invar.
- ! correct dipole moment is used here. d. bilitza, nov 87.
- dimob0 = dimo/b0
- arg1 = log(fi)
- arg2 = log(dimob0)
- ! arg = fi*fi*fi/dimob0
- ! if(abs(arg)>88.0_wp) arg=88.0_wp
- xx = 3*arg1 - arg2
- if ( xx>23.0_wp ) then
- gg = xx - 3.0460681_wp
- elseif ( xx>11.7_wp ) then
- gg = (((((2.8212095e-8_wp*xx-3.8049276e-6_wp)*xx+&
- 2.170224e-4_wp)*xx-6.7310339e-3_wp)*xx+&
- 1.2038224e-1_wp)*xx-1.8461796e-1_wp)*xx + 2.0007187_wp
- elseif ( xx>+3.0_wp ) then
- gg = ((((((((6.3271665e-10_wp*xx-3.958306e-8_wp)*xx+&
- 9.9766148e-07_wp)*xx-1.2531932e-5_wp)*xx+&
- 7.9451313e-5_wp)*xx-3.2077032e-4_wp)*xx+&
- 2.1680398e-3_wp)*xx+1.2817956e-2_wp)*xx+&
- 4.3510529e-1_wp)*xx + 6.222355e-1_wp
- elseif ( xx>-3.0_wp ) then
- gg = ((((((((2.6047023e-10_wp*xx+2.3028767e-9_wp)*xx-&
- 2.1997983e-8_wp)*xx-5.3977642e-7_wp)*xx-&
- 3.3408822e-6_wp)*xx+3.8379917e-5_wp)*xx+&
- 1.1784234e-3_wp)*xx+1.4492441e-2_wp)*xx+&
- 4.3352788e-1_wp)*xx + 6.228644e-1_wp
- elseif ( xx>-22.0_wp ) then
- gg = ((((((((-8.1537735e-14_wp*xx+8.3232531e-13_wp)*xx+&
- 1.0066362e-9_wp)*xx+8.1048663e-8_wp)*xx+&
- 3.2916354e-6_wp)*xx+8.2711096e-5_wp)*xx+&
- 1.3714667e-3_wp)*xx+1.5017245e-2_wp)*xx+&
- 4.3432642e-1_wp)*xx + 6.2337691e-1_wp
- else
- gg = 3.33338e-1_wp*xx + 3.0062102e-1_wp
- endif
- fl = exp(log((1.0_wp+exp(gg))*dimob0)/3.0_wp)
+ ! compute l from b and i. same as carmel in invar.
+ ! correct dipole moment is used here. d. bilitza, nov 87.
+ dimob0 = dimo / b0
+ arg1 = log(fi)
+ arg2 = log(dimob0)
+ ! arg = fi*fi*fi/dimob0
+ ! if(abs(arg)>88.0_wp) arg=88.0_wp
+ xx = 3 * arg1 - arg2
+ if (xx > 23.0_wp) then
+ gg = xx - 3.0460681_wp
+ elseif (xx > 11.7_wp) then
+ gg = (((((2.8212095e-8_wp * xx - 3.8049276e-6_wp) * xx + &
+ 2.170224e-4_wp) * xx - 6.7310339e-3_wp) * xx + &
+ 1.2038224e-1_wp) * xx - 1.8461796e-1_wp) * xx + 2.0007187_wp
+ elseif (xx > +3.0_wp) then
+ gg = ((((((((6.3271665e-10_wp * xx - 3.958306e-8_wp) * xx + &
+ 9.9766148e-07_wp) * xx - 1.2531932e-5_wp) * xx + &
+ 7.9451313e-5_wp) * xx - 3.2077032e-4_wp) * xx + &
+ 2.1680398e-3_wp) * xx + 1.2817956e-2_wp) * xx + &
+ 4.3510529e-1_wp) * xx + 6.222355e-1_wp
+ elseif (xx > -3.0_wp) then
+ gg = ((((((((2.6047023e-10_wp * xx + 2.3028767e-9_wp) * xx - &
+ 2.1997983e-8_wp) * xx - 5.3977642e-7_wp) * xx - &
+ 3.3408822e-6_wp) * xx + 3.8379917e-5_wp) * xx + &
+ 1.1784234e-3_wp) * xx + 1.4492441e-2_wp) * xx + &
+ 4.3352788e-1_wp) * xx + 6.228644e-1_wp
+ elseif (xx > -22.0_wp) then
+ gg = ((((((((-8.1537735e-14_wp * xx + 8.3232531e-13_wp) * xx + &
+ 1.0066362e-9_wp) * xx + 8.1048663e-8_wp) * xx + &
+ 3.2916354e-6_wp) * xx + 8.2711096e-5_wp) * xx + &
+ 1.3714667e-3_wp) * xx + 1.5017245e-2_wp) * xx + &
+ 4.3432642e-1_wp) * xx + 6.2337691e-1_wp
+ else
+ gg = 3.33338e-1_wp * xx + 3.0062102e-1_wp
+ end if
+ fl = exp(log((1.0_wp + exp(gg)) * dimob0) / 3.0_wp)
- end associate
+ end associate
-end subroutine shellg
+ end subroutine shellg
Arguments
|
-
+
real(kind=wp),
|
intent(inout), |
@@ -667,51 +667,51 @@ Graph Key
Source Code
- subroutine stoer(me,p,bq,r)
-
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(7),intent(inout) :: p
- real(wp),intent(out) :: bq
- real(wp),intent(out) :: r
-
- real(wp) :: dr , dsq , dx , dxm , dy , dym , dz , &
- dzm , fli , q , rq , wr , xm , ym , zm
-
- ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates
- zm = P(3)
- fli = P(1)*P(1) + P(2)*P(2) + 1.0e-15_wp
- R = 0.5_wp*(fli+sqrt(fli*fli+(zm+zm)**2))
- rq = R*R
- wr = sqrt(R)
- xm = P(1)*wr
- ym = P(2)*wr
- ! transform to geographic co-ordinate system
- me%Xi(1) = xm*u(1,1) + ym*u(1,2) + zm*u(1,3)
- me%Xi(2) = xm*u(2,1) + ym*u(2,2) + zm*u(2,3)
- me%Xi(3) = xm*u(3,1) + zm*u(3,3)
- ! compute derivatives
- ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results
- ! are the same; dkb Feb 1998.
- ! JW : feb 2024 : xi, h now class variables.
- call me%feldi()
- q = me%H(1)/rq
- dx = me%H(3) + me%H(3) + q*me%Xi(1)
- dy = me%H(4) + me%H(4) + q*me%Xi(2)
- dz = me%H(2) + me%H(2) + q*me%Xi(3)
- ! transform back to geomagnetic co-ordinate system
- dxm = u(1,1)*dx + u(2,1)*dy + u(3,1)*dz
- dym = u(1,2)*dx + u(2,2)*dy
- dzm = u(1,3)*dx + u(2,3)*dy + u(3,3)*dz
- dr = (xm*dxm+ym*dym+zm*dzm)/R
- ! form slowly varying expressions
- P(4) = (wr*dxm-0.5_wp*P(1)*dr)/(R*dzm)
- P(5) = (wr*dym-0.5_wp*P(2)*dr)/(R*dzm)
- dsq = rq*(dxm*dxm+dym*dym+dzm*dzm)
- Bq = dsq*rq*rq
- P(6) = sqrt(dsq/(rq+3.0_wp*zm*zm))
- P(7) = P(6)*(rq+zm*zm)/(rq*dzm)
-
-end subroutine stoer
+ subroutine stoer(me, p, bq, r)
+
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(7), intent(inout) :: p
+ real(wp), intent(out) :: bq
+ real(wp), intent(out) :: r
+
+ real(wp) :: dr, dsq, dx, dxm, dy, dym, dz, &
+ dzm, fli, q, rq, wr, xm, ym, zm
+
+ ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates
+ zm = P(3)
+ fli = P(1) * P(1) + P(2) * P(2) + 1.0e-15_wp
+ R = 0.5_wp * (fli + sqrt(fli * fli + (zm + zm)**2))
+ rq = R * R
+ wr = sqrt(R)
+ xm = P(1) * wr
+ ym = P(2) * wr
+ ! transform to geographic co-ordinate system
+ me%Xi(1) = xm * u(1, 1) + ym * u(1, 2) + zm * u(1, 3)
+ me%Xi(2) = xm * u(2, 1) + ym * u(2, 2) + zm * u(2, 3)
+ me%Xi(3) = xm * u(3, 1) + zm * u(3, 3)
+ ! compute derivatives
+ ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results
+ ! are the same; dkb Feb 1998.
+ ! JW : feb 2024 : xi, h now class variables.
+ call me%feldi()
+ q = me%H(1) / rq
+ dx = me%H(3) + me%H(3) + q * me%Xi(1)
+ dy = me%H(4) + me%H(4) + q * me%Xi(2)
+ dz = me%H(2) + me%H(2) + q * me%Xi(3)
+ ! transform back to geomagnetic co-ordinate system
+ dxm = u(1, 1) * dx + u(2, 1) * dy + u(3, 1) * dz
+ dym = u(1, 2) * dx + u(2, 2) * dy
+ dzm = u(1, 3) * dx + u(2, 3) * dy + u(3, 3) * dz
+ dr = (xm * dxm + ym * dym + zm * dzm) / R
+ ! form slowly varying expressions
+ P(4) = (wr * dxm - 0.5_wp * P(1) * dr) / (R * dzm)
+ P(5) = (wr * dym - 0.5_wp * P(2) * dr) / (R * dzm)
+ dsq = rq * (dxm * dxm + dym * dym + dzm * dzm)
+ Bq = dsq * rq * rq
+ P(6) = sqrt(dsq / (rq + 3.0_wp * zm * zm))
+ P(7) = P(6) * (rq + zm * zm) / (rq * dzm)
+
+ end subroutine stoer
Arguments
|
-
+
real(kind=wp),
|
intent(in) |
@@ -272,7 +272,7 @@ Arguments
|
-
+
integer,
|
intent(in) |
@@ -660,114 +660,114 @@ Graph Key
Source Code
- subroutine trara1(me,descr,map,fl,bb0,e,f,n)
-
- class(trm_type),intent(inout) :: me
- integer,intent(in) :: n !! number of energies
- integer,intent(in) :: descr(8) !! header of specified trapped radition model
- real(wp),intent(in) :: e(n) !! array of energies in mev
- real(wp),intent(in) :: fl !! l-value
- real(wp),intent(in) :: bb0 !! =b/b0 magnetic field strength normalized
+ subroutine trara1(me, descr, map, fl, bb0, e, f, n)
+
+ class(trm_type), intent(inout) :: me
+ integer, intent(in) :: n !! number of energies
+ integer, intent(in) :: descr(8) !! header of specified trapped radition model
+ real(wp), intent(in) :: e(n) !! array of energies in mev
+ real(wp), intent(in) :: fl !! l-value
+ real(wp), intent(in) :: bb0 !! =b/b0 magnetic field strength normalized
!! to field strength at magnetic equator
- integer,intent(in) :: map(*) !! map of trapped radition model
+ integer, intent(in) :: map(*) !! map of trapped radition model
!! (descr and map are explained at the begin
!! of the main program model)
- real(wp),intent(out) :: f(n) !! decadic logarithm of integral fluxes in
+ real(wp), intent(out) :: f(n) !! decadic logarithm of integral fluxes in
!! particles/(cm*cm*sec)
- real(wp) :: e0 , e1 , e2 , escale , f0 , fscale , xnl
- real(wp) :: bb0_ !! local copy of `bb0`. in the original code
+ real(wp) :: e0, e1, e2, escale, f0, fscale, xnl
+ real(wp) :: bb0_ !! local copy of `bb0`. in the original code
!! this was modified by this routine.
!! added this so `bb0` could be `intent(in)`
- integer :: i0 , i1 , i2 , i3 , ie , l3 , nb , nl
- logical :: s0 , s1 , s2
-
- e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
- f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
- i0 = 0 ! to avoid -Wmaybe-uninitialized warnings
- s0 = .false. ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW
-
- bb0_ = bb0
- me%fistep = descr(7)/descr(2)
- escale = descr(4)
- fscale = descr(7)
- xnl = min(15.6_wp,abs(fl))
- nl = int(xnl*descr(5))
- if ( bb0_<1.0_wp ) bb0_ = 1.0_wp
- nb = int((bb0_-1.0_wp)*descr(6))
-
- ! i2 is the number of elements in the flux map for the first energy.
- ! i3 is the index of the last element of the second energy map.
- ! l3 is the length of the map for the third energy.
- ! e1 is the energy of the first energy map (unscaled)
- ! e2 is the energy of the second energy map (unscaled)
- i1 = 0
- i2 = map(1)
- i3 = i2 + map(i2+1)
- l3 = map(i3+1)
- e1 = map(i1+2)/escale
- e2 = map(i2+2)/escale
-
- ! s0, s1, s2 are logical variables which indicate whether the flux for
- ! a particular e, b, l point has already been found in a previous call
- ! to function trara2. if not, s.. =.true.
- s1 = .true.
- s2 = .true.
-
- ! energy loop
-
- do ie = 1 , n
-
- ! for each energy e(i) find the successive energies e0,e1,e2 in
- ! model map, which obey e0 < e1 < e(i) < e2 .
-
- do while ( (e(ie)>e2) .and. (l3/=0) )
- i0 = i1
- i1 = i2
- i2 = i3
- i3 = i3 + l3
- l3 = map(i3+1)
- e0 = e1
- e1 = e2
- e2 = map(i2+2)/escale
- s0 = s1
- s1 = s2
- s2 = .true.
- f0 = me%f1
- me%f1 = me%f2
- enddo
-
- ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0-
- ! space to find fluxes f1,f2 [if they have not already been
- ! calculated for a previous e(i)].
-
- if ( s1 ) me%f1 = me%trara2(map(i1+3),nl,nb)/fscale
- if ( s2 ) me%f2 = me%trara2(map(i2+3),nl,nb)/fscale
- s1 = .false.
- s2 = .false.
-
- ! finally, interpolate in energy.
-
- f(ie) = me%f1 + (me%f2-me%f1)*(e(ie)-e1)/(e2-e1)
- if ( me%f2<=0.0_wp ) then
- if ( i1/=0 ) then
- ! --------- special interpolation ---------------------------------
- ! if the flux for the second energy cannot be found (i.e. f2=0.0),
- ! and the zeroth energy map has been defined (i.e. i1 not equal 0),
- ! then interpolate using the flux maps for the zeroth and first
- ! energy and choose the minimum of this interpolations and the
- ! interpolation that was done with f2=0.
- if ( s0 ) f0 = me%trara2(map(i0+3),nl,nb)/fscale
- s0 = .false.
- f(ie) = min(f(ie),f0+(me%f1-f0)*(e(ie)-e0)/(e1-e0))
- endif
- endif
-
- ! the logarithmic flux is always kept greater or equal zero.
-
- f(ie) = max(f(ie),0.0_wp)
- enddo
-end subroutine trara1
+ integer :: i0, i1, i2, i3, ie, l3, nb, nl
+ logical :: s0, s1, s2
+
+ e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+ f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+ i0 = 0 ! to avoid -Wmaybe-uninitialized warnings
+ s0 = .false. ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW
+
+ bb0_ = bb0
+ me%fistep = descr(7) / descr(2)
+ escale = descr(4)
+ fscale = descr(7)
+ xnl = min(15.6_wp, abs(fl))
+ nl = int(xnl * descr(5))
+ if (bb0_ < 1.0_wp) bb0_ = 1.0_wp
+ nb = int((bb0_ - 1.0_wp) * descr(6))
+
+ ! i2 is the number of elements in the flux map for the first energy.
+ ! i3 is the index of the last element of the second energy map.
+ ! l3 is the length of the map for the third energy.
+ ! e1 is the energy of the first energy map (unscaled)
+ ! e2 is the energy of the second energy map (unscaled)
+ i1 = 0
+ i2 = map(1)
+ i3 = i2 + map(i2 + 1)
+ l3 = map(i3 + 1)
+ e1 = map(i1 + 2) / escale
+ e2 = map(i2 + 2) / escale
+
+ ! s0, s1, s2 are logical variables which indicate whether the flux for
+ ! a particular e, b, l point has already been found in a previous call
+ ! to function trara2. if not, s.. =.true.
+ s1 = .true.
+ s2 = .true.
+
+ ! energy loop
+
+ do ie = 1, n
+
+ ! for each energy e(i) find the successive energies e0,e1,e2 in
+ ! model map, which obey e0 < e1 < e(i) < e2 .
+
+ do while ((e(ie) > e2) .and. (l3 /= 0))
+ i0 = i1
+ i1 = i2
+ i2 = i3
+ i3 = i3 + l3
+ l3 = map(i3 + 1)
+ e0 = e1
+ e1 = e2
+ e2 = map(i2 + 2) / escale
+ s0 = s1
+ s1 = s2
+ s2 = .true.
+ f0 = me%f1
+ me%f1 = me%f2
+ end do
+
+ ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0-
+ ! space to find fluxes f1,f2 [if they have not already been
+ ! calculated for a previous e(i)].
+
+ if (s1) me%f1 = me%trara2(map(i1 + 3), nl, nb) / fscale
+ if (s2) me%f2 = me%trara2(map(i2 + 3), nl, nb) / fscale
+ s1 = .false.
+ s2 = .false.
+
+ ! finally, interpolate in energy.
+
+ f(ie) = me%f1 + (me%f2 - me%f1) * (e(ie) - e1) / (e2 - e1)
+ if (me%f2 <= 0.0_wp) then
+ if (i1 /= 0) then
+ ! --------- special interpolation ---------------------------------
+ ! if the flux for the second energy cannot be found (i.e. f2=0.0),
+ ! and the zeroth energy map has been defined (i.e. i1 not equal 0),
+ ! then interpolate using the flux maps for the zeroth and first
+ ! energy and choose the minimum of this interpolations and the
+ ! interpolation that was done with f2=0.
+ if (s0) f0 = me%trara2(map(i0 + 3), nl, nb) / fscale
+ s0 = .false.
+ f(ie) = min(f(ie), f0 + (me%f1 - f0) * (e(ie) - e0) / (e1 - e0))
+ end if
+ end if
+
+ ! the logarithmic flux is always kept greater or equal zero.
+
+ f(ie) = max(f(ie), 0.0_wp)
+ end do
+ end subroutine trara1
Graph Key
Source Code
- function trara2(me,map,il,ib)
+ function trara2(me, map, il, ib)
- class(trm_type),intent(inout) :: me
- integer,intent(in) :: map(*) !! is sub-map (for specific energy) of
+ class(trm_type), intent(inout) :: me
+ integer, intent(in) :: map(*) !! is sub-map (for specific energy) of
!! trapped radiation model map
- integer,intent(in) :: il !! scaled l-value
- integer,intent(in) :: ib !! scaled b/b0-1
- real(wp) :: trara2 !! scaled logarithm of particle flux
-
- real(wp) :: dfl , fincr1 , fincr2 , fistep , fkb , fkb1 , fkb2 , fkbj1 , fkbj2 , &
- fkbm , fll1 , fll2 , flog , flog1 , flog2 , flogm , &
- fnb , fnl , sl1 , sl2
- integer :: i1 , i2 , itime , j1 , j2 , kt , l1 , l2
- logical :: dummy
-
- fistep = me%fistep
-
- !********
- ! to avoid -Wmaybe-uninitialized warning
- dfl = 0.0_wp
- fincr1 = 0.0_wp
- fincr2 = 0.0_wp
- fkb = 0.0_wp
- fkb1 = 0.0_wp
- fkb2 = 0.0_wp
- fkbm = 0.0_wp
- flog = 0.0_wp
- flog1 = 0.0_wp
- flog2 = 0.0_wp
- flogm = 0.0_wp
- fnb = 0.0_wp
- fnl = 0.0_wp
- sl2 = 0.0_wp
- i1 = 0
- i2 = 0
- itime = 0
- j2 = 0
- l1 = 0
- l2 = 0
- !********
-
- ! these are recursive functions that
- ! replace the gotos in the original code
- call task1(dummy)
-
- contains
-
- recursive subroutine task1(done)
- logical,intent(out) :: done
- done = .false.
- fnl = il
- fnb = ib
- itime = 0
- i2 = 0
- do
- ! find consecutive sub-sub-maps for scaled l-values ls1,ls2,
- ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps.
- ! i1,i2 are indeces of first elements minus 1.
- l2 = map(i2+1)
- if ( map(i2+2)<=il ) then
- i1 = i2
+ integer, intent(in) :: il !! scaled l-value
+ integer, intent(in) :: ib !! scaled b/b0-1
+ real(wp) :: trara2 !! scaled logarithm of particle flux
+
+ real(wp) :: dfl, fincr1, fincr2, fistep, fkb, fkb1, fkb2, fkbj1, fkbj2, &
+ fkbm, fll1, fll2, flog, flog1, flog2, flogm, &
+ fnb, fnl, sl1, sl2
+ integer :: i1, i2, itime, j1, j2, kt, l1, l2
+ logical :: dummy
+
+ fistep = me%fistep
+
+ !********
+ ! to avoid -Wmaybe-uninitialized warning
+ dfl = 0.0_wp
+ fincr1 = 0.0_wp
+ fincr2 = 0.0_wp
+ fkb = 0.0_wp
+ fkb1 = 0.0_wp
+ fkb2 = 0.0_wp
+ fkbm = 0.0_wp
+ flog = 0.0_wp
+ flog1 = 0.0_wp
+ flog2 = 0.0_wp
+ flogm = 0.0_wp
+ fnb = 0.0_wp
+ fnl = 0.0_wp
+ sl2 = 0.0_wp
+ i1 = 0
+ i2 = 0
+ itime = 0
+ j2 = 0
+ l1 = 0
+ l2 = 0
+ !********
+
+ ! these are recursive functions that
+ ! replace the gotos in the original code
+ call task1(dummy)
+
+ contains
+
+ recursive subroutine task1(done)
+ logical, intent(out) :: done
+ done = .false.
+ fnl = il
+ fnb = ib
+ itime = 0
+ i2 = 0
+ do
+ ! find consecutive sub-sub-maps for scaled l-values ls1,ls2,
+ ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps.
+ ! i1,i2 are indeces of first elements minus 1.
+ l2 = map(i2 + 1)
+ if (map(i2 + 2) <= il) then
+ i1 = i2
+ l1 = l2
+ i2 = i2 + l2
+ ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0
+ elseif ((l1 < 4) .and. (l2 < 4)) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ ! if flog2 less flog1, than ls2 first map and ls1 second map
+ if (map(i2 + 3) <= map(i1 + 3)) exit
+ call task3(done)
+ return
+ end if
+ end do
+ call task2(done)
+ end subroutine task1
+ recursive subroutine task2(done)
+ logical, intent(out) :: done
+ done = .false.
+ kt = i1
+ i1 = i2
+ i2 = kt
+ kt = l1
l1 = l2
- i2 = i2 + l2
- ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0
- elseif ( (l1<4) .and. (l2<4) ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- ! if flog2 less flog1, than ls2 first map and ls1 second map
- if ( map(i2+3)<=map(i1+3) ) exit
- call task3(done)
- return
- endif
- enddo
- call task2(done)
- end subroutine task1
- recursive subroutine task2(done)
- logical,intent(out) :: done
- done = .false.
- kt = i1
- i1 = i2
- i2 = kt
- kt = l1
- l1 = l2
- l2 = kt
- call task3(done)
- end subroutine task2
- recursive subroutine task3(done)
- logical,intent(out) :: done
- logical :: check
- done = .false.
- ! determine interpolate in scaled l-value
- fll1 = map(i1+2)
- fll2 = map(i2+2)
- dfl = (fnl-fll1)/(fll2-fll1)
- flog1 = map(i1+3)
- flog2 = map(i2+3)
- fkb1 = 0.0_wp
- fkb2 = 0.0_wp
- if ( l1>=4 ) then
- ! b/b0 loop
- check = .true.
- do j2 = 4 , l2
- fincr2 = map(i2+j2)
- if ( fkb2+fincr2>fnb ) then
- check = .false.
- exit
- end if
- fkb2 = fkb2 + fincr2
+ l2 = kt
+ call task3(done)
+ end subroutine task2
+ recursive subroutine task3(done)
+ logical, intent(out) :: done
+ logical :: check
+ done = .false.
+ ! determine interpolate in scaled l-value
+ fll1 = map(i1 + 2)
+ fll2 = map(i2 + 2)
+ dfl = (fnl - fll1) / (fll2 - fll1)
+ flog1 = map(i1 + 3)
+ flog2 = map(i2 + 3)
+ fkb1 = 0.0_wp
+ fkb2 = 0.0_wp
+ if (l1 >= 4) then
+ ! b/b0 loop
+ check = .true.
+ do j2 = 4, l2
+ fincr2 = map(i2 + j2)
+ if (fkb2 + fincr2 > fnb) then
+ check = .false.
+ exit
+ end if
+ fkb2 = fkb2 + fincr2
+ flog2 = flog2 - fistep
+ end do
+ if (check) then
+ itime = itime + 1
+ if (itime == 1) then
+ call task2(done)
+ return
+ end if
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ end if
+ if (itime /= 1) then
+ if (j2 == 4) then
+ call task4(done)
+ return
+ end if
+ sl2 = flog2 / fkb2
+ check = .true.
+ do j1 = 4, l1
+ fincr1 = map(i1 + j1)
+ fkb1 = fkb1 + fincr1
+ flog1 = flog1 - fistep
+ fkbj1 = ((flog1 / fistep) * fincr1 + fkb1) / ((fincr1 / fistep) * sl2 + 1.0_wp)
+ if (fkbj1 <= fkb1) then
+ check = .false.
+ exit
+ end if
+ end do
+ if (check) then
+ if (fkbj1 <= fkb2) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ end if
+ end if
+ if (fkbj1 <= fkb2) then
+ fkbm = fkbj1 + (fkb2 - fkbj1) * dfl
+ flogm = fkbm * sl2
+ flog2 = flog2 - fistep
+ fkb2 = fkb2 + fincr2
+ sl1 = flog1 / fkb1
+ sl2 = flog2 / fkb2
+ call task5(done)
+ return
+ else
+ fkb1 = 0.0_wp
+ end if
+ end if
+ fkb2 = 0.0_wp
+ end if
+ j2 = 4
+ fincr2 = map(i2 + j2)
+ flog2 = map(i2 + 3)
+ flog1 = map(i1 + 3)
+ call task4(done)
+ end subroutine task3
+ recursive subroutine task4(done)
+ logical, intent(out) :: done
+ done = .false.
+ flogm = flog1 + (flog2 - flog1) * dfl
+ fkbm = 0.0_wp
+ fkb2 = fkb2 + fincr2
flog2 = flog2 - fistep
- enddo
- if (check) then
- itime = itime + 1
- if ( itime==1 ) then
- call task2(done)
- return
- endif
- trara2 = 0.0_wp
- done = .true.
- return
- end if
- if ( itime/=1 ) then
- if ( j2==4 ) then
- call task4(done)
- return
- endif
- sl2 = flog2/fkb2
- check = .true.
- do j1 = 4 , l1
- fincr1 = map(i1+j1)
- fkb1 = fkb1 + fincr1
- flog1 = flog1 - fistep
- fkbj1 = ((flog1/fistep)*fincr1+fkb1)/((fincr1/fistep)*sl2+1.0_wp)
- if ( fkbj1<=fkb1 ) then
- check = .false.
- exit
- end if
- enddo
- if (check) then
- if ( fkbj1<=fkb2 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- endif
- end if
- if ( fkbj1<=fkb2 ) then
- fkbm = fkbj1 + (fkb2-fkbj1)*dfl
- flogm = fkbm*sl2
- flog2 = flog2 - fistep
- fkb2 = fkb2 + fincr2
- sl1 = flog1/fkb1
- sl2 = flog2/fkb2
- call task5(done)
- return
+ sl2 = flog2 / fkb2
+ if (l1 < 4) then
+ fincr1 = 0.0_wp
+ sl1 = -900000.0_wp
+ call task6(done)
+ return
else
- fkb1 = 0.0_wp
- endif
- endif
- fkb2 = 0.0_wp
- endif
- j2 = 4
- fincr2 = map(i2+j2)
- flog2 = map(i2+3)
- flog1 = map(i1+3)
- call task4(done)
- end subroutine task3
- recursive subroutine task4(done)
- logical,intent(out) :: done
- done = .false.
- flogm = flog1 + (flog2-flog1)*dfl
- fkbm = 0.0_wp
- fkb2 = fkb2 + fincr2
- flog2 = flog2 - fistep
- sl2 = flog2/fkb2
- if ( l1<4 ) then
- fincr1 = 0.0_wp
- sl1 = -900000.0_wp
- call task6(done)
- return
- else
- j1 = 4
- fincr1 = map(i1+j1)
- fkb1 = fkb1 + fincr1
- flog1 = flog1 - fistep
- sl1 = flog1/fkb1
- endif
- call task5(done)
- end subroutine task4
- recursive subroutine task5(done)
- logical,intent(out) :: done
- done = .false.
- do while ( sl1>=sl2 )
- fkbj2 = ((flog2/fistep)*fincr2+fkb2)/((fincr2/fistep)*sl1+1.0_wp)
- fkb = fkb1 + (fkbj2-fkb1)*dfl
- flog = fkb*sl1
- if ( fkb>=fnb ) then
+ j1 = 4
+ fincr1 = map(i1 + j1)
+ fkb1 = fkb1 + fincr1
+ flog1 = flog1 - fistep
+ sl1 = flog1 / fkb1
+ end if
+ call task5(done)
+ end subroutine task4
+ recursive subroutine task5(done)
+ logical, intent(out) :: done
+ done = .false.
+ do while (sl1 >= sl2)
+ fkbj2 = ((flog2 / fistep) * fincr2 + fkb2) / ((fincr2 / fistep) * sl1 + 1.0_wp)
+ fkb = fkb1 + (fkbj2 - fkb1) * dfl
+ flog = fkb * sl1
+ if (fkb >= fnb) then
+ call task7(done)
+ return
+ end if
+ fkbm = fkb
+ flogm = flog
+ if (j1 >= l1) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ j1 = j1 + 1
+ fincr1 = map(i1 + j1)
+ flog1 = flog1 - fistep
+ fkb1 = fkb1 + fincr1
+ sl1 = flog1 / fkb1
+ end if
+ end do
+ call task6(done)
+ end subroutine task5
+ recursive subroutine task6(done)
+ logical, intent(out) :: done
+ done = .false.
+ fkbj1 = ((flog1 / fistep) * fincr1 + fkb1) / ((fincr1 / fistep) * sl2 + 1.0_wp)
+ fkb = fkbj1 + (fkb2 - fkbj1) * dfl
+ flog = fkb * sl2
+ if (fkb < fnb) then
+ fkbm = fkb
+ flogm = flog
+ if (j2 >= l2) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ j2 = j2 + 1
+ fincr2 = map(i2 + j2)
+ flog2 = flog2 - fistep
+ fkb2 = fkb2 + fincr2
+ sl2 = flog2 / fkb2
+ call task5(done)
+ return
+ end if
+ end if
call task7(done)
- return
- endif
- fkbm = fkb
- flogm = flog
- if ( j1>=l1 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- j1 = j1 + 1
- fincr1 = map(i1+j1)
- flog1 = flog1 - fistep
- fkb1 = fkb1 + fincr1
- sl1 = flog1/fkb1
- endif
- enddo
- call task6(done)
- end subroutine task5
- recursive subroutine task6(done)
- logical,intent(out) :: done
- done = .false.
- fkbj1 = ((flog1/fistep)*fincr1+fkb1)/((fincr1/fistep)*sl2+1.0_wp)
- fkb = fkbj1 + (fkb2-fkbj1)*dfl
- flog = fkb*sl2
- if ( fkb<fnb ) then
- fkbm = fkb
- flogm = flog
- if ( j2>=l2 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- j2 = j2 + 1
- fincr2 = map(i2+j2)
- flog2 = flog2 - fistep
- fkb2 = fkb2 + fincr2
- sl2 = flog2/fkb2
- call task5(done)
- return
- endif
- endif
- call task7(done)
- end subroutine task6
- recursive subroutine task7(done)
- logical,intent(out) :: done
- if ( fkb<fkbm+1.0e-10_wp ) then
- trara2 = 0.0_wp
- else
- trara2 = flogm + (flog-flogm)*((fnb-fkbm)/(fkb-fkbm))
- trara2 = max(trara2,0.0_wp)
- endif
- done = .true.
- end subroutine task7
-
-end function trara2
+ end subroutine task6
+ recursive subroutine task7(done)
+ logical, intent(out) :: done
+ if (fkb < fkbm + 1.0e-10_wp) then
+ trara2 = 0.0_wp
+ else
+ trara2 = flogm + (flog - flogm) * ((fnb - fkbm) / (fkb - fkbm))
+ trara2 = max(trara2, 0.0_wp)
+ end if
+ done = .true.
+ end subroutine task7
+
+ end function trara2
Source Code
!>
! Experimental C interface to the radbelt module.
- module radbelt_c_module
+module radbelt_c_module
use iso_c_binding, only: c_double, c_int, c_char, c_null_char, &
c_intptr_t, c_ptr, c_loc, c_f_pointer, &
@@ -308,196 +308,196 @@ Source Code
implicit none
- contains
+contains
!*****************************************************************************************
!*****************************************************************************************
!>
! Convert C string to Fortran
-function c2f_str(cstr) result(fstr)
+ function c2f_str(cstr) result(fstr)
- character(kind=c_char,len=1),dimension(:),intent(in) :: cstr !! string from C
- character(len=:),allocatable :: fstr !! fortran string
+ character(kind=c_char, len=1), dimension(:), intent(in) :: cstr !! string from C
+ character(len=:), allocatable :: fstr !! fortran string
- integer :: i !! counter
+ integer :: i !! counter
- fstr = ''
- do i = 1, size(cstr)
- fstr = fstr//cstr(i)
- end do
- fstr = trim(fstr)
+ fstr = ''
+ do i = 1, size(cstr)
+ fstr = fstr//cstr(i)
+ end do
+ fstr = trim(fstr)
-end function c2f_str
+ end function c2f_str
!*****************************************************************************************
!>
! Convert an integer pointer to a [[radbelt_type]] pointer.
-subroutine int_pointer_to_f_pointer(ipointer, p)
+ subroutine int_pointer_to_f_pointer(ipointer, p)
- integer(c_intptr_t),intent(in) :: ipointer !! integer pointer from C
- type(radbelt_type),pointer :: p !! fortran pointer
+ integer(c_intptr_t), intent(in) :: ipointer !! integer pointer from C
+ type(radbelt_type), pointer :: p !! fortran pointer
- type(c_ptr) :: cp
+ type(c_ptr) :: cp
- cp = transfer(ipointer, c_null_ptr)
- if (c_associated(cp)) then
- call c_f_pointer(cp, p)
- else
- p => null()
- end if
+ cp = transfer(ipointer, c_null_ptr)
+ if (c_associated(cp)) then
+ call c_f_pointer(cp, p)
+ else
+ p => null()
+ end if
-end subroutine int_pointer_to_f_pointer
+ end subroutine int_pointer_to_f_pointer
!*****************************************************************************************
!>
! create a [[radbelt_type]] from C
-subroutine initialize_c(ipointer) bind(C, name="initialize_c")
+ subroutine initialize_c(ipointer) bind(C, name="initialize_c")
- integer(c_intptr_t),intent(out) :: ipointer
- type(radbelt_type),pointer :: p
- type(c_ptr) :: cp
+ integer(c_intptr_t), intent(out) :: ipointer
+ type(radbelt_type), pointer :: p
+ type(c_ptr) :: cp
- allocate(p)
- cp = c_loc(p)
- ipointer = transfer(cp, 0_c_intptr_t)
+ allocate (p)
+ cp = c_loc(p)
+ ipointer = transfer(cp, 0_c_intptr_t)
-end subroutine initialize_c
+ end subroutine initialize_c
!*****************************************************************************************
!>
! destroy a [[radbelt_type]] from C
-subroutine destroy_c(ipointer) bind(C, name="destroy_c")
+ subroutine destroy_c(ipointer) bind(C, name="destroy_c")
- integer(c_intptr_t),intent(in) :: ipointer
- type(radbelt_type),pointer :: p
+ integer(c_intptr_t), intent(in) :: ipointer
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer,p)
- if (associated(p)) deallocate(p)
+ call int_pointer_to_f_pointer(ipointer, p)
+ if (associated(p)) deallocate (p)
-end subroutine destroy_c
+ end subroutine destroy_c
!*****************************************************************************************
!>
! C interface for setting the `trm` data file path
-subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name="set_trm_file_path_c")
+ subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name="set_trm_file_path_c")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `aep8_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: aep8_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `aep8_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: aep8_dir
- character(len=:),allocatable :: aep8_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: aep8_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
- aep8_dir_ = c2f_str(aep8_dir)
- call p%set_trm_file_path(aep8_dir_)
- else
- error stop 'error in set_trm_file_path_c: class is not associated'
- end if
+ if (associated(p)) then
+ aep8_dir_ = c2f_str(aep8_dir)
+ call p%set_trm_file_path(aep8_dir_)
+ else
+ error stop 'error in set_trm_file_path_c: class is not associated'
+ end if
- end subroutine set_trm_file_path_c
+ end subroutine set_trm_file_path_c
!*****************************************************************************************
!*****************************************************************************************
!>
! C interface for setting the `igrf` data file path
- subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name="set_igrf_file_path")
+ subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name="set_igrf_file_path")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `igrf_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: igrf_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `igrf_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: igrf_dir
- character(len=:),allocatable :: igrf_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: igrf_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
- igrf_dir_ = c2f_str(igrf_dir)
- call p%set_igrf_file_path(igrf_dir_)
- else
- error stop 'error in set_igrf_file_path: class is not associated'
- end if
+ if (associated(p)) then
+ igrf_dir_ = c2f_str(igrf_dir)
+ call p%set_igrf_file_path(igrf_dir_)
+ else
+ error stop 'error in set_igrf_file_path: class is not associated'
+ end if
- end subroutine set_igrf_file_path_c
+ end subroutine set_igrf_file_path_c
!*****************************************************************************************
!*****************************************************************************************
!>
! C interface for setting the data file paths
- subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name="set_data_files_paths_c")
+ subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name="set_data_files_paths_c")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `aep8_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: aep8_dir
- integer(c_int),intent(in) :: m !! size of `igrf_dir`
- character(kind=c_char,len=1),dimension(m),intent(in) :: igrf_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `aep8_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: aep8_dir
+ integer(c_int), intent(in) :: m !! size of `igrf_dir`
+ character(kind=c_char, len=1), dimension(m), intent(in) :: igrf_dir
- character(len=:),allocatable :: aep8_dir_, igrf_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: aep8_dir_, igrf_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
+ if (associated(p)) then
- aep8_dir_ = c2f_str(aep8_dir)
- igrf_dir_ = c2f_str(igrf_dir)
+ aep8_dir_ = c2f_str(aep8_dir)
+ igrf_dir_ = c2f_str(igrf_dir)
- call p%set_data_files_paths(aep8_dir_, igrf_dir_)
+ call p%set_data_files_paths(aep8_dir_, igrf_dir_)
- else
- error stop 'error in set_data_files_paths_c: class is not associated'
- end if
+ else
+ error stop 'error in set_data_files_paths_c: class is not associated'
+ end if
- end subroutine set_data_files_paths_c
+ end subroutine set_data_files_paths_c
!*****************************************************************************************
!*****************************************************************************************
!>
! C interface to [[get_flux_g]].
-subroutine get_flux_g_c(ipointer,lon,lat,height,year,e,imname,flux) bind(C, name="get_flux_g_c")
+ subroutine get_flux_g_c(ipointer, lon, lat, height, year, e, imname, flux) bind(C, name="get_flux_g_c")
- integer(c_intptr_t),intent(in) :: ipointer
- real(c_double),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(c_double),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(c_double),intent(in) :: height !! altitude in km above sea level
- real(c_double),intent(in) :: year !! decimal year for which geomagnetic field is to
+ integer(c_intptr_t), intent(in) :: ipointer
+ real(c_double), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(c_double), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(c_double), intent(in) :: height !! altitude in km above sea level
+ real(c_double), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(c_double),intent(in) :: e !! minimum energy
- integer(c_int),intent(in) :: imname !! which method to use:
+ real(c_double), intent(in) :: e !! minimum energy
+ integer(c_int), intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(c_double),intent(out) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(c_double), intent(out) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type),pointer :: p
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
+ if (associated(p)) then
- flux = p%get_flux(lon,lat,height,year,e,imname)
+ flux = p%get_flux(lon, lat, height, year, e, imname)
- else
- error stop 'error in get_flux_g_c: class is not associated'
- end if
+ else
+ error stop 'error in get_flux_g_c: class is not associated'
+ end if
-end subroutine get_flux_g_c
+ end subroutine get_flux_g_c
!*****************************************************************************************
- end module radbelt_c_module
+end module radbelt_c_module
!*****************************************************************************************
Source Code
!>
! Numeric kind definitions for radbelt.
- module radbelt_kinds_module
+module radbelt_kinds_module
- use,intrinsic :: iso_fortran_env
+ use, intrinsic :: iso_fortran_env
implicit none
private
#ifdef REAL32
- integer,parameter,public :: wp = real32 !! Real working precision [4 bytes]
+ integer, parameter, public :: wp = real32 !! Real working precision [4 bytes]
#elif REAL64
- integer,parameter,public :: wp = real64 !! Real working precision [8 bytes]
+ integer, parameter, public :: wp = real64 !! Real working precision [8 bytes]
#elif REAL128
- integer,parameter,public :: wp = real128 !! Real working precision [16 bytes]
+ integer, parameter, public :: wp = real128 !! Real working precision [16 bytes]
#else
- integer,parameter,public :: wp = real64 !! Real working precision if not specified [8 bytes]
+ integer, parameter, public :: wp = real64 !! Real working precision if not specified [8 bytes]
#endif
#ifdef INT8
- integer,parameter,public :: ip = int8 !! Integer working precision [1 byte]
+ integer, parameter, public :: ip = int8 !! Integer working precision [1 byte]
#elif INT16
- integer,parameter,public :: ip = int16 !! Integer working precision [2 bytes]
+ integer, parameter, public :: ip = int16 !! Integer working precision [2 bytes]
#elif INT32
- integer,parameter,public :: ip = int32 !! Integer working precision [4 bytes]
+ integer, parameter, public :: ip = int32 !! Integer working precision [4 bytes]
#elif INT64
- integer,parameter,public :: ip = int64 !! Integer working precision [8 bytes]
+ integer, parameter, public :: ip = int64 !! Integer working precision [8 bytes]
#else
- integer,parameter,public :: ip = int32 !! Integer working precision if not specified [4 bytes]
+ integer, parameter, public :: ip = int32 !! Integer working precision if not specified [4 bytes]
#endif
!*****************************************************************************************
- end module radbelt_kinds_module
+end module radbelt_kinds_module
!*****************************************************************************************
Source Code
module radbelt_module
- use radbelt_kinds_module
- use trmfun_module
- use shellig_module
+ use radbelt_kinds_module
+ use trmfun_module
+ use shellig_module
- implicit none
+ implicit none
- type,public :: radbelt_type
- !! the main class that can be used to get the flux.
- private
- type(trm_type) :: trm
- type(shellig_type) :: igrf
- contains
- private
- generic,public :: get_flux => get_flux_g_, get_flux_c_
- procedure :: get_flux_g_, get_flux_c_
- procedure,public :: set_trm_file_path, &
- set_igrf_file_path, &
- set_data_files_paths
- end type radbelt_type
+ type, public :: radbelt_type
+ !! the main class that can be used to get the flux.
+ private
+ type(trm_type) :: trm
+ type(shellig_type) :: igrf
+ contains
+ private
+ generic, public :: get_flux => get_flux_g_, get_flux_c_
+ procedure :: get_flux_g_, get_flux_c_
+ procedure, public :: set_trm_file_path, &
+ set_igrf_file_path, &
+ set_data_files_paths
+ end type radbelt_type
- interface get_flux
- !! simple function versions for testing
- procedure :: get_flux_g
- procedure :: get_flux_c
- end interface
- public :: get_flux
+ interface get_flux
+ !! simple function versions for testing
+ procedure :: get_flux_g
+ procedure :: get_flux_c
+ end interface
+ public :: get_flux
- contains
+contains
!*****************************************************************************************
!>
! Set the `trm` path.
- subroutine set_trm_file_path(me, dir)
+ subroutine set_trm_file_path(me, dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
- call me%trm%set_data_file_dir(trim(dir))
+ call me%trm%set_data_file_dir(trim(dir))
- end subroutine set_trm_file_path
+ end subroutine set_trm_file_path
!*****************************************************************************************
!*****************************************************************************************
!>
! Set the `igrf` path.
- subroutine set_igrf_file_path(me, dir)
+ subroutine set_igrf_file_path(me, dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
- call me%igrf%set_data_file_dir(trim(dir))
+ call me%igrf%set_data_file_dir(trim(dir))
- end subroutine set_igrf_file_path
+ end subroutine set_igrf_file_path
!*****************************************************************************************
!*****************************************************************************************
@@ -440,46 +440,46 @@ Source Code
! If not used or blank, the folder `data/aep8` and `data/igrf` in the
! current working directory is assumed
- subroutine set_data_files_paths(me, aep8_dir, igrf_dir)
+ subroutine set_data_files_paths(me, aep8_dir, igrf_dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: aep8_dir
- character(len=*),intent(in) :: igrf_dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: aep8_dir
+ character(len=*), intent(in) :: igrf_dir
- call me%set_trm_file_path(trim(aep8_dir))
- call me%set_igrf_file_path(trim(igrf_dir))
+ call me%set_trm_file_path(trim(aep8_dir))
+ call me%set_igrf_file_path(trim(igrf_dir))
- end subroutine set_data_files_paths
+ end subroutine set_data_files_paths
!*****************************************************************************************
!*****************************************************************************************
!>
! Calculate the flux of trapped particles at a specific location and time.
- function get_flux_g_(me,lon,lat,height,year,e,imname) result(flux)
+ function get_flux_g_(me, lon, lat, height, year, e, imname) result(flux)
- class(radbelt_type),intent(inout) :: me
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(radbelt_type), intent(inout) :: me
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- real(wp) :: xl !! l value
- real(wp) :: bbx
+ real(wp) :: xl !! l value
+ real(wp) :: bbx
- call me%igrf%igrf(lon,lat,height,year,xl,bbx)
- call me%trm%aep8(e,xl,bbx,imname,flux)
+ call me%igrf%igrf(lon, lat, height, year, xl, bbx)
+ call me%trm%aep8(e, xl, bbx, imname, flux)
- end function get_flux_g_
+ end function get_flux_g_
!*****************************************************************************************
!*****************************************************************************************
@@ -490,27 +490,27 @@ Source Code
!@note This routine is not efficient at all since it will reload all the
! files every time it is called.
- function get_flux_g(lon,lat,height,year,e,imname) result(flux)
+ function get_flux_g(lon, lat, height, year, e, imname) result(flux)
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type) :: radbelt
+ type(radbelt_type) :: radbelt
- flux = radbelt%get_flux(lon,lat,height,year,e,imname)
+ flux = radbelt%get_flux(lon, lat, height, year, e, imname)
- end function get_flux_g
+ end function get_flux_g
!*****************************************************************************************
!*****************************************************************************************
@@ -518,28 +518,28 @@ Source Code
! Calculate the flux of trapped particles at a specific location and time.
! This is an alternate version of [[get_flux_g_]] for cartesian coordinates.
- function get_flux_c_(me,v,year,e,imname) result(flux)
+ function get_flux_c_(me, v, year, e, imname) result(flux)
- class(radbelt_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(radbelt_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- real(wp) :: xl !! l value
- real(wp) :: bbx
+ real(wp) :: xl !! l value
+ real(wp) :: bbx
- call me%igrf%igrfc(v,year,xl,bbx)
- call me%trm%aep8(e,xl,bbx,imname,flux)
+ call me%igrf%igrfc(v, year, xl, bbx)
+ call me%trm%aep8(e, xl, bbx, imname, flux)
- end function get_flux_c_
+ end function get_flux_c_
!*****************************************************************************************
!*****************************************************************************************
@@ -550,25 +550,25 @@ Source Code
!@note This routine is not efficient at all since it will reload all the
! files every time it is called.
- function get_flux_c(v,year,e,imname) result(flux)
+ function get_flux_c(v, year, e, imname) result(flux)
- real(wp),dimension(3),intent(in) :: v
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), dimension(3), intent(in) :: v
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type) :: radbelt
+ type(radbelt_type) :: radbelt
- flux = radbelt%get_flux(v,year,e,imname)
+ flux = radbelt%get_flux(v, year, e, imname)
- end function get_flux_c
+ end function get_flux_c
end module radbelt_module
diff --git a/sourcefile/shellig.f90.html b/sourcefile/shellig.f90.html
index 9592726..ca1b249 100644
--- a/sourcefile/shellig.f90.html
+++ b/sourcefile/shellig.f90.html
@@ -353,302 +353,302 @@ Source Code
! * 5/31/00-DKB- Updated to IGRF-45-00; new coeff.: IGRF00, IGRF00s
! * 3/24/05-DKB- Updated to IGRF-45-10; new coeff.: IGRF05, IGRF05s
- module shellig_module
+module shellig_module
- use radbelt_kinds_module
+ use radbelt_kinds_module
- implicit none
+ implicit none
- private
+ private
- integer,parameter :: filename_len = 14 !! length of the model data file names
+ integer, parameter :: filename_len = 14 !! length of the model data file names
- ! parameters formerly in `gener` common block
- real(wp),parameter :: Era = 6371.2_wp !! earth radius for normalization of cartesian coordinates (6371.2 km)
- real(wp),parameter :: erequ = 6378.16_wp
- real(wp),parameter :: erpol = 6356.775_wp
- real(wp),parameter :: Aquad = erequ*erequ !! square of major half axis for
+ ! parameters formerly in `gener` common block
+ real(wp), parameter :: Era = 6371.2_wp !! earth radius for normalization of cartesian coordinates (6371.2 km)
+ real(wp), parameter :: erequ = 6378.16_wp
+ real(wp), parameter :: erpol = 6356.775_wp
+ real(wp), parameter :: Aquad = erequ * erequ !! square of major half axis for
!! earth ellipsoid as recommended by international
!! astronomical union
- real(wp),parameter :: Bquad = erpol*erpol !! square of minor half axis for
+ real(wp), parameter :: Bquad = erpol * erpol !! square of minor half axis for
!! earth ellipsoid as recommended by international
!! astronomical union
- real(wp),parameter :: Umr = atan(1.0_wp)*4.0_wp/180.0_wp !! atan(1.0)*4./180. <degree>*umr=<radiant>
+ real(wp), parameter :: Umr = atan(1.0_wp) * 4.0_wp / 180.0_wp !! atan(1.0)*4./180. <degree>*umr=<radiant>
- real(wp),dimension(3,3),parameter :: u = reshape([ +0.3511737_wp , -0.9148385_wp , -0.1993679_wp , &
- +0.9335804_wp , +0.3583680_wp , +0.0000000_wp , &
- +0.0714471_wp , -0.1861260_wp , +0.9799247_wp], [3,3])
- integer,parameter :: max_loop_index = 3333 !! used in [[shellg]] for the field line integration loop
+ real(wp), dimension(3, 3), parameter :: u = reshape([+0.3511737_wp, -0.9148385_wp, -0.1993679_wp, &
+ +0.9335804_wp, +0.3583680_wp, +0.0000000_wp, &
+ +0.0714471_wp, -0.1861260_wp, +0.9799247_wp], [3, 3])
+ integer, parameter :: max_loop_index = 3333 !! used in [[shellg]] for the field line integration loop
- type,public :: shellig_type
- private
+ type, public :: shellig_type
+ private
- character(len=:),allocatable :: igrf_dir !! directory containing the data files
+ character(len=:), allocatable :: igrf_dir !! directory containing the data files
- ! formerly in the `fidb0` common block
- real(wp),dimension(3) :: sp = 0.0_wp
+ ! formerly in the `fidb0` common block
+ real(wp), dimension(3) :: sp = 0.0_wp
- ! formerly in blank common
- real(wp),dimension(3) :: xi = 0.0_wp
- real(wp),dimension(144) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]]
+ ! formerly in blank common
+ real(wp), dimension(3) :: xi = 0.0_wp
+ real(wp), dimension(144) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]]
- ! formerly in `model` common block
- integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read
- character(len=:),allocatable :: name !! file name
- integer :: nmax = 0 !! maximum order of spherical harmonics
- real(wp) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated
- real(wp),dimension(144) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2)
- integer :: nmax1 = 0 !! saved variables from the file
- integer :: nmax2 = 0 !! saved variables from the file
- real(wp),dimension(144) :: g_cache = 0.0_wp !! saved `g` from the file
+ ! formerly in `model` common block
+ integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read
+ character(len=:), allocatable :: name !! file name
+ integer :: nmax = 0 !! maximum order of spherical harmonics
+ real(wp) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated
+ real(wp), dimension(144) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2)
+ integer :: nmax1 = 0 !! saved variables from the file
+ integer :: nmax2 = 0 !! saved variables from the file
+ real(wp), dimension(144) :: g_cache = 0.0_wp !! saved `g` from the file
- ! formerly saved vars in shellg:
- real(wp) :: step = 0.20_wp !! step size for field line tracing
- real(wp) :: steq = 0.03_wp !! step size for integration
+ ! formerly saved vars in shellg:
+ real(wp) :: step = 0.20_wp !! step size for field line tracing
+ real(wp) :: steq = 0.03_wp !! step size for integration
- ! from feldcof, so we can cache the coefficients
- real(wp),dimension(120) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ???
+ ! from feldcof, so we can cache the coefficients
+ real(wp), dimension(120) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ???
- real(wp),dimension(:,:),allocatable :: p !! this was `p(8,100)` in the original code.
+ real(wp), dimension(:, :), allocatable :: p !! this was `p(8,100)` in the original code.
!! used for the field line integration loop.
!! changed it to be allocatable since it was
!! changed to be p(8,3334).
- contains
- private
+ contains
+ private
- procedure,public :: igrf, igrfc
+ procedure, public :: igrf, igrfc
- procedure, public :: feldcof
- procedure, public :: feldg, feldc
- procedure, public :: shellg, shellc
- procedure, public :: findb0
- procedure :: stoer, feldi
- procedure,public :: set_data_file_dir, get_data_file_dir
- procedure,public :: destroy => destroy_shellig_type
+ procedure, public :: feldcof
+ procedure, public :: feldg, feldc
+ procedure, public :: shellg, shellc
+ procedure, public :: findb0
+ procedure :: stoer, feldi
+ procedure, public :: set_data_file_dir, get_data_file_dir
+ procedure, public :: destroy => destroy_shellig_type
- end type shellig_type
+ end type shellig_type
- contains
+contains
!*****************************************************************************************
!*****************************************************************************************
!>
! Destroy a [[shellig_type]].
- subroutine destroy_shellig_type(me)
- class(shellig_type),intent(out) :: me
- end subroutine destroy_shellig_type
+ subroutine destroy_shellig_type(me)
+ class(shellig_type), intent(out) :: me
+ end subroutine destroy_shellig_type
!*****************************************************************************************
!>
! Set the directory containing the data files.
- subroutine set_data_file_dir(me,dir)
- class(shellig_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
- me%igrf_dir = trim(dir)
- end subroutine set_data_file_dir
+ subroutine set_data_file_dir(me, dir)
+ class(shellig_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
+ me%igrf_dir = trim(dir)
+ end subroutine set_data_file_dir
!*****************************************************************************************
!>
! Get the directory containing the data files.
- function get_data_file_dir(me) result(dir)
- class(shellig_type),intent(in) :: me
- character(len=:),allocatable :: dir
- if (allocated(me%igrf_dir)) then
- dir = trim(me%igrf_dir) // '/'
- else
- dir = 'data/igrf/' ! default
- end if
- end function get_data_file_dir
+ function get_data_file_dir(me) result(dir)
+ class(shellig_type), intent(in) :: me
+ character(len=:), allocatable :: dir
+ if (allocated(me%igrf_dir)) then
+ dir = trim(me%igrf_dir)//'/'
+ else
+ dir = 'data/igrf/' ! default
+ end if
+ end function get_data_file_dir
!*****************************************************************************************
!>
! Wrapper for IGRF functions.
- subroutine igrf(me,lon,lat,height,year,xl,bbx)
+ subroutine igrf(me, lon, lat, height, year, xl, bbx)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: xl !! l-value
- real(wp),intent(out) :: bbx !! b_total / b_equatorial ratio
+ real(wp), intent(out) :: xl !! l-value
+ real(wp), intent(out) :: bbx !! b_total / b_equatorial ratio
- real(wp) :: bab1 , babs , bdel , bdown , beast , &
- beq , bequ , bnorth , dimo , rr0
- integer :: icode
- logical :: val
+ real(wp) :: bab1, babs, bdel, bdown, beast, &
+ beq, bequ, bnorth, dimo, rr0
+ integer :: icode
+ logical :: val
- real(wp),parameter :: stps = 0.05_wp
+ real(wp), parameter :: stps = 0.05_wp
- ! JW : do we need to reset some or all of these ?
- me%sp = 0.0_wp
- me%xi = 0.0_wp
- me%h = 0.0_wp
- me%step = 0.20_wp
- me%steq = 0.03_wp
+ ! JW : do we need to reset some or all of these ?
+ me%sp = 0.0_wp
+ me%xi = 0.0_wp
+ me%h = 0.0_wp
+ me%step = 0.20_wp
+ me%steq = 0.03_wp
- call me%feldcof(year,dimo)
- call me%feldg(lat,lon,height,bnorth,beast,bdown,babs)
- call me%shellg(lat,lon,height,dimo,xl,icode,bab1)
+ call me%feldcof(year, dimo)
+ call me%feldg(lat, lon, height, bnorth, beast, bdown, babs)
+ call me%shellg(lat, lon, height, dimo, xl, icode, bab1)
- bequ = dimo/(xl*xl*xl)
- if ( icode==1 ) then
- bdel = 1.0e-3_wp
- call me%findb0(stps,bdel,val,beq,rr0)
- if ( val ) bequ = beq
- endif
- bbx = babs/bequ
+ bequ = dimo / (xl * xl * xl)
+ if (icode == 1) then
+ bdel = 1.0e-3_wp
+ call me%findb0(stps, bdel, val, beq, rr0)
+ if (val) bequ = beq
+ end if
+ bbx = babs / bequ
- end subroutine igrf
+ end subroutine igrf
!*****************************************************************************************
!*****************************************************************************************
!>
! Alternate version of [[igrf]] for cartesian coordinates.
- subroutine igrfc(me,v,year,xl,bbx)
+ subroutine igrfc(me, v, year, xl, bbx)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! x-axis pointing to equator at 0 longitude
!! y-axis pointing to equator at 90 long.
!! z-axis pointing to north pole
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: xl !! l-value
- real(wp),intent(out) :: bbx !! b_total / b_equatorial ratio
+ real(wp), intent(out) :: xl !! l-value
+ real(wp), intent(out) :: bbx !! b_total / b_equatorial ratio
- real(wp) :: bab1 , bdel , beq , bequ , dimo , rr0
- integer :: icode
- logical :: val
- real(wp),dimension(3) :: b
+ real(wp) :: bab1, bdel, beq, bequ, dimo, rr0
+ integer :: icode
+ logical :: val
+ real(wp), dimension(3) :: b
- real(wp),parameter :: stps = 0.05_wp
+ real(wp), parameter :: stps = 0.05_wp
- ! JW : do we need to reset some or all of these ?
- me%sp = 0.0_wp
- me%xi = 0.0_wp
- me%h = 0.0_wp
- me%step = 0.20_wp
- me%steq = 0.03_wp
+ ! JW : do we need to reset some or all of these ?
+ me%sp = 0.0_wp
+ me%xi = 0.0_wp
+ me%h = 0.0_wp
+ me%step = 0.20_wp
+ me%steq = 0.03_wp
- call me%feldcof(year,dimo)
- call me%feldc(v,b)
- call me%shellc(v,dimo,xl,icode,bab1)
+ call me%feldcof(year, dimo)
+ call me%feldc(v, b)
+ call me%shellc(v, dimo, xl, icode, bab1)
- bequ = dimo/(xl*xl*xl)
- if ( icode==1 ) then
- bdel = 1.0e-3_wp
- call me%findb0(stps,bdel,val,beq,rr0)
- if ( val ) bequ = beq
- endif
- bbx = norm2(b)/bequ
+ bequ = dimo / (xl * xl * xl)
+ if (icode == 1) then
+ bdel = 1.0e-3_wp
+ call me%findb0(stps, bdel, val, beq, rr0)
+ if (val) bequ = beq
+ end if
+ bbx = norm2(b) / bequ
- end subroutine igrfc
+ end subroutine igrfc
!*****************************************************************************************
!*****************************************************************************************
!>
- subroutine findb0(me,stps,bdel,value,bequ,rr0)
+ subroutine findb0(me, stps, bdel, value, bequ, rr0)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: stps
- real(wp),intent(inout) :: bdel
- real(wp),intent(out) :: bequ
- logical,intent(out) :: value
- real(wp),intent(out) :: rr0
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: stps
+ real(wp), intent(inout) :: bdel
+ real(wp), intent(out) :: bequ
+ logical, intent(out) :: value
+ real(wp), intent(out) :: rr0
- real(wp) :: b , bdelta , bmin , bold , bq1 , &
- bq2 , bq3 , p(8,4) , r1 , r2 , r3 , &
- rold , step , step12 , zz
- integer :: i , irun , j , n
+ real(wp) :: b, bdelta, bmin, bold, bq1, &
+ bq2, bq3, p(8, 4), r1, r2, r3, &
+ rold, step, step12, zz
+ integer :: i, irun, j, n
- step=stps
- irun=0
- rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+ step = stps
+ irun = 0
+ rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
- main : do
- irun=irun+1
- if (irun>5) then
- value=.false.
- exit main
- endif
- ! first three points
- p(1,2)=me%sp(1)
- p(2,2)=me%sp(2)
- p(3,2)=me%sp(3)
- step=-sign(step,p(3,2))
- call me%stoer(p(1,2),bq2,r2)
- p(1,3)=p(1,2)+0.5_wp*step*p(4,2)
- p(2,3)=p(2,2)+0.5_wp*step*p(5,2)
- p(3,3)=p(3,2)+0.5_wp*step
- call me%stoer(p(1,3),bq3,r3)
- p(1,1)=p(1,2)-step*(2.0_wp*p(4,2)-p(4,3))
- p(2,1)=p(2,2)-step*(2.0_wp*p(5,2)-p(5,3))
- p(3,1)=p(3,2)-step
- call me%stoer(p(1,1),bq1,r1)
- p(1,3)=p(1,2)+step*(20.0_wp*p(4,3)-3.*p(4,2)+p(4,1))/18.0_wp
- p(2,3)=p(2,2)+step*(20.0_wp*p(5,3)-3.*p(5,2)+p(5,1))/18.0_wp
- p(3,3)=p(3,2)+step
- call me%stoer(p(1,3),bq3,r3)
- ! invert sense if required
- if (bq3>bq1) then
- step=-step
- r3=r1
- bq3=bq1
- do i=1,5
- zz=p(i,1)
- p(i,1)=p(i,3)
- p(i,3)=zz
- end do
- end if
- ! initialization
- step12=step/12.0_wp
- value=.true.
- bmin=1.0e4_wp
- bold=1.0e4_wp
- ! corrector (field line tracing)
- n=0
- corrector : do
- p(1,3)=p(1,2)+step12*(5.0_wp*p(4,3)+8.0_wp*p(4,2)-p(4,1))
- n=n+1
- p(2,3)=p(2,2)+step12*(5.0_wp*p(5,3)+8.0_wp*p(5,2)-p(5,1))
- ! predictor (field line tracing)
- p(1,4)=p(1,3)+step12*(23.0_wp*p(4,3)-16.0_wp*p(4,2)+5.0_wp*p(4,1))
- p(2,4)=p(2,3)+step12*(23.0_wp*p(5,3)-16.0_wp*p(5,2)+5.0_wp*p(5,1))
- p(3,4)=p(3,3)+step
- call me%stoer(p(1,4),bq3,r3)
- do j=1,3
- do i=1,8
- p(i,j)=p(i,j+1)
- end do
- end do
- b=sqrt(bq3)
- if (b<bmin) bmin=b
- if (b>bold) exit corrector
- bold=b
- rold=1.0_wp/r3
- me%sp(1)=p(1,4)
- me%sp(2)=p(2,4)
- me%sp(3)=p(3,4)
- end do corrector
- if (bold/=bmin) value=.false.
- bdelta=(b-bold)/bold
- if (bdelta<=bdel) exit main
- step=step/10.0_wp
- end do main
+ main: do
+ irun = irun + 1
+ if (irun > 5) then
+ value = .false.
+ exit main
+ end if
+ ! first three points
+ p(1, 2) = me%sp(1)
+ p(2, 2) = me%sp(2)
+ p(3, 2) = me%sp(3)
+ step = -sign(step, p(3, 2))
+ call me%stoer(p(1, 2), bq2, r2)
+ p(1, 3) = p(1, 2) + 0.5_wp * step * p(4, 2)
+ p(2, 3) = p(2, 2) + 0.5_wp * step * p(5, 2)
+ p(3, 3) = p(3, 2) + 0.5_wp * step
+ call me%stoer(p(1, 3), bq3, r3)
+ p(1, 1) = p(1, 2) - step * (2.0_wp * p(4, 2) - p(4, 3))
+ p(2, 1) = p(2, 2) - step * (2.0_wp * p(5, 2) - p(5, 3))
+ p(3, 1) = p(3, 2) - step
+ call me%stoer(p(1, 1), bq1, r1)
+ p(1, 3) = p(1, 2) + step * (20.0_wp * p(4, 3) - 3.*p(4, 2) + p(4, 1)) / 18.0_wp
+ p(2, 3) = p(2, 2) + step * (20.0_wp * p(5, 3) - 3.*p(5, 2) + p(5, 1)) / 18.0_wp
+ p(3, 3) = p(3, 2) + step
+ call me%stoer(p(1, 3), bq3, r3)
+ ! invert sense if required
+ if (bq3 > bq1) then
+ step = -step
+ r3 = r1
+ bq3 = bq1
+ do i = 1, 5
+ zz = p(i, 1)
+ p(i, 1) = p(i, 3)
+ p(i, 3) = zz
+ end do
+ end if
+ ! initialization
+ step12 = step / 12.0_wp
+ value = .true.
+ bmin = 1.0e4_wp
+ bold = 1.0e4_wp
+ ! corrector (field line tracing)
+ n = 0
+ corrector: do
+ p(1, 3) = p(1, 2) + step12 * (5.0_wp * p(4, 3) + 8.0_wp * p(4, 2) - p(4, 1))
+ n = n + 1
+ p(2, 3) = p(2, 2) + step12 * (5.0_wp * p(5, 3) + 8.0_wp * p(5, 2) - p(5, 1))
+ ! predictor (field line tracing)
+ p(1, 4) = p(1, 3) + step12 * (23.0_wp * p(4, 3) - 16.0_wp * p(4, 2) + 5.0_wp * p(4, 1))
+ p(2, 4) = p(2, 3) + step12 * (23.0_wp * p(5, 3) - 16.0_wp * p(5, 2) + 5.0_wp * p(5, 1))
+ p(3, 4) = p(3, 3) + step
+ call me%stoer(p(1, 4), bq3, r3)
+ do j = 1, 3
+ do i = 1, 8
+ p(i, j) = p(i, j + 1)
+ end do
+ end do
+ b = sqrt(bq3)
+ if (b < bmin) bmin = b
+ if (b > bold) exit corrector
+ bold = b
+ rold = 1.0_wp / r3
+ me%sp(1) = p(1, 4)
+ me%sp(2) = p(2, 4)
+ me%sp(3) = p(3, 4)
+ end do corrector
+ if (bold /= bmin) value = .false.
+ bdelta = (b - bold) / bold
+ if (bdelta <= bdel) exit main
+ step = step / 10.0_wp
+ end do main
- rr0=rold
- bequ=bold
- bdel=bdelta
+ rr0 = rold
+ bequ = bold
+ bdel = bdelta
- end subroutine findb0
+ end subroutine findb0
!*****************************************************************************************
!>
@@ -657,26 +657,26 @@ Source Code
!@note In the original code, this was an ENTRY point in [[shellg]] and didn't
! include all the outputs.
- subroutine shellc(me,v,dimo,fl,icode,b0)
+ subroutine shellc(me, v, dimo, fl, icode, b0)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
!! * z-axis pointing to north pole
- real(wp),intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
- real(wp),intent(out) :: fl !! l-value
- integer,intent(out) :: icode !! * =1 normal completion
+ real(wp), intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
+ real(wp), intent(out) :: fl !! l-value
+ integer, intent(out) :: icode !! * =1 normal completion
!! * =2 unphysical conjugate point (fl meaningless)
!! * =3 shell parameter greater than limit up to
!! which accurate calculation is required;
!! approximation is used.
- real(wp),intent(out) :: b0 !! magnetic field strength in gauss
- real(wp) :: glat,glon,alt !! not used
+ real(wp), intent(out) :: b0 !! magnetic field strength in gauss
+ real(wp) :: glat, glon, alt !! not used
- call me%shellg(glat,glon,alt,dimo,fl,icode,b0,v)
+ call me%shellg(glat, glon, alt, dimo, fl, icode, b0, v)
- end subroutine shellc
+ end subroutine shellc
!*****************************************************************************************
!>
@@ -693,21 +693,21 @@ Source Code
! - USING CORRECT DIPOL MOMENT I.E.,DIFFERENT COMMON/MODEL/
! - USING IGRF EARTH MAGNETIC FIELD MODELS FROM 1945 TO 1990
- subroutine shellg(me,glat,glon,alt,dimo,fl,icode,b0,v)
+ subroutine shellg(me, glat, glon, alt, dimo, fl, icode, b0, v)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: glat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: glon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: alt !! altitude in km above sea level
- real(wp),intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
- real(wp),intent(out) :: fl !! l-value
- integer,intent(out) :: icode !! * =1 normal completion
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: glat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: glon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: alt !! altitude in km above sea level
+ real(wp), intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
+ real(wp), intent(out) :: fl !! l-value
+ integer, intent(out) :: icode !! * =1 normal completion
!! * =2 unphysical conjugate point (fl meaningless)
!! * =3 shell parameter greater than limit up to
!! which accurate calculation is required;
!! approximation is used.
- real(wp),intent(out) :: b0 !! magnetic field strength in gauss
- real(wp),dimension(3),intent(in),optional :: v !! cartesian coordinates in earth radii (6371.2 km)
+ real(wp), intent(out) :: b0 !! magnetic field strength in gauss
+ real(wp), dimension(3), intent(in), optional :: v !! cartesian coordinates in earth radii (6371.2 km)
!!
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
@@ -716,251 +716,251 @@ Source Code
!! If this argument is present, it is used
!! instead of glat,glon,alt. See [[shellc]].
- real(wp) :: arg1 , arg2 , bequ , bq1 , bq2 , bq3 , c0 , c1 , c2 , c3 , &
- d0 , d1 , d2, dimob0 , e0 , e1 , e2 , ff , fi , gg , &
- hli , oradik , oterm , r , r1 , r2 , r3 , r3h , radik , &
- rq , step12 , step2 , stp , t , term , xx , z , zq , zz
- integer :: i , iequ , n
+ real(wp) :: arg1, arg2, bequ, bq1, bq2, bq3, c0, c1, c2, c3, &
+ d0, d1, d2, dimob0, e0, e1, e2, ff, fi, gg, &
+ hli, oradik, oterm, r, r1, r2, r3, r3h, radik, &
+ rq, step12, step2, stp, t, term, xx, z, zq, zz
+ integer :: i, iequ, n
- real(wp),parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3`
- real(wp),parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3`
+ real(wp), parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3`
+ real(wp), parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3`
- if (.not. allocated(me%p)) allocate(me%p(8,max_loop_index+1)) ! because `p(:,n+1)` in the loop
+ if (.not. allocated(me%p)) allocate (me%p(8, max_loop_index + 1)) ! because `p(:,n+1)` in the loop
- bequ = 1.0e10_wp
+ bequ = 1.0e10_wp
- if (present(v)) then
- me%xi(1) = v(1)
- me%xi(2) = v(2)
- me%xi(3) = v(3)
- else
- me%xi = geo_to_cart(glat,glon,alt)
- end if
+ if (present(v)) then
+ me%xi(1) = v(1)
+ me%xi(2) = v(2)
+ me%xi(3) = v(3)
+ else
+ me%xi = geo_to_cart(glat, glon, alt)
+ end if
- associate (p => me%p)
+ associate (p => me%p)
- ! convert to dipol-oriented co-ordinates
- rq = 1.0_wp/(me%xi(1)*me%xi(1)+me%xi(2)*me%xi(2)+me%xi(3)*me%xi(3))
- r3h = sqrt(rq*sqrt(rq))
- p(1,2) = (me%xi(1)*u(1,1)+me%xi(2)*u(2,1)+me%xi(3)*u(3,1))*r3h
- p(2,2) = (me%xi(1)*u(1,2)+me%xi(2)*u(2,2))*r3h
- p(3,2) = (me%xi(1)*u(1,3)+me%xi(2)*u(2,3)+me%xi(3)*u(3,3))*rq
- ! first three points of field line
- me%step = -sign(me%step,p(3,2))
- call me%stoer(p(1,2),bq2,r2)
- b0 = sqrt(bq2)
- p(1,3) = p(1,2) + 0.5_wp*me%step*p(4,2)
- p(2,3) = p(2,2) + 0.5_wp*me%step*p(5,2)
- p(3,3) = p(3,2) + 0.5_wp*me%step
- call me%stoer(p(1,3),bq3,r3)
- p(1,1) = p(1,2) - me%step*(2.0_wp*p(4,2)-p(4,3))
- p(2,1) = p(2,2) - me%step*(2.0_wp*p(5,2)-p(5,3))
- p(3,1) = p(3,2) - me%step
- call me%stoer(p(1,1),bq1,r1)
- p(1,3) = p(1,2) + me%step*(20.0_wp*p(4,3)-3.*p(4,2)+p(4,1))/18.0_wp
- p(2,3) = p(2,2) + me%step*(20.0_wp*p(5,3)-3.*p(5,2)+p(5,1))/18.0_wp
- p(3,3) = p(3,2) + me%step
- call me%stoer(p(1,3),bq3,r3)
- ! invert sense if required
- if ( bq3>bq1 ) then
- me%step = -me%step
- r3 = r1
- bq3 = bq1
- do i = 1 , 7
- zz = p(i,1)
- p(i,1) = p(i,3)
- p(i,3) = zz
- enddo
- endif
- ! search for lowest magnetic field strength
- if ( bq1<bequ ) then
- bequ = bq1
- iequ = 1
- endif
- if ( bq2<bequ ) then
- bequ = bq2
- iequ = 2
- endif
- if ( bq3<bequ ) then
- bequ = bq3
- iequ = 3
- endif
- ! initialization of integration loops
- step12 = me%step/12.0_wp
- step2 = me%step + me%step
- me%steq = sign(me%steq,me%step)
- fi = 0.0_wp
- icode = 1
- oradik = 0.0_wp
- oterm = 0.0_wp
- stp = r2*me%steq
- z = p(3,2) + stp
- stp = stp/0.75_wp
- p(8,1) = step2*(p(1,1)*p(4,1)+p(2,1)*p(5,1))
- p(8,2) = step2*(p(1,2)*p(4,2)+p(2,2)*p(5,2))
- ! main loop (field line tracing)
- main: do n = 3 , max_loop_index
- ! corrector (field line tracing)
- p(1,n) = p(1,n-1) + step12*(5.0_wp*p(4,n)+8.0_wp*p(4,n-1)-p(4,n-2))
- p(2,n) = p(2,n-1) + step12*(5.0_wp*p(5,n)+8.0_wp*p(5,n-1)-p(5,n-2))
- ! prepare expansion coefficients for interpolation
- ! of slowly varying quantities
- p(8,n) = step2*(p(1,n)*p(4,n)+p(2,n)*p(5,n))
- c0 = p(1,n-1)**2 + p(2,n-1)**2
- c1 = p(8,n-1)
- c2 = (p(8,n)-p(8,n-2))*0.25_wp
- c3 = (p(8,n)+p(8,n-2)-c1-c1)/6.0_wp
- d0 = p(6,n-1)
- d1 = (p(6,n)-p(6,n-2))*0.5_wp
- d2 = (p(6,n)+p(6,n-2)-d0-d0)*0.5_wp
- e0 = p(7,n-1)
- e1 = (p(7,n)-p(7,n-2))*0.5_wp
- e2 = (p(7,n)+p(7,n-2)-e0-e0)*0.5_wp
- inner: do
- ! inner loop (for quadrature)
- t = (z-p(3,n-1))/me%step
- if ( t>1.0_wp ) then
- ! predictor (field line tracing)
- p(1,n+1) = p(1,n) + step12*(23.0_wp*p(4,n)-16.0_wp*p(4,n-1)+5.0_wp*p(4,n-2))
- p(2,n+1) = p(2,n) + step12*(23.0_wp*p(5,n)-16.0_wp*p(5,n-1)+5.0_wp*p(5,n-2))
- p(3,n+1) = p(3,n) + me%step
- call me%stoer(p(1,n+1),bq3,r3)
- ! search for lowest magnetic field strength
- if ( bq3<bequ ) then
- iequ = n + 1
- bequ = bq3
- endif
- exit inner
- else
- hli = 0.5_wp*(((c3*t+c2)*t+c1)*t+c0)
- zq = z*z
- r = hli + sqrt(hli*hli+zq)
- if ( r<=rmin ) then
- ! approximation for high values of l.
- icode = 3
- t = -p(3,n-1)/me%step
- fl = 1.0_wp/(abs(((c3*t+c2)*t+c1)*t+c0)+1.0e-15_wp)
- return
- endif
- rq = r*r
- ff = sqrt(1.0_wp+3.0_wp*zq/rq)
- radik = b0 - ((d2*t+d1)*t+d0)*r*rq*ff
- if ( r>rmax ) then
- icode = 2
- radik = radik - 12.0_wp*(r-rmax)**2
- endif
- if ( radik+radik<=oradik ) exit main
- term = sqrt(radik)*ff*((e2*t+e1)*t+e0)/(rq+zq)
- fi = fi + stp*(oterm+term)
- oradik = radik
- oterm = term
- stp = r*me%steq
- z = z + stp
- endif
- enddo inner
- enddo main
- if ( iequ<2 ) iequ = 2
- me%sp(1) = p(1,iequ-1)
- me%sp(2) = p(2,iequ-1)
- me%sp(3) = p(3,iequ-1)
- if ( oradik>=1.0e-15_wp ) fi = fi + stp/0.75_wp*oterm*oradik/(oradik-radik)
+ ! convert to dipol-oriented co-ordinates
+ rq = 1.0_wp / (me%xi(1) * me%xi(1) + me%xi(2) * me%xi(2) + me%xi(3) * me%xi(3))
+ r3h = sqrt(rq * sqrt(rq))
+ p(1, 2) = (me%xi(1) * u(1, 1) + me%xi(2) * u(2, 1) + me%xi(3) * u(3, 1)) * r3h
+ p(2, 2) = (me%xi(1) * u(1, 2) + me%xi(2) * u(2, 2)) * r3h
+ p(3, 2) = (me%xi(1) * u(1, 3) + me%xi(2) * u(2, 3) + me%xi(3) * u(3, 3)) * rq
+ ! first three points of field line
+ me%step = -sign(me%step, p(3, 2))
+ call me%stoer(p(1, 2), bq2, r2)
+ b0 = sqrt(bq2)
+ p(1, 3) = p(1, 2) + 0.5_wp * me%step * p(4, 2)
+ p(2, 3) = p(2, 2) + 0.5_wp * me%step * p(5, 2)
+ p(3, 3) = p(3, 2) + 0.5_wp * me%step
+ call me%stoer(p(1, 3), bq3, r3)
+ p(1, 1) = p(1, 2) - me%step * (2.0_wp * p(4, 2) - p(4, 3))
+ p(2, 1) = p(2, 2) - me%step * (2.0_wp * p(5, 2) - p(5, 3))
+ p(3, 1) = p(3, 2) - me%step
+ call me%stoer(p(1, 1), bq1, r1)
+ p(1, 3) = p(1, 2) + me%step * (20.0_wp * p(4, 3) - 3.*p(4, 2) + p(4, 1)) / 18.0_wp
+ p(2, 3) = p(2, 2) + me%step * (20.0_wp * p(5, 3) - 3.*p(5, 2) + p(5, 1)) / 18.0_wp
+ p(3, 3) = p(3, 2) + me%step
+ call me%stoer(p(1, 3), bq3, r3)
+ ! invert sense if required
+ if (bq3 > bq1) then
+ me%step = -me%step
+ r3 = r1
+ bq3 = bq1
+ do i = 1, 7
+ zz = p(i, 1)
+ p(i, 1) = p(i, 3)
+ p(i, 3) = zz
+ end do
+ end if
+ ! search for lowest magnetic field strength
+ if (bq1 < bequ) then
+ bequ = bq1
+ iequ = 1
+ end if
+ if (bq2 < bequ) then
+ bequ = bq2
+ iequ = 2
+ end if
+ if (bq3 < bequ) then
+ bequ = bq3
+ iequ = 3
+ end if
+ ! initialization of integration loops
+ step12 = me%step / 12.0_wp
+ step2 = me%step + me%step
+ me%steq = sign(me%steq, me%step)
+ fi = 0.0_wp
+ icode = 1
+ oradik = 0.0_wp
+ oterm = 0.0_wp
+ stp = r2 * me%steq
+ z = p(3, 2) + stp
+ stp = stp / 0.75_wp
+ p(8, 1) = step2 * (p(1, 1) * p(4, 1) + p(2, 1) * p(5, 1))
+ p(8, 2) = step2 * (p(1, 2) * p(4, 2) + p(2, 2) * p(5, 2))
+ ! main loop (field line tracing)
+ main: do n = 3, max_loop_index
+ ! corrector (field line tracing)
+ p(1, n) = p(1, n - 1) + step12 * (5.0_wp * p(4, n) + 8.0_wp * p(4, n - 1) - p(4, n - 2))
+ p(2, n) = p(2, n - 1) + step12 * (5.0_wp * p(5, n) + 8.0_wp * p(5, n - 1) - p(5, n - 2))
+ ! prepare expansion coefficients for interpolation
+ ! of slowly varying quantities
+ p(8, n) = step2 * (p(1, n) * p(4, n) + p(2, n) * p(5, n))
+ c0 = p(1, n - 1)**2 + p(2, n - 1)**2
+ c1 = p(8, n - 1)
+ c2 = (p(8, n) - p(8, n - 2)) * 0.25_wp
+ c3 = (p(8, n) + p(8, n - 2) - c1 - c1) / 6.0_wp
+ d0 = p(6, n - 1)
+ d1 = (p(6, n) - p(6, n - 2)) * 0.5_wp
+ d2 = (p(6, n) + p(6, n - 2) - d0 - d0) * 0.5_wp
+ e0 = p(7, n - 1)
+ e1 = (p(7, n) - p(7, n - 2)) * 0.5_wp
+ e2 = (p(7, n) + p(7, n - 2) - e0 - e0) * 0.5_wp
+ inner: do
+ ! inner loop (for quadrature)
+ t = (z - p(3, n - 1)) / me%step
+ if (t > 1.0_wp) then
+ ! predictor (field line tracing)
+ p(1, n + 1) = p(1, n) + step12 * (23.0_wp * p(4, n) - 16.0_wp * p(4, n - 1) + 5.0_wp * p(4, n - 2))
+ p(2, n + 1) = p(2, n) + step12 * (23.0_wp * p(5, n) - 16.0_wp * p(5, n - 1) + 5.0_wp * p(5, n - 2))
+ p(3, n + 1) = p(3, n) + me%step
+ call me%stoer(p(1, n + 1), bq3, r3)
+ ! search for lowest magnetic field strength
+ if (bq3 < bequ) then
+ iequ = n + 1
+ bequ = bq3
+ end if
+ exit inner
+ else
+ hli = 0.5_wp * (((c3 * t + c2) * t + c1) * t + c0)
+ zq = z * z
+ r = hli + sqrt(hli * hli + zq)
+ if (r <= rmin) then
+ ! approximation for high values of l.
+ icode = 3
+ t = -p(3, n - 1) / me%step
+ fl = 1.0_wp / (abs(((c3 * t + c2) * t + c1) * t + c0) + 1.0e-15_wp)
+ return
+ end if
+ rq = r * r
+ ff = sqrt(1.0_wp + 3.0_wp * zq / rq)
+ radik = b0 - ((d2 * t + d1) * t + d0) * r * rq * ff
+ if (r > rmax) then
+ icode = 2
+ radik = radik - 12.0_wp * (r - rmax)**2
+ end if
+ if (radik + radik <= oradik) exit main
+ term = sqrt(radik) * ff * ((e2 * t + e1) * t + e0) / (rq + zq)
+ fi = fi + stp * (oterm + term)
+ oradik = radik
+ oterm = term
+ stp = r * me%steq
+ z = z + stp
+ end if
+ end do inner
+ end do main
+ if (iequ < 2) iequ = 2
+ me%sp(1) = p(1, iequ - 1)
+ me%sp(2) = p(2, iequ - 1)
+ me%sp(3) = p(3, iequ - 1)
+ if (oradik >= 1.0e-15_wp) fi = fi + stp / 0.75_wp * oterm * oradik / (oradik - radik)
- ! the minimal allowable value of fi was changed from 1e-15 to 1e-12,
- ! because 1e-38 is the minimal allowable arg. for alog in our envir.
- ! d. bilitza, nov 87.
- fi = 0.5_wp*abs(fi)/sqrt(b0) + 1.0e-12_wp
+ ! the minimal allowable value of fi was changed from 1e-15 to 1e-12,
+ ! because 1e-38 is the minimal allowable arg. for alog in our envir.
+ ! d. bilitza, nov 87.
+ fi = 0.5_wp * abs(fi) / sqrt(b0) + 1.0e-12_wp
- ! compute l from b and i. same as carmel in invar.
- ! correct dipole moment is used here. d. bilitza, nov 87.
- dimob0 = dimo/b0
- arg1 = log(fi)
- arg2 = log(dimob0)
- ! arg = fi*fi*fi/dimob0
- ! if(abs(arg)>88.0_wp) arg=88.0_wp
- xx = 3*arg1 - arg2
- if ( xx>23.0_wp ) then
- gg = xx - 3.0460681_wp
- elseif ( xx>11.7_wp ) then
- gg = (((((2.8212095e-8_wp*xx-3.8049276e-6_wp)*xx+&
- 2.170224e-4_wp)*xx-6.7310339e-3_wp)*xx+&
- 1.2038224e-1_wp)*xx-1.8461796e-1_wp)*xx + 2.0007187_wp
- elseif ( xx>+3.0_wp ) then
- gg = ((((((((6.3271665e-10_wp*xx-3.958306e-8_wp)*xx+&
- 9.9766148e-07_wp)*xx-1.2531932e-5_wp)*xx+&
- 7.9451313e-5_wp)*xx-3.2077032e-4_wp)*xx+&
- 2.1680398e-3_wp)*xx+1.2817956e-2_wp)*xx+&
- 4.3510529e-1_wp)*xx + 6.222355e-1_wp
- elseif ( xx>-3.0_wp ) then
- gg = ((((((((2.6047023e-10_wp*xx+2.3028767e-9_wp)*xx-&
- 2.1997983e-8_wp)*xx-5.3977642e-7_wp)*xx-&
- 3.3408822e-6_wp)*xx+3.8379917e-5_wp)*xx+&
- 1.1784234e-3_wp)*xx+1.4492441e-2_wp)*xx+&
- 4.3352788e-1_wp)*xx + 6.228644e-1_wp
- elseif ( xx>-22.0_wp ) then
- gg = ((((((((-8.1537735e-14_wp*xx+8.3232531e-13_wp)*xx+&
- 1.0066362e-9_wp)*xx+8.1048663e-8_wp)*xx+&
- 3.2916354e-6_wp)*xx+8.2711096e-5_wp)*xx+&
- 1.3714667e-3_wp)*xx+1.5017245e-2_wp)*xx+&
- 4.3432642e-1_wp)*xx + 6.2337691e-1_wp
- else
- gg = 3.33338e-1_wp*xx + 3.0062102e-1_wp
- endif
- fl = exp(log((1.0_wp+exp(gg))*dimob0)/3.0_wp)
+ ! compute l from b and i. same as carmel in invar.
+ ! correct dipole moment is used here. d. bilitza, nov 87.
+ dimob0 = dimo / b0
+ arg1 = log(fi)
+ arg2 = log(dimob0)
+ ! arg = fi*fi*fi/dimob0
+ ! if(abs(arg)>88.0_wp) arg=88.0_wp
+ xx = 3 * arg1 - arg2
+ if (xx > 23.0_wp) then
+ gg = xx - 3.0460681_wp
+ elseif (xx > 11.7_wp) then
+ gg = (((((2.8212095e-8_wp * xx - 3.8049276e-6_wp) * xx + &
+ 2.170224e-4_wp) * xx - 6.7310339e-3_wp) * xx + &
+ 1.2038224e-1_wp) * xx - 1.8461796e-1_wp) * xx + 2.0007187_wp
+ elseif (xx > +3.0_wp) then
+ gg = ((((((((6.3271665e-10_wp * xx - 3.958306e-8_wp) * xx + &
+ 9.9766148e-07_wp) * xx - 1.2531932e-5_wp) * xx + &
+ 7.9451313e-5_wp) * xx - 3.2077032e-4_wp) * xx + &
+ 2.1680398e-3_wp) * xx + 1.2817956e-2_wp) * xx + &
+ 4.3510529e-1_wp) * xx + 6.222355e-1_wp
+ elseif (xx > -3.0_wp) then
+ gg = ((((((((2.6047023e-10_wp * xx + 2.3028767e-9_wp) * xx - &
+ 2.1997983e-8_wp) * xx - 5.3977642e-7_wp) * xx - &
+ 3.3408822e-6_wp) * xx + 3.8379917e-5_wp) * xx + &
+ 1.1784234e-3_wp) * xx + 1.4492441e-2_wp) * xx + &
+ 4.3352788e-1_wp) * xx + 6.228644e-1_wp
+ elseif (xx > -22.0_wp) then
+ gg = ((((((((-8.1537735e-14_wp * xx + 8.3232531e-13_wp) * xx + &
+ 1.0066362e-9_wp) * xx + 8.1048663e-8_wp) * xx + &
+ 3.2916354e-6_wp) * xx + 8.2711096e-5_wp) * xx + &
+ 1.3714667e-3_wp) * xx + 1.5017245e-2_wp) * xx + &
+ 4.3432642e-1_wp) * xx + 6.2337691e-1_wp
+ else
+ gg = 3.33338e-1_wp * xx + 3.0062102e-1_wp
+ end if
+ fl = exp(log((1.0_wp + exp(gg)) * dimob0) / 3.0_wp)
- end associate
+ end associate
-end subroutine shellg
+ end subroutine shellg
!*****************************************************************************************
!>
! subroutine used for field line tracing in [[shellg]].
! calls entry point [[feldi]] in geomagnetic field subroutine [[feldg]]
-subroutine stoer(me,p,bq,r)
+ subroutine stoer(me, p, bq, r)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(7),intent(inout) :: p
- real(wp),intent(out) :: bq
- real(wp),intent(out) :: r
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(7), intent(inout) :: p
+ real(wp), intent(out) :: bq
+ real(wp), intent(out) :: r
- real(wp) :: dr , dsq , dx , dxm , dy , dym , dz , &
- dzm , fli , q , rq , wr , xm , ym , zm
+ real(wp) :: dr, dsq, dx, dxm, dy, dym, dz, &
+ dzm, fli, q, rq, wr, xm, ym, zm
- ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates
- zm = P(3)
- fli = P(1)*P(1) + P(2)*P(2) + 1.0e-15_wp
- R = 0.5_wp*(fli+sqrt(fli*fli+(zm+zm)**2))
- rq = R*R
- wr = sqrt(R)
- xm = P(1)*wr
- ym = P(2)*wr
- ! transform to geographic co-ordinate system
- me%Xi(1) = xm*u(1,1) + ym*u(1,2) + zm*u(1,3)
- me%Xi(2) = xm*u(2,1) + ym*u(2,2) + zm*u(2,3)
- me%Xi(3) = xm*u(3,1) + zm*u(3,3)
- ! compute derivatives
- ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results
- ! are the same; dkb Feb 1998.
- ! JW : feb 2024 : xi, h now class variables.
- call me%feldi()
- q = me%H(1)/rq
- dx = me%H(3) + me%H(3) + q*me%Xi(1)
- dy = me%H(4) + me%H(4) + q*me%Xi(2)
- dz = me%H(2) + me%H(2) + q*me%Xi(3)
- ! transform back to geomagnetic co-ordinate system
- dxm = u(1,1)*dx + u(2,1)*dy + u(3,1)*dz
- dym = u(1,2)*dx + u(2,2)*dy
- dzm = u(1,3)*dx + u(2,3)*dy + u(3,3)*dz
- dr = (xm*dxm+ym*dym+zm*dzm)/R
- ! form slowly varying expressions
- P(4) = (wr*dxm-0.5_wp*P(1)*dr)/(R*dzm)
- P(5) = (wr*dym-0.5_wp*P(2)*dr)/(R*dzm)
- dsq = rq*(dxm*dxm+dym*dym+dzm*dzm)
- Bq = dsq*rq*rq
- P(6) = sqrt(dsq/(rq+3.0_wp*zm*zm))
- P(7) = P(6)*(rq+zm*zm)/(rq*dzm)
+ ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates
+ zm = P(3)
+ fli = P(1) * P(1) + P(2) * P(2) + 1.0e-15_wp
+ R = 0.5_wp * (fli + sqrt(fli * fli + (zm + zm)**2))
+ rq = R * R
+ wr = sqrt(R)
+ xm = P(1) * wr
+ ym = P(2) * wr
+ ! transform to geographic co-ordinate system
+ me%Xi(1) = xm * u(1, 1) + ym * u(1, 2) + zm * u(1, 3)
+ me%Xi(2) = xm * u(2, 1) + ym * u(2, 2) + zm * u(2, 3)
+ me%Xi(3) = xm * u(3, 1) + zm * u(3, 3)
+ ! compute derivatives
+ ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results
+ ! are the same; dkb Feb 1998.
+ ! JW : feb 2024 : xi, h now class variables.
+ call me%feldi()
+ q = me%H(1) / rq
+ dx = me%H(3) + me%H(3) + q * me%Xi(1)
+ dy = me%H(4) + me%H(4) + q * me%Xi(2)
+ dz = me%H(2) + me%H(2) + q * me%Xi(3)
+ ! transform back to geomagnetic co-ordinate system
+ dxm = u(1, 1) * dx + u(2, 1) * dy + u(3, 1) * dz
+ dym = u(1, 2) * dx + u(2, 2) * dy
+ dzm = u(1, 3) * dx + u(2, 3) * dy + u(3, 3) * dz
+ dr = (xm * dxm + ym * dym + zm * dzm) / R
+ ! form slowly varying expressions
+ P(4) = (wr * dxm - 0.5_wp * P(1) * dr) / (R * dzm)
+ P(5) = (wr * dym - 0.5_wp * P(2) * dr) / (R * dzm)
+ dsq = rq * (dxm * dxm + dym * dym + dzm * dzm)
+ Bq = dsq * rq * rq
+ P(6) = sqrt(dsq / (rq + 3.0_wp * zm * zm))
+ P(7) = P(6) * (rq + zm * zm) / (rq * dzm)
-end subroutine stoer
+ end subroutine stoer
!*****************************************************************************************
!>
@@ -978,200 +978,200 @@ Source Code
!@note In the original code, [[feldc] and [[feldi]] were
! ENTRY points to this routine
- subroutine feldg(me,glat,glon,alt,bnorth,beast,bdown,babs)
+ subroutine feldg(me, glat, glon, alt, bnorth, beast, bdown, babs)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: glat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: glon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: alt !! altitude in km above sea level
- real(wp),intent(out) :: bnorth, beast, bdown !! components of the field with respect
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: glat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: glon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: alt !! altitude in km above sea level
+ real(wp), intent(out) :: bnorth, beast, bdown !! components of the field with respect
!! to the local geodetic coordinate system, with axis
!! pointing in the tangential plane to the north, east
!! and downward.
- real(wp),intent(out) :: Babs !! magnetic field strength in gauss
+ real(wp), intent(out) :: Babs !! magnetic field strength in gauss
- real(wp) :: brho , bxxx , byyy , bzzz , cp , ct , d , f , rho , &
- rlat , rlon , rq , s , sp , st , t , &
- x , xxx , y , yyy , z , zzz
- integer :: i , ih , ihmax , il , imax , k , last , m
+ real(wp) :: brho, bxxx, byyy, bzzz, cp, ct, d, f, rho, &
+ rlat, rlon, rq, s, sp, st, t, &
+ x, xxx, y, yyy, z, zzz
+ integer :: i, ih, ihmax, il, imax, k, last, m
- ! same calculation as geo_to_cart, but not used here
- ! because the intermediate variables are also used below.
- rlat = glat*umr
- ct = sin(rlat)
- st = cos(rlat)
- d = sqrt(aquad-(aquad-bquad)*ct*ct)
- rlon = glon*umr
- cp = cos(rlon)
- sp = sin(rlon)
- zzz = (alt+bquad/d)*ct/era
- rho = (alt+aquad/d)*st/era
- xxx = rho*cp
- yyy = rho*sp
+ ! same calculation as geo_to_cart, but not used here
+ ! because the intermediate variables are also used below.
+ rlat = glat * umr
+ ct = sin(rlat)
+ st = cos(rlat)
+ d = sqrt(aquad - (aquad - bquad) * ct * ct)
+ rlon = glon * umr
+ cp = cos(rlon)
+ sp = sin(rlon)
+ zzz = (alt + bquad / d) * ct / era
+ rho = (alt + aquad / d) * st / era
+ xxx = rho * cp
+ yyy = rho * sp
- rq = 1.0_wp/(xxx*xxx+yyy*yyy+zzz*zzz)
- me%xi = [xxx,yyy,zzz] * rq
+ rq = 1.0_wp / (xxx * xxx + yyy * yyy + zzz * zzz)
+ me%xi = [xxx, yyy, zzz] * rq
- ihmax=me%nmax*me%nmax+1
- last=ihmax+me%nmax+me%nmax
- imax=me%nmax+me%nmax-1
- do i=ihmax,last
- me%h(i)=me%g(i)
- end do
- do k=1,3,2
- i=imax
- ih=ihmax
- do
- il=ih-i
- f=2.0_wp/real(i-k+2, wp)
- x=me%xi(1)*f
- y=me%xi(2)*f
- z=me%xi(3)*(f+f)
- i=i-2
- if ((i-1)>=0) then
- if ((i-1)>0) then
- do m=3,i,2
- me%h(il+m+1)=me%g(il+m+1)+z*me%h(ih+m+1)+x*(me%h(ih+m+3)-&
- me%h(ih+m-1))-y*(me%h(ih+m+2)+me%h(ih+m-2))
- me%h(il+m)=me%g(il+m)+z*me%h(ih+m)+x*(me%h(ih+m+2)-&
- me%h(ih+m-2))+y*(me%h(ih+m+3)+me%h(ih+m-1))
- end do
- end if
- me%h(il+2)=me%g(il+2)+z*me%h(ih+2)+x*me%h(ih+4)-y*(me%h(ih+3)+me%h(ih))
- me%h(il+1)=me%g(il+1)+z*me%h(ih+1)+y*me%h(ih+4)+x*(me%h(ih+3)-me%h(ih))
- end if
- me%h(il)=me%g(il)+z*me%h(ih)+2.0_wp*(x*me%h(ih+1)+y*me%h(ih+2))
- ih=il
- if (i<k) exit
- end do
- end do
+ ihmax = me%nmax * me%nmax + 1
+ last = ihmax + me%nmax + me%nmax
+ imax = me%nmax + me%nmax - 1
+ do i = ihmax, last
+ me%h(i) = me%g(i)
+ end do
+ do k = 1, 3, 2
+ i = imax
+ ih = ihmax
+ do
+ il = ih - i
+ f = 2.0_wp / real(i - k + 2, wp)
+ x = me%xi(1) * f
+ y = me%xi(2) * f
+ z = me%xi(3) * (f + f)
+ i = i - 2
+ if ((i - 1) >= 0) then
+ if ((i - 1) > 0) then
+ do m = 3, i, 2
+ me%h(il + m + 1) = me%g(il + m + 1) + z * me%h(ih + m + 1) + x * (me%h(ih + m + 3) - &
+ me%h(ih + m - 1)) - y * (me%h(ih + m + 2) + me%h(ih + m - 2))
+ me%h(il + m) = me%g(il + m) + z * me%h(ih + m) + x * (me%h(ih + m + 2) - &
+ me%h(ih + m - 2)) + y * (me%h(ih + m + 3) + me%h(ih + m - 1))
+ end do
+ end if
+ me%h(il + 2) = me%g(il + 2) + z * me%h(ih + 2) + x * me%h(ih + 4) - y * (me%h(ih + 3) + me%h(ih))
+ me%h(il + 1) = me%g(il + 1) + z * me%h(ih + 1) + y * me%h(ih + 4) + x * (me%h(ih + 3) - me%h(ih))
+ end if
+ me%h(il) = me%g(il) + z * me%h(ih) + 2.0_wp * (x * me%h(ih + 1) + y * me%h(ih + 2))
+ ih = il
+ if (i < k) exit
+ end do
+ end do
- s=0.5_wp*me%h(1)+2.0_wp*(me%h(2)*me%xi(3)+me%h(3)*me%xi(1)+me%h(4)*me%xi(2))
- t=(rq+rq)*sqrt(rq)
- bxxx=t*(me%h(3)-s*xxx)
- byyy=t*(me%h(4)-s*yyy)
- bzzz=t*(me%h(2)-s*zzz)
+ s = 0.5_wp * me%h(1) + 2.0_wp * (me%h(2) * me%xi(3) + me%h(3) * me%xi(1) + me%h(4) * me%xi(2))
+ t = (rq + rq) * sqrt(rq)
+ bxxx = t * (me%h(3) - s * xxx)
+ byyy = t * (me%h(4) - s * yyy)
+ bzzz = t * (me%h(2) - s * zzz)
- babs=sqrt(bxxx*bxxx+byyy*byyy+bzzz*bzzz)
- beast=byyy*cp-bxxx*sp
- brho=byyy*sp+bxxx*cp
- bnorth=bzzz*st-brho*ct
- bdown=-bzzz*ct-brho*st
+ babs = sqrt(bxxx * bxxx + byyy * byyy + bzzz * bzzz)
+ beast = byyy * cp - bxxx * sp
+ brho = byyy * sp + bxxx * cp
+ bnorth = bzzz * st - brho * ct
+ bdown = -bzzz * ct - brho * st
- end subroutine feldg
+ end subroutine feldg
!*****************************************************************************************
!>
! Alternate version of [[feldg]] to be used with cartesian coordinates
- subroutine feldc(me,v,b)
+ subroutine feldc(me, v, b)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! x-axis pointing to equator at 0 longitude
!! y-axis pointing to equator at 90 long.
!! z-axis pointing to north pole
- real(wp),intent(out) :: b(3) !! field components
+ real(wp), intent(out) :: b(3) !! field components
- real(wp) :: f , rq , s , t , x , xxx , y , yyy , z , zzz
- integer :: i , ih , ihmax , il , imax , k , last , m
+ real(wp) :: f, rq, s, t, x, xxx, y, yyy, z, zzz
+ integer :: i, ih, ihmax, il, imax, k, last, m
- xxx=v(1)
- yyy=v(2)
- zzz=v(3)
+ xxx = v(1)
+ yyy = v(2)
+ zzz = v(3)
- rq=1.0_wp/(xxx*xxx+yyy*yyy+zzz*zzz)
- me%xi = [xxx,yyy,zzz] * rq
+ rq = 1.0_wp / (xxx * xxx + yyy * yyy + zzz * zzz)
+ me%xi = [xxx, yyy, zzz] * rq
- ihmax=me%nmax*me%nmax+1
- last=ihmax+me%nmax+me%nmax
- imax=me%nmax+me%nmax-1
- do i=ihmax,last
- me%h(i)=me%g(i)
- end do
- do k=1,3,2
- i=imax
- ih=ihmax
- do
- il=ih-i
- f=2.0_wp/real(i-k+2, wp)
- x=me%xi(1)*f
- y=me%xi(2)*f
- z=me%xi(3)*(f+f)
- i=i-2
- if ((i-1)>=0) then
- if ((i-1)>0) then
- do m=3,i,2
- me%h(il+m+1)=me%g(il+m+1)+z*me%h(ih+m+1)+x*(me%h(ih+m+3)-&
- me%h(ih+m-1))-y*(me%h(ih+m+2)+me%h(ih+m-2))
- me%h(il+m)=me%g(il+m)+z*me%h(ih+m)+x*(me%h(ih+m+2)-&
- me%h(ih+m-2))+y*(me%h(ih+m+3)+me%h(ih+m-1))
- end do
- end if
- me%h(il+2)=me%g(il+2)+z*me%h(ih+2)+x*me%h(ih+4)-y*(me%h(ih+3)+me%h(ih))
- me%h(il+1)=me%g(il+1)+z*me%h(ih+1)+y*me%h(ih+4)+x*(me%h(ih+3)-me%h(ih))
- end if
- me%h(il)=me%g(il)+z*me%h(ih)+2.0_wp*(x*me%h(ih+1)+y*me%h(ih+2))
- ih=il
- if (i<k) exit
- end do
- end do
+ ihmax = me%nmax * me%nmax + 1
+ last = ihmax + me%nmax + me%nmax
+ imax = me%nmax + me%nmax - 1
+ do i = ihmax, last
+ me%h(i) = me%g(i)
+ end do
+ do k = 1, 3, 2
+ i = imax
+ ih = ihmax
+ do
+ il = ih - i
+ f = 2.0_wp / real(i - k + 2, wp)
+ x = me%xi(1) * f
+ y = me%xi(2) * f
+ z = me%xi(3) * (f + f)
+ i = i - 2
+ if ((i - 1) >= 0) then
+ if ((i - 1) > 0) then
+ do m = 3, i, 2
+ me%h(il + m + 1) = me%g(il + m + 1) + z * me%h(ih + m + 1) + x * (me%h(ih + m + 3) - &
+ me%h(ih + m - 1)) - y * (me%h(ih + m + 2) + me%h(ih + m - 2))
+ me%h(il + m) = me%g(il + m) + z * me%h(ih + m) + x * (me%h(ih + m + 2) - &
+ me%h(ih + m - 2)) + y * (me%h(ih + m + 3) + me%h(ih + m - 1))
+ end do
+ end if
+ me%h(il + 2) = me%g(il + 2) + z * me%h(ih + 2) + x * me%h(ih + 4) - y * (me%h(ih + 3) + me%h(ih))
+ me%h(il + 1) = me%g(il + 1) + z * me%h(ih + 1) + y * me%h(ih + 4) + x * (me%h(ih + 3) - me%h(ih))
+ end if
+ me%h(il) = me%g(il) + z * me%h(ih) + 2.0_wp * (x * me%h(ih + 1) + y * me%h(ih + 2))
+ ih = il
+ if (i < k) exit
+ end do
+ end do
- s=0.5_wp*me%h(1)+2.0_wp*(me%h(2)*me%xi(3)+me%h(3)*me%xi(1)+me%h(4)*me%xi(2))
- t=(rq+rq)*sqrt(rq)
+ s = 0.5_wp * me%h(1) + 2.0_wp * (me%h(2) * me%xi(3) + me%h(3) * me%xi(1) + me%h(4) * me%xi(2))
+ t = (rq + rq) * sqrt(rq)
- b(1)=t*(me%h(3)-s*xxx)
- b(2)=t*(me%h(4)-s*yyy)
- b(3)=t*(me%h(2)-s*zzz)
+ b(1) = t * (me%h(3) - s * xxx)
+ b(2) = t * (me%h(4) - s * yyy)
+ b(3) = t * (me%h(2) - s * zzz)
- end subroutine feldc
+ end subroutine feldc
!*****************************************************************************************
!>
! Used for `l` computation.
- subroutine feldi(me)
+ subroutine feldi(me)
- class(shellig_type),intent(inout) :: me
+ class(shellig_type), intent(inout) :: me
- real(wp) :: f , x , y , z
- integer :: i , ih , ihmax , il , imax , k , last , m
+ real(wp) :: f, x, y, z
+ integer :: i, ih, ihmax, il, imax, k, last, m
- ihmax=me%nmax*me%nmax+1
- last=ihmax+me%nmax+me%nmax
- imax=me%nmax+me%nmax-1
- do i=ihmax,last
- me%h(i)=me%g(i)
- end do
- do k=1,3,2
- i=imax
- ih=ihmax
- do
- il=ih-i
- f=2.0_wp/real(i-k+2, wp)
- x=me%xi(1)*f
- y=me%xi(2)*f
- z=me%xi(3)*(f+f)
- i=i-2
- if ((i-1)>=0) then
- if ((i-1)>0) then
- do m=3,i,2
- me%h(il+m+1)=me%g(il+m+1)+z*me%h(ih+m+1)+x*(me%h(ih+m+3)-&
- me%h(ih+m-1))-y*(me%h(ih+m+2)+me%h(ih+m-2))
- me%h(il+m)=me%g(il+m)+z*me%h(ih+m)+x*(me%h(ih+m+2)-&
- me%h(ih+m-2))+y*(me%h(ih+m+3)+me%h(ih+m-1))
- end do
- end if
- me%h(il+2)=me%g(il+2)+z*me%h(ih+2)+x*me%h(ih+4)-y*(me%h(ih+3)+me%h(ih))
- me%h(il+1)=me%g(il+1)+z*me%h(ih+1)+y*me%h(ih+4)+x*(me%h(ih+3)-me%h(ih))
- end if
- me%h(il)=me%g(il)+z*me%h(ih)+2.0_wp*(x*me%h(ih+1)+y*me%h(ih+2))
- ih=il
- if (i<k) exit
- end do
- end do
+ ihmax = me%nmax * me%nmax + 1
+ last = ihmax + me%nmax + me%nmax
+ imax = me%nmax + me%nmax - 1
+ do i = ihmax, last
+ me%h(i) = me%g(i)
+ end do
+ do k = 1, 3, 2
+ i = imax
+ ih = ihmax
+ do
+ il = ih - i
+ f = 2.0_wp / real(i - k + 2, wp)
+ x = me%xi(1) * f
+ y = me%xi(2) * f
+ z = me%xi(3) * (f + f)
+ i = i - 2
+ if ((i - 1) >= 0) then
+ if ((i - 1) > 0) then
+ do m = 3, i, 2
+ me%h(il + m + 1) = me%g(il + m + 1) + z * me%h(ih + m + 1) + x * (me%h(ih + m + 3) - &
+ me%h(ih + m - 1)) - y * (me%h(ih + m + 2) + me%h(ih + m - 2))
+ me%h(il + m) = me%g(il + m) + z * me%h(ih + m) + x * (me%h(ih + m + 2) - &
+ me%h(ih + m - 2)) + y * (me%h(ih + m + 3) + me%h(ih + m - 1))
+ end do
+ end if
+ me%h(il + 2) = me%g(il + 2) + z * me%h(ih + 2) + x * me%h(ih + 4) - y * (me%h(ih + 3) + me%h(ih))
+ me%h(il + 1) = me%g(il + 1) + z * me%h(ih + 1) + y * me%h(ih + 4) + x * (me%h(ih + 3) - me%h(ih))
+ end if
+ me%h(il) = me%g(il) + z * me%h(ih) + 2.0_wp * (x * me%h(ih + 1) + y * me%h(ih + 2))
+ ih = il
+ if (i < k) exit
+ end do
+ end do
- end subroutine feldi
+ end subroutine feldi
!*****************************************************************************************
!>
@@ -1186,100 +1186,100 @@ Source Code
! * updated to IGRF-2000 version -dkb- 5/31/2000
! * updated to IGRF-2005 version -dkb- 3/24/2000
- subroutine feldcof(me,year,dimo)
+ subroutine feldcof(me, year, dimo)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: dimo !! geomagnetic dipol moment in gauss (normalized
+ real(wp), intent(out) :: dimo !! geomagnetic dipol moment in gauss (normalized
!! to earth's radius) at the time (year)
- real(wp) :: dte1 , dte2 , erad , gha(144) , sqrt2
- integer :: i , ier , j , l , m , n , iyea
- character(len=:),allocatable :: fil2
- real(wp) :: x , f0 , f !! these were double precision in original
+ real(wp) :: dte1, dte2, erad, gha(144), sqrt2
+ integer :: i, ier, j, l, m, n, iyea
+ character(len=:), allocatable :: fil2
+ real(wp) :: x, f0, f !! these were double precision in original
!! code while everything else was single precision
- ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1
- character(len=filename_len),dimension(17),parameter :: filmod = [&
- 'dgrf1945.dat ' , 'dgrf1950.dat ' , 'dgrf1955.dat ' , 'dgrf1960.dat ' , &
- 'dgrf1965.dat ' , 'dgrf1970.dat ' , 'dgrf1975.dat ' , 'dgrf1980.dat ' , &
- 'dgrf1985.dat ' , 'dgrf1990.dat ' , 'dgrf1995.dat ' , 'dgrf2000.dat ' , &
- 'dgrf2005.dat ' , 'dgrf2010.dat ' , 'dgrf2015.dat ' , 'igrf2020.dat ' , &
- 'igrf2020s.dat']
- real(wp),dimension(17),parameter :: dtemod = [1945.0_wp , 1950.0_wp , 1955.0_wp , &
- 1960.0_wp , 1965.0_wp , 1970.0_wp , &
- 1975.0_wp , 1980.0_wp , 1985.0_wp , &
- 1990.0_wp , 1995.0_wp , 2000.0_wp , &
- 2005.0_wp , 2010.0_wp , 2015.0_wp , &
- 2020.0_wp , 2025.0_wp]
- integer,parameter :: numye = size(dtemod)-1 ! number of 5-year priods represented by IGRF
- integer,parameter :: is = 0 !! * is=0 for schmidt normalization
+ ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1
+ character(len=filename_len), dimension(17), parameter :: filmod = [ &
+ 'dgrf1945.dat ', 'dgrf1950.dat ', 'dgrf1955.dat ', 'dgrf1960.dat ', &
+ 'dgrf1965.dat ', 'dgrf1970.dat ', 'dgrf1975.dat ', 'dgrf1980.dat ', &
+ 'dgrf1985.dat ', 'dgrf1990.dat ', 'dgrf1995.dat ', 'dgrf2000.dat ', &
+ 'dgrf2005.dat ', 'dgrf2010.dat ', 'dgrf2015.dat ', 'igrf2020.dat ', &
+ 'igrf2020s.dat']
+ real(wp), dimension(17), parameter :: dtemod = [1945.0_wp, 1950.0_wp, 1955.0_wp, &
+ 1960.0_wp, 1965.0_wp, 1970.0_wp, &
+ 1975.0_wp, 1980.0_wp, 1985.0_wp, &
+ 1990.0_wp, 1995.0_wp, 2000.0_wp, &
+ 2005.0_wp, 2010.0_wp, 2015.0_wp, &
+ 2020.0_wp, 2025.0_wp]
+ integer, parameter :: numye = size(dtemod) - 1 ! number of 5-year priods represented by IGRF
+ integer, parameter :: is = 0 !! * is=0 for schmidt normalization
!! * is=1 gauss normalization
- logical :: read_file
+ logical :: read_file
- !-- determine igrf-years for input-year
- me%time = year
- iyea = int(year/5.0_wp)*5
- read_file = iyea /= me%iyea ! if we have to read the file
- me%iyea = iyea
- l = (me%iyea-1945)/5 + 1
- if ( l<1 ) l = 1
- if ( l>numye ) l = numye
- dte1 = dtemod(l)
- me%name = me%get_data_file_dir() // trim(filmod(l))
- dte2 = dtemod(l+1)
- fil2 = me%get_data_file_dir() // trim(filmod(l+1))
- if (read_file) then
- ! get igrf coefficients for the boundary years
- ! [if they have not ready been loaded]
- call getshc(me%name,me%nmax1,erad,me%g,ier)
- if ( ier/=0 ) error stop 'error reading file: '//trim(me%name)
- me%g_cache = me%g ! because it is modified below, we have to cache the original values from the file
- call getshc(fil2,me%nmax2,erad,me%gh2,ier)
- if ( ier/=0 ) error stop 'error reading file: '//trim(fil2)
- else
- me%g = me%g_cache
- end if
- !-- determine igrf coefficients for year
- if ( l<=numye-1 ) then
- call intershc(year,dte1,me%nmax1,me%g,dte2,me%nmax2,me%gh2,me%nmax,gha)
- else
- call extrashc(year,dte1,me%nmax1,me%g,me%nmax2,me%gh2,me%nmax,gha)
- endif
- !-- determine magnetic dipol moment and coeffiecients g
- f0 = 0.0_wp
- do j = 1 , 3
- f = gha(j)*1.0e-5_wp
- f0 = f0 + f*f
- enddo
- dimo = sqrt(f0)
+ !-- determine igrf-years for input-year
+ me%time = year
+ iyea = int(year / 5.0_wp) * 5
+ read_file = iyea /= me%iyea ! if we have to read the file
+ me%iyea = iyea
+ l = (me%iyea - 1945) / 5 + 1
+ if (l < 1) l = 1
+ if (l > numye) l = numye
+ dte1 = dtemod(l)
+ me%name = me%get_data_file_dir()//trim(filmod(l))
+ dte2 = dtemod(l + 1)
+ fil2 = me%get_data_file_dir()//trim(filmod(l + 1))
+ if (read_file) then
+ ! get igrf coefficients for the boundary years
+ ! [if they have not ready been loaded]
+ call getshc(me%name, me%nmax1, erad, me%g, ier)
+ if (ier /= 0) error stop 'error reading file: '//trim(me%name)
+ me%g_cache = me%g ! because it is modified below, we have to cache the original values from the file
+ call getshc(fil2, me%nmax2, erad, me%gh2, ier)
+ if (ier /= 0) error stop 'error reading file: '//trim(fil2)
+ else
+ me%g = me%g_cache
+ end if
+ !-- determine igrf coefficients for year
+ if (l <= numye - 1) then
+ call intershc(year, dte1, me%nmax1, me%g, dte2, me%nmax2, me%gh2, me%nmax, gha)
+ else
+ call extrashc(year, dte1, me%nmax1, me%g, me%nmax2, me%gh2, me%nmax, gha)
+ end if
+ !-- determine magnetic dipol moment and coeffiecients g
+ f0 = 0.0_wp
+ do j = 1, 3
+ f = gha(j) * 1.0e-5_wp
+ f0 = f0 + f * f
+ end do
+ dimo = sqrt(f0)
- me%g(1) = 0.0_wp
- i = 2
- f0 = 1.0e-5_wp
- if ( is==0 ) f0 = -f0
- sqrt2 = sqrt(2.0_wp)
+ me%g(1) = 0.0_wp
+ i = 2
+ f0 = 1.0e-5_wp
+ if (is == 0) f0 = -f0
+ sqrt2 = sqrt(2.0_wp)
- do n = 1 , me%nmax
- x = n
- f0 = f0*x*x/(4.0_wp*x-2.0_wp)
- if ( is==0 ) f0 = f0*(2.0_wp*x-1.0_wp)/x
- f = f0*0.5_wp
- if ( is==0 ) f = f*sqrt2
- me%g(i) = gha(i-1)*f0
- i = i + 1
- do m = 1 , n
- f = f*(x+m)/(x-m+1.0_wp)
- if ( is==0 ) f = f*sqrt((x-m+1.0_wp)/(x+m))
- me%g(i) = gha(i-1)*f
- me%g(i+1) = gha(i)*f
- i = i + 2
- enddo
- enddo
+ do n = 1, me%nmax
+ x = n
+ f0 = f0 * x * x / (4.0_wp * x - 2.0_wp)
+ if (is == 0) f0 = f0 * (2.0_wp * x - 1.0_wp) / x
+ f = f0 * 0.5_wp
+ if (is == 0) f = f * sqrt2
+ me%g(i) = gha(i - 1) * f0
+ i = i + 1
+ do m = 1, n
+ f = f * (x + m) / (x - m + 1.0_wp)
+ if (is == 0) f = f * sqrt((x - m + 1.0_wp) / (x + m))
+ me%g(i) = gha(i - 1) * f
+ me%g(i + 1) = gha(i) * f
+ i = i + 2
+ end do
+ end do
-end subroutine feldcof
+ end subroutine feldcof
!*****************************************************************************************
!>
@@ -1290,82 +1290,82 @@ Source Code
! * Version 1.01, A. Zunde, USGS, MS 964,
! Box 25046 Federal Center, Denver, CO 80225
-subroutine getshc(Fspec,Nmax,Erad,Gh,Ier)
+ subroutine getshc(Fspec, Nmax, Erad, Gh, Ier)
- character(len=*),intent(in) :: Fspec !! File specification
- integer,intent(out) :: Nmax !! Maximum degree and order of model
- real(wp),intent(out) :: Erad !! Earth's radius associated with the spherical
+ character(len=*), intent(in) :: Fspec !! File specification
+ integer, intent(out) :: Nmax !! Maximum degree and order of model
+ real(wp), intent(out) :: Erad !! Earth's radius associated with the spherical
!! harmonic coefficients, in the same units as
!! elevation
- real(wp),dimension(*),intent(out) :: Gh !! Schmidt quasi-normal internal spherical
+ real(wp), dimension(*), intent(out) :: Gh !! Schmidt quasi-normal internal spherical
!! harmonic coefficients
- integer,intent(out) :: Ier !! Error number:
+ integer, intent(out) :: Ier !! Error number:
!!
!! * 0, no error
!! * -2, records out of order
!! * FORTRAN run-time error number
- integer :: iu !! logical unit number
- real(wp) :: g , h
- integer :: i , m , mm , n , nn
+ integer :: iu !! logical unit number
+ real(wp) :: g, h
+ integer :: i, m, mm, n, nn
- read_file : block
- ! ---------------------------------------------------------------
- ! Open coefficient file. Read past first header record.
- ! Read degree and order of model and Earth's radius.
- ! ---------------------------------------------------------------
- OPEN (newunit=Iu,FILE=Fspec,STATUS='OLD',IOSTAT=Ier)
- if (Ier/=0) then
- write(*,*) 'Error opening file: '//trim(fspec)
- exit read_file
- end if
- READ (Iu,*,IOSTAT=Ier)
- if (Ier/=0) exit read_file
- READ (Iu,*,IOSTAT=Ier) Nmax , Erad
- if (Ier/=0) exit read_file
+ read_file: block
+ ! ---------------------------------------------------------------
+ ! Open coefficient file. Read past first header record.
+ ! Read degree and order of model and Earth's radius.
+ ! ---------------------------------------------------------------
+ open (newunit=Iu, FILE=Fspec, STATUS='OLD', IOSTAT=Ier)
+ if (Ier /= 0) then
+ write (*, *) 'Error opening file: '//trim(fspec)
+ exit read_file
+ end if
+ read (Iu, *, IOSTAT=Ier)
+ if (Ier /= 0) exit read_file
+ read (Iu, *, IOSTAT=Ier) Nmax, Erad
+ if (Ier /= 0) exit read_file
- ! ---------------------------------------------------------------
- ! Read the coefficient file, arranged as follows:
- !
- ! N M G H
- ! ----------------------
- ! / 1 0 GH(1) -
- ! / 1 1 GH(2) GH(3)
- ! / 2 0 GH(4) -
- ! / 2 1 GH(5) GH(6)
- ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8)
- ! records \ 3 0 GH(9) -
- ! \ . . . .
- ! \ . . . .
- ! NMAX*(NMAX+2) \ . . . .
- ! elements in GH \ NMAX NMAX . .
- !
- ! N and M are, respectively, the degree and order of the
- ! coefficient.
- ! ---------------------------------------------------------------
- i = 0
- main: DO nn = 1 , Nmax
- DO mm = 0 , nn
- READ (Iu,*,IOSTAT=Ier) n , m , g , h
- if (Ier/=0) exit main
- IF ( nn/=n .OR. mm/=m ) THEN
- Ier = -2
- EXIT main
- ENDIF
- i = i + 1
- Gh(i) = g
- IF ( m/=0 ) THEN
- i = i + 1
- Gh(i) = h
- ENDIF
- ENDDO
- ENDDO main
+ ! ---------------------------------------------------------------
+ ! Read the coefficient file, arranged as follows:
+ !
+ ! N M G H
+ ! ----------------------
+ ! / 1 0 GH(1) -
+ ! / 1 1 GH(2) GH(3)
+ ! / 2 0 GH(4) -
+ ! / 2 1 GH(5) GH(6)
+ ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8)
+ ! records \ 3 0 GH(9) -
+ ! \ . . . .
+ ! \ . . . .
+ ! NMAX*(NMAX+2) \ . . . .
+ ! elements in GH \ NMAX NMAX . .
+ !
+ ! N and M are, respectively, the degree and order of the
+ ! coefficient.
+ ! ---------------------------------------------------------------
+ i = 0
+ main: do nn = 1, Nmax
+ do mm = 0, nn
+ read (Iu, *, IOSTAT=Ier) n, m, g, h
+ if (Ier /= 0) exit main
+ if (nn /= n .or. mm /= m) then
+ Ier = -2
+ exit main
+ end if
+ i = i + 1
+ Gh(i) = g
+ if (m /= 0) then
+ i = i + 1
+ Gh(i) = h
+ end if
+ end do
+ end do main
- end block read_file
+ end block read_file
- CLOSE (Iu)
+ close (Iu)
-END subroutine getshc
+ end subroutine getshc
!*****************************************************************************************
!>
@@ -1383,47 +1383,47 @@ Source Code
! * Version 1.01, A. Zunde
! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225
-subroutine intershc(date,dte1,nmax1,gh1,dte2,nmax2,gh2,nmax,gh)
+ subroutine intershc(date, dte1, nmax1, gh1, dte2, nmax2, gh2, nmax, gh)
- real(wp),intent(in) :: date !! Date of resulting model (in decimal year)
- real(wp),intent(in) :: dte1 !! Date of earlier model
- integer,intent(in) :: nmax1 !! Maximum degree and order of earlier model
- real(wp),intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model
- real(wp),intent(in) :: dte2 !! Date of later model
- integer,intent(in) :: nmax2 !! Maximum degree and order of later model
- real(wp),intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model
- real(wp),intent(out) :: gh(*) !! Coefficients of resulting model
- integer,intent(out) :: nmax !! Maximum degree and order of resulting model
+ real(wp), intent(in) :: date !! Date of resulting model (in decimal year)
+ real(wp), intent(in) :: dte1 !! Date of earlier model
+ integer, intent(in) :: nmax1 !! Maximum degree and order of earlier model
+ real(wp), intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model
+ real(wp), intent(in) :: dte2 !! Date of later model
+ integer, intent(in) :: nmax2 !! Maximum degree and order of later model
+ real(wp), intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model
+ real(wp), intent(out) :: gh(*) !! Coefficients of resulting model
+ integer, intent(out) :: nmax !! Maximum degree and order of resulting model
- real(wp) :: factor
- integer :: i , k , l
+ real(wp) :: factor
+ integer :: i, k, l
- factor = (date-dte1)/(dte2-dte1)
+ factor = (date - dte1) / (dte2 - dte1)
- if ( nmax1==nmax2 ) then
- k = nmax1*(nmax1+2)
- nmax = nmax1
- elseif ( nmax1>nmax2 ) then
- k = nmax2*(nmax2+2)
- l = nmax1*(nmax1+2)
- do i = k + 1 , l
- gh(i) = gh1(i) + factor*(-gh1(i))
- enddo
- nmax = nmax1
- else
- k = nmax1*(nmax1+2)
- l = nmax2*(nmax2+2)
- do i = k + 1 , l
- gh(i) = factor*gh2(i)
- enddo
- nmax = nmax2
- endif
+ if (nmax1 == nmax2) then
+ k = nmax1 * (nmax1 + 2)
+ nmax = nmax1
+ elseif (nmax1 > nmax2) then
+ k = nmax2 * (nmax2 + 2)
+ l = nmax1 * (nmax1 + 2)
+ do i = k + 1, l
+ gh(i) = gh1(i) + factor * (-gh1(i))
+ end do
+ nmax = nmax1
+ else
+ k = nmax1 * (nmax1 + 2)
+ l = nmax2 * (nmax2 + 2)
+ do i = k + 1, l
+ gh(i) = factor * gh2(i)
+ end do
+ nmax = nmax2
+ end if
- do i = 1 , k
- gh(i) = gh1(i) + factor*(gh2(i)-gh1(i))
- enddo
+ do i = 1, k
+ gh(i) = gh1(i) + factor * (gh2(i) - gh1(i))
+ end do
-end subroutine intershc
+ end subroutine intershc
!*****************************************************************************************
!>
@@ -1441,78 +1441,78 @@ Source Code
! * Version 1.01, A. Zunde
! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225
-subroutine extrashc(date,dte1,nmax1,gh1,nmax2,gh2,nmax,gh)
+ subroutine extrashc(date, dte1, nmax1, gh1, nmax2, gh2, nmax, gh)
- real(wp),intent(in) :: date !! Date of resulting model (in decimal year)
- real(wp),intent(in) :: dte1 !! Date of base model
- integer,intent(in) :: nmax1 !! Maximum degree and order of base model
- real(wp),intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model
- integer,intent(in) :: nmax2 !! Maximum degree and order of rate-of-change model
- real(wp),intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model
- real(wp),intent(out) :: gh(*) !! Coefficients of resulting model
- integer,intent(out) :: nmax !! Maximum degree and order of resulting model
+ real(wp), intent(in) :: date !! Date of resulting model (in decimal year)
+ real(wp), intent(in) :: dte1 !! Date of base model
+ integer, intent(in) :: nmax1 !! Maximum degree and order of base model
+ real(wp), intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model
+ integer, intent(in) :: nmax2 !! Maximum degree and order of rate-of-change model
+ real(wp), intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model
+ real(wp), intent(out) :: gh(*) !! Coefficients of resulting model
+ integer, intent(out) :: nmax !! Maximum degree and order of resulting model
- real(wp) :: factor
- integer :: i , k , l
+ real(wp) :: factor
+ integer :: i, k, l
- factor = (date-dte1)
+ factor = (date - dte1)
- if ( nmax1==nmax2 ) then
- k = nmax1*(nmax1+2)
- nmax = nmax1
- elseif ( nmax1>nmax2 ) then
- k = nmax2*(nmax2+2)
- l = nmax1*(nmax1+2)
- do i = k + 1 , l
- gh(i) = gh1(i)
- enddo
- nmax = nmax1
- else
- k = nmax1*(nmax1+2)
- l = nmax2*(nmax2+2)
- do i = k + 1 , l
- gh(i) = factor*gh2(i)
- enddo
- nmax = nmax2
- endif
+ if (nmax1 == nmax2) then
+ k = nmax1 * (nmax1 + 2)
+ nmax = nmax1
+ elseif (nmax1 > nmax2) then
+ k = nmax2 * (nmax2 + 2)
+ l = nmax1 * (nmax1 + 2)
+ do i = k + 1, l
+ gh(i) = gh1(i)
+ end do
+ nmax = nmax1
+ else
+ k = nmax1 * (nmax1 + 2)
+ l = nmax2 * (nmax2 + 2)
+ do i = k + 1, l
+ gh(i) = factor * gh2(i)
+ end do
+ nmax = nmax2
+ end if
- do i = 1 , k
- gh(i) = gh1(i) + factor*gh2(i)
- enddo
+ do i = 1, k
+ gh(i) = gh1(i) + factor * gh2(i)
+ end do
-end subroutine extrashc
+ end subroutine extrashc
!*****************************************************************************************
!>
! geodetic to scaled cartesian coordinates
-pure function geo_to_cart(glat,glon,alt) result(x)
+ pure function geo_to_cart(glat, glon, alt) result(x)
- real(wp),intent(in) :: glat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: glon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: alt !! altitude in km above sea level
- real(wp),dimension(3) :: x !! cartesian coordinates in earth radii (6371.2 km)
+ real(wp), intent(in) :: glat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: glon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: alt !! altitude in km above sea level
+ real(wp), dimension(3) :: x !! cartesian coordinates in earth radii (6371.2 km)
!!
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
!! * z-axis pointing to north pole
- real(wp) :: rlat !! latitude in radians
- real(wp) :: rlon !! longitude in radians
- real(wp) :: d, rho
+ real(wp) :: rlat !! latitude in radians
+ real(wp) :: rlon !! longitude in radians
+ real(wp) :: d, rho
- ! deg to radians:
- rlat = glat*umr
- rlon = glon*umr
+ ! deg to radians:
+ rlat = glat * umr
+ rlon = glon * umr
- ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code
- associate (ct => sin(rlat), st => cos(rlat), cp => cos(rlon), sp => sin(rlon))
- d = sqrt(aquad-(aquad-bquad)*ct*ct)
- rho = (alt+aquad/d)*st/era
- x = [rho*cp, rho*sp, (alt+bquad/d)*ct/era]
- end associate
+ ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code
+ associate (ct => sin(rlat), st => cos(rlat), cp => cos(rlon), sp => sin(rlon))
+ d = sqrt(aquad - (aquad - bquad) * ct * ct)
+ rho = (alt + aquad / d) * st / era
+ x = [rho * cp, rho * sp, (alt + bquad / d) * ct / era]
+ end associate
-end function geo_to_cart
+ end function geo_to_cart
end module SHELLIG_module
diff --git a/sourcefile/trmfun.f90.html b/sourcefile/trmfun.f90.html
index d372c7c..873b854 100644
--- a/sourcefile/trmfun.f90.html
+++ b/sourcefile/trmfun.f90.html
@@ -349,121 +349,121 @@ Source Code
module trmfun_module
- use radbelt_kinds_module
+ use radbelt_kinds_module
- implicit none
+ implicit none
- private
+ private
- character(len=10),dimension(4),parameter :: mname = [ 'ae8min.asc' , &
- 'ae8max.asc' , &
- 'ap8min.asc' , &
- 'ap8max.asc'] !! data files available
+ character(len=10), dimension(4), parameter :: mname = ['ae8min.asc', &
+ 'ae8max.asc', &
+ 'ap8min.asc', &
+ 'ap8max.asc'] !! data files available
- type,public :: trm_type
+ type, public :: trm_type
!! main class for the `aep8` model
- private
+ private
- character(len=:),allocatable :: aep8_dir !! directory containing the data files
+ character(len=:), allocatable :: aep8_dir !! directory containing the data files
- ! data read from the files:
- character(len=:),allocatable :: file_loaded !! the file that has been loaded
- integer,dimension(8) :: ihead = 0
- integer,dimension(:),allocatable :: map
+ ! data read from the files:
+ character(len=:), allocatable :: file_loaded !! the file that has been loaded
+ integer, dimension(8) :: ihead = 0
+ integer, dimension(:), allocatable :: map
- real(wp) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux.
+ real(wp) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux.
!! formerly stored in common block `tra2`
- ! formerly saved variables in trara1:
- real(wp) :: f1 = 1.001_wp
- real(wp) :: f2 = 1.002_wp
+ ! formerly saved variables in trara1:
+ real(wp) :: f1 = 1.001_wp
+ real(wp) :: f2 = 1.002_wp
- contains
- private
- procedure,public :: aep8 !! main routine
- procedure,public :: trara1, trara2 !! low-level routine
- procedure,public :: set_data_file_dir, get_data_file_dir
- end type trm_type
+ contains
+ private
+ procedure, public :: aep8 !! main routine
+ procedure, public :: trara1, trara2 !! low-level routine
+ procedure, public :: set_data_file_dir, get_data_file_dir
+ end type trm_type
- contains
+contains
!*****************************************************************************************
!>
! Set the directory containing the data files.
- subroutine set_data_file_dir(me,dir)
- class(trm_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
- me%aep8_dir = trim(dir)
- end subroutine set_data_file_dir
+ subroutine set_data_file_dir(me, dir)
+ class(trm_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
+ me%aep8_dir = trim(dir)
+ end subroutine set_data_file_dir
!*****************************************************************************************
!>
! Get the directory containing the data files.
- function get_data_file_dir(me) result(dir)
- class(trm_type),intent(in) :: me
- character(len=:),allocatable :: dir
- if (allocated(me%aep8_dir)) then
- dir = trim(me%aep8_dir) // '/'
- else
- dir = 'data/aep8/' ! default
- end if
- end function get_data_file_dir
+ function get_data_file_dir(me) result(dir)
+ class(trm_type), intent(in) :: me
+ character(len=:), allocatable :: dir
+ if (allocated(me%aep8_dir)) then
+ dir = trim(me%aep8_dir)//'/'
+ else
+ dir = 'data/aep8/' ! default
+ end if
+ end function get_data_file_dir
!*****************************************************************************************
!>
! Main wrapper for the radiation model.
! Reads the coefficient file and calls the low-level routine.
- subroutine aep8(me,e,l,bb0,imname,flux)
+ subroutine aep8(me, e, l, bb0, imname, flux)
- class(trm_type),intent(inout) :: me
+ class(trm_type), intent(inout) :: me
- real(wp),intent(in) :: e
- real(wp),intent(in) :: l
- real(wp),intent(in) :: bb0
- integer,intent(in) :: imname !! which model to load (index in `mname` array)
- real(wp),intent(out) :: flux
+ real(wp), intent(in) :: e
+ real(wp), intent(in) :: l
+ real(wp), intent(in) :: bb0
+ integer, intent(in) :: imname !! which model to load (index in `mname` array)
+ real(wp), intent(out) :: flux
- real(wp) :: ee(1), f(1) !! temp variables
- integer :: i , ierr, iuaeap , nmap
- character(len=:),allocatable :: name
- logical :: load_file
+ real(wp) :: ee(1), f(1) !! temp variables
+ integer :: i, ierr, iuaeap, nmap
+ character(len=:), allocatable :: name
+ logical :: load_file
- name = me%get_data_file_dir() // trim(mname(Imname)) ! the file to load
+ name = me%get_data_file_dir()//trim(mname(Imname)) ! the file to load
- ! JW : do we need to reset some or all of these ?
- me%fistep = 0.0_wp
- me%f1 = 1.001_wp
- me%f2 = 1.002_wp
+ ! JW : do we need to reset some or all of these ?
+ me%fistep = 0.0_wp
+ me%f1 = 1.001_wp
+ me%f2 = 1.002_wp
- ! check to see if this file has already been loaded
- ! [the class can store one file at a time]
- load_file = .true.
- if (allocated(me%file_loaded)) then
- if (name == me%file_loaded) load_file = .false.
- end if
+ ! check to see if this file has already been loaded
+ ! [the class can store one file at a time]
+ load_file = .true.
+ if (allocated(me%file_loaded)) then
+ if (name == me%file_loaded) load_file = .false.
+ end if
- if (load_file) then
- open (newunit = iuaeap,file=name,status='OLD',iostat=ierr,form='FORMATTED')
- if ( ierr/=0 ) then
- error stop 'error reading '//trim(name)
- end if
- read (iuaeap,'(1X,12I6)') me%ihead
- nmap = me%ihead(8)
- allocate(me%map(nmap))
- read (iuaeap,'(1X,12I6)') (me%map(i),i=1,nmap)
- close (iuaeap)
- me%file_loaded = trim(name)
- end if
+ if (load_file) then
+ open (newunit=iuaeap, file=name, status='OLD', iostat=ierr, form='FORMATTED')
+ if (ierr /= 0) then
+ error stop 'error reading '//trim(name)
+ end if
+ read (iuaeap, '(1X,12I6)') me%ihead
+ nmap = me%ihead(8)
+ allocate (me%map(nmap))
+ read (iuaeap, '(1X,12I6)') (me%map(i), i=1, nmap)
+ close (iuaeap)
+ me%file_loaded = trim(name)
+ end if
- ee(1) = e
- call me%trara1(me%ihead,me%map,L,Bb0,ee,f,1)
- flux = f(1)
- IF ( Flux>0.0_wp ) Flux = 10.0_wp**Flux
+ ee(1) = e
+ call me%trara1(me%ihead, me%map, L, Bb0, ee, f, 1)
+ flux = f(1)
+ if (Flux > 0.0_wp) Flux = 10.0_wp**Flux
- end subroutine aep8
+ end subroutine aep8
!*****************************************************************************************
!*****************************************************************************************
@@ -472,114 +472,114 @@ Source Code
! strength and l-value. function [[trara2]] is used to interpolate in
! b-l-space.
- subroutine trara1(me,descr,map,fl,bb0,e,f,n)
+ subroutine trara1(me, descr, map, fl, bb0, e, f, n)
- class(trm_type),intent(inout) :: me
- integer,intent(in) :: n !! number of energies
- integer,intent(in) :: descr(8) !! header of specified trapped radition model
- real(wp),intent(in) :: e(n) !! array of energies in mev
- real(wp),intent(in) :: fl !! l-value
- real(wp),intent(in) :: bb0 !! =b/b0 magnetic field strength normalized
+ class(trm_type), intent(inout) :: me
+ integer, intent(in) :: n !! number of energies
+ integer, intent(in) :: descr(8) !! header of specified trapped radition model
+ real(wp), intent(in) :: e(n) !! array of energies in mev
+ real(wp), intent(in) :: fl !! l-value
+ real(wp), intent(in) :: bb0 !! =b/b0 magnetic field strength normalized
!! to field strength at magnetic equator
- integer,intent(in) :: map(*) !! map of trapped radition model
+ integer, intent(in) :: map(*) !! map of trapped radition model
!! (descr and map are explained at the begin
!! of the main program model)
- real(wp),intent(out) :: f(n) !! decadic logarithm of integral fluxes in
+ real(wp), intent(out) :: f(n) !! decadic logarithm of integral fluxes in
!! particles/(cm*cm*sec)
- real(wp) :: e0 , e1 , e2 , escale , f0 , fscale , xnl
- real(wp) :: bb0_ !! local copy of `bb0`. in the original code
+ real(wp) :: e0, e1, e2, escale, f0, fscale, xnl
+ real(wp) :: bb0_ !! local copy of `bb0`. in the original code
!! this was modified by this routine.
!! added this so `bb0` could be `intent(in)`
- integer :: i0 , i1 , i2 , i3 , ie , l3 , nb , nl
- logical :: s0 , s1 , s2
+ integer :: i0, i1, i2, i3, ie, l3, nb, nl
+ logical :: s0, s1, s2
- e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
- f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
- i0 = 0 ! to avoid -Wmaybe-uninitialized warnings
- s0 = .false. ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW
+ e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+ f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+ i0 = 0 ! to avoid -Wmaybe-uninitialized warnings
+ s0 = .false. ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW
- bb0_ = bb0
- me%fistep = descr(7)/descr(2)
- escale = descr(4)
- fscale = descr(7)
- xnl = min(15.6_wp,abs(fl))
- nl = int(xnl*descr(5))
- if ( bb0_<1.0_wp ) bb0_ = 1.0_wp
- nb = int((bb0_-1.0_wp)*descr(6))
+ bb0_ = bb0
+ me%fistep = descr(7) / descr(2)
+ escale = descr(4)
+ fscale = descr(7)
+ xnl = min(15.6_wp, abs(fl))
+ nl = int(xnl * descr(5))
+ if (bb0_ < 1.0_wp) bb0_ = 1.0_wp
+ nb = int((bb0_ - 1.0_wp) * descr(6))
- ! i2 is the number of elements in the flux map for the first energy.
- ! i3 is the index of the last element of the second energy map.
- ! l3 is the length of the map for the third energy.
- ! e1 is the energy of the first energy map (unscaled)
- ! e2 is the energy of the second energy map (unscaled)
- i1 = 0
- i2 = map(1)
- i3 = i2 + map(i2+1)
- l3 = map(i3+1)
- e1 = map(i1+2)/escale
- e2 = map(i2+2)/escale
+ ! i2 is the number of elements in the flux map for the first energy.
+ ! i3 is the index of the last element of the second energy map.
+ ! l3 is the length of the map for the third energy.
+ ! e1 is the energy of the first energy map (unscaled)
+ ! e2 is the energy of the second energy map (unscaled)
+ i1 = 0
+ i2 = map(1)
+ i3 = i2 + map(i2 + 1)
+ l3 = map(i3 + 1)
+ e1 = map(i1 + 2) / escale
+ e2 = map(i2 + 2) / escale
- ! s0, s1, s2 are logical variables which indicate whether the flux for
- ! a particular e, b, l point has already been found in a previous call
- ! to function trara2. if not, s.. =.true.
- s1 = .true.
- s2 = .true.
+ ! s0, s1, s2 are logical variables which indicate whether the flux for
+ ! a particular e, b, l point has already been found in a previous call
+ ! to function trara2. if not, s.. =.true.
+ s1 = .true.
+ s2 = .true.
- ! energy loop
+ ! energy loop
- do ie = 1 , n
+ do ie = 1, n
- ! for each energy e(i) find the successive energies e0,e1,e2 in
- ! model map, which obey e0 < e1 < e(i) < e2 .
+ ! for each energy e(i) find the successive energies e0,e1,e2 in
+ ! model map, which obey e0 < e1 < e(i) < e2 .
- do while ( (e(ie)>e2) .and. (l3/=0) )
- i0 = i1
- i1 = i2
- i2 = i3
- i3 = i3 + l3
- l3 = map(i3+1)
- e0 = e1
- e1 = e2
- e2 = map(i2+2)/escale
- s0 = s1
- s1 = s2
- s2 = .true.
- f0 = me%f1
- me%f1 = me%f2
- enddo
+ do while ((e(ie) > e2) .and. (l3 /= 0))
+ i0 = i1
+ i1 = i2
+ i2 = i3
+ i3 = i3 + l3
+ l3 = map(i3 + 1)
+ e0 = e1
+ e1 = e2
+ e2 = map(i2 + 2) / escale
+ s0 = s1
+ s1 = s2
+ s2 = .true.
+ f0 = me%f1
+ me%f1 = me%f2
+ end do
- ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0-
- ! space to find fluxes f1,f2 [if they have not already been
- ! calculated for a previous e(i)].
+ ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0-
+ ! space to find fluxes f1,f2 [if they have not already been
+ ! calculated for a previous e(i)].
- if ( s1 ) me%f1 = me%trara2(map(i1+3),nl,nb)/fscale
- if ( s2 ) me%f2 = me%trara2(map(i2+3),nl,nb)/fscale
- s1 = .false.
- s2 = .false.
+ if (s1) me%f1 = me%trara2(map(i1 + 3), nl, nb) / fscale
+ if (s2) me%f2 = me%trara2(map(i2 + 3), nl, nb) / fscale
+ s1 = .false.
+ s2 = .false.
- ! finally, interpolate in energy.
+ ! finally, interpolate in energy.
- f(ie) = me%f1 + (me%f2-me%f1)*(e(ie)-e1)/(e2-e1)
- if ( me%f2<=0.0_wp ) then
- if ( i1/=0 ) then
- ! --------- special interpolation ---------------------------------
- ! if the flux for the second energy cannot be found (i.e. f2=0.0),
- ! and the zeroth energy map has been defined (i.e. i1 not equal 0),
- ! then interpolate using the flux maps for the zeroth and first
- ! energy and choose the minimum of this interpolations and the
- ! interpolation that was done with f2=0.
- if ( s0 ) f0 = me%trara2(map(i0+3),nl,nb)/fscale
- s0 = .false.
- f(ie) = min(f(ie),f0+(me%f1-f0)*(e(ie)-e0)/(e1-e0))
- endif
- endif
+ f(ie) = me%f1 + (me%f2 - me%f1) * (e(ie) - e1) / (e2 - e1)
+ if (me%f2 <= 0.0_wp) then
+ if (i1 /= 0) then
+ ! --------- special interpolation ---------------------------------
+ ! if the flux for the second energy cannot be found (i.e. f2=0.0),
+ ! and the zeroth energy map has been defined (i.e. i1 not equal 0),
+ ! then interpolate using the flux maps for the zeroth and first
+ ! energy and choose the minimum of this interpolations and the
+ ! interpolation that was done with f2=0.
+ if (s0) f0 = me%trara2(map(i0 + 3), nl, nb) / fscale
+ s0 = .false.
+ f(ie) = min(f(ie), f0 + (me%f1 - f0) * (e(ie) - e0) / (e1 - e0))
+ end if
+ end if
- ! the logarithmic flux is always kept greater or equal zero.
+ ! the logarithmic flux is always kept greater or equal zero.
- f(ie) = max(f(ie),0.0_wp)
- enddo
-end subroutine trara1
+ f(ie) = max(f(ie), 0.0_wp)
+ end do
+ end subroutine trara1
!*****************************************************************************************
!>
@@ -590,259 +590,259 @@ Source Code
! see main program 'model' for explanation of map format
! scaling factors.
-function trara2(me,map,il,ib)
+ function trara2(me, map, il, ib)
- class(trm_type),intent(inout) :: me
- integer,intent(in) :: map(*) !! is sub-map (for specific energy) of
+ class(trm_type), intent(inout) :: me
+ integer, intent(in) :: map(*) !! is sub-map (for specific energy) of
!! trapped radiation model map
- integer,intent(in) :: il !! scaled l-value
- integer,intent(in) :: ib !! scaled b/b0-1
- real(wp) :: trara2 !! scaled logarithm of particle flux
+ integer, intent(in) :: il !! scaled l-value
+ integer, intent(in) :: ib !! scaled b/b0-1
+ real(wp) :: trara2 !! scaled logarithm of particle flux
- real(wp) :: dfl , fincr1 , fincr2 , fistep , fkb , fkb1 , fkb2 , fkbj1 , fkbj2 , &
- fkbm , fll1 , fll2 , flog , flog1 , flog2 , flogm , &
- fnb , fnl , sl1 , sl2
- integer :: i1 , i2 , itime , j1 , j2 , kt , l1 , l2
- logical :: dummy
+ real(wp) :: dfl, fincr1, fincr2, fistep, fkb, fkb1, fkb2, fkbj1, fkbj2, &
+ fkbm, fll1, fll2, flog, flog1, flog2, flogm, &
+ fnb, fnl, sl1, sl2
+ integer :: i1, i2, itime, j1, j2, kt, l1, l2
+ logical :: dummy
- fistep = me%fistep
+ fistep = me%fistep
- !********
- ! to avoid -Wmaybe-uninitialized warning
- dfl = 0.0_wp
- fincr1 = 0.0_wp
- fincr2 = 0.0_wp
- fkb = 0.0_wp
- fkb1 = 0.0_wp
- fkb2 = 0.0_wp
- fkbm = 0.0_wp
- flog = 0.0_wp
- flog1 = 0.0_wp
- flog2 = 0.0_wp
- flogm = 0.0_wp
- fnb = 0.0_wp
- fnl = 0.0_wp
- sl2 = 0.0_wp
- i1 = 0
- i2 = 0
- itime = 0
- j2 = 0
- l1 = 0
- l2 = 0
- !********
+ !********
+ ! to avoid -Wmaybe-uninitialized warning
+ dfl = 0.0_wp
+ fincr1 = 0.0_wp
+ fincr2 = 0.0_wp
+ fkb = 0.0_wp
+ fkb1 = 0.0_wp
+ fkb2 = 0.0_wp
+ fkbm = 0.0_wp
+ flog = 0.0_wp
+ flog1 = 0.0_wp
+ flog2 = 0.0_wp
+ flogm = 0.0_wp
+ fnb = 0.0_wp
+ fnl = 0.0_wp
+ sl2 = 0.0_wp
+ i1 = 0
+ i2 = 0
+ itime = 0
+ j2 = 0
+ l1 = 0
+ l2 = 0
+ !********
- ! these are recursive functions that
- ! replace the gotos in the original code
- call task1(dummy)
+ ! these are recursive functions that
+ ! replace the gotos in the original code
+ call task1(dummy)
- contains
+ contains
- recursive subroutine task1(done)
- logical,intent(out) :: done
- done = .false.
- fnl = il
- fnb = ib
- itime = 0
- i2 = 0
- do
- ! find consecutive sub-sub-maps for scaled l-values ls1,ls2,
- ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps.
- ! i1,i2 are indeces of first elements minus 1.
- l2 = map(i2+1)
- if ( map(i2+2)<=il ) then
- i1 = i2
- l1 = l2
- i2 = i2 + l2
- ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0
- elseif ( (l1<4) .and. (l2<4) ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- ! if flog2 less flog1, than ls2 first map and ls1 second map
- if ( map(i2+3)<=map(i1+3) ) exit
- call task3(done)
- return
- endif
- enddo
- call task2(done)
- end subroutine task1
- recursive subroutine task2(done)
- logical,intent(out) :: done
- done = .false.
- kt = i1
- i1 = i2
- i2 = kt
- kt = l1
- l1 = l2
- l2 = kt
- call task3(done)
- end subroutine task2
- recursive subroutine task3(done)
- logical,intent(out) :: done
- logical :: check
- done = .false.
- ! determine interpolate in scaled l-value
- fll1 = map(i1+2)
- fll2 = map(i2+2)
- dfl = (fnl-fll1)/(fll2-fll1)
- flog1 = map(i1+3)
- flog2 = map(i2+3)
- fkb1 = 0.0_wp
- fkb2 = 0.0_wp
- if ( l1>=4 ) then
- ! b/b0 loop
- check = .true.
- do j2 = 4 , l2
- fincr2 = map(i2+j2)
- if ( fkb2+fincr2>fnb ) then
- check = .false.
- exit
- end if
- fkb2 = fkb2 + fincr2
- flog2 = flog2 - fistep
- enddo
- if (check) then
- itime = itime + 1
- if ( itime==1 ) then
- call task2(done)
- return
- endif
- trara2 = 0.0_wp
- done = .true.
- return
- end if
- if ( itime/=1 ) then
- if ( j2==4 ) then
- call task4(done)
- return
- endif
- sl2 = flog2/fkb2
- check = .true.
- do j1 = 4 , l1
- fincr1 = map(i1+j1)
- fkb1 = fkb1 + fincr1
- flog1 = flog1 - fistep
- fkbj1 = ((flog1/fistep)*fincr1+fkb1)/((fincr1/fistep)*sl2+1.0_wp)
- if ( fkbj1<=fkb1 ) then
- check = .false.
- exit
- end if
- enddo
- if (check) then
- if ( fkbj1<=fkb2 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- endif
- end if
- if ( fkbj1<=fkb2 ) then
- fkbm = fkbj1 + (fkb2-fkbj1)*dfl
- flogm = fkbm*sl2
- flog2 = flog2 - fistep
- fkb2 = fkb2 + fincr2
- sl1 = flog1/fkb1
- sl2 = flog2/fkb2
- call task5(done)
- return
- else
- fkb1 = 0.0_wp
- endif
- endif
- fkb2 = 0.0_wp
- endif
- j2 = 4
- fincr2 = map(i2+j2)
- flog2 = map(i2+3)
- flog1 = map(i1+3)
- call task4(done)
- end subroutine task3
- recursive subroutine task4(done)
- logical,intent(out) :: done
- done = .false.
- flogm = flog1 + (flog2-flog1)*dfl
- fkbm = 0.0_wp
- fkb2 = fkb2 + fincr2
- flog2 = flog2 - fistep
- sl2 = flog2/fkb2
- if ( l1<4 ) then
- fincr1 = 0.0_wp
- sl1 = -900000.0_wp
- call task6(done)
- return
- else
- j1 = 4
- fincr1 = map(i1+j1)
- fkb1 = fkb1 + fincr1
- flog1 = flog1 - fistep
- sl1 = flog1/fkb1
- endif
- call task5(done)
- end subroutine task4
- recursive subroutine task5(done)
- logical,intent(out) :: done
- done = .false.
- do while ( sl1>=sl2 )
- fkbj2 = ((flog2/fistep)*fincr2+fkb2)/((fincr2/fistep)*sl1+1.0_wp)
- fkb = fkb1 + (fkbj2-fkb1)*dfl
- flog = fkb*sl1
- if ( fkb>=fnb ) then
- call task7(done)
- return
- endif
- fkbm = fkb
- flogm = flog
- if ( j1>=l1 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- j1 = j1 + 1
- fincr1 = map(i1+j1)
- flog1 = flog1 - fistep
- fkb1 = fkb1 + fincr1
- sl1 = flog1/fkb1
- endif
- enddo
- call task6(done)
- end subroutine task5
- recursive subroutine task6(done)
- logical,intent(out) :: done
- done = .false.
- fkbj1 = ((flog1/fistep)*fincr1+fkb1)/((fincr1/fistep)*sl2+1.0_wp)
- fkb = fkbj1 + (fkb2-fkbj1)*dfl
- flog = fkb*sl2
- if ( fkb<fnb ) then
- fkbm = fkb
- flogm = flog
- if ( j2>=l2 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- j2 = j2 + 1
- fincr2 = map(i2+j2)
- flog2 = flog2 - fistep
- fkb2 = fkb2 + fincr2
- sl2 = flog2/fkb2
- call task5(done)
- return
- endif
- endif
- call task7(done)
- end subroutine task6
- recursive subroutine task7(done)
- logical,intent(out) :: done
- if ( fkb<fkbm+1.0e-10_wp ) then
- trara2 = 0.0_wp
- else
- trara2 = flogm + (flog-flogm)*((fnb-fkbm)/(fkb-fkbm))
- trara2 = max(trara2,0.0_wp)
- endif
- done = .true.
- end subroutine task7
+ recursive subroutine task1(done)
+ logical, intent(out) :: done
+ done = .false.
+ fnl = il
+ fnb = ib
+ itime = 0
+ i2 = 0
+ do
+ ! find consecutive sub-sub-maps for scaled l-values ls1,ls2,
+ ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps.
+ ! i1,i2 are indeces of first elements minus 1.
+ l2 = map(i2 + 1)
+ if (map(i2 + 2) <= il) then
+ i1 = i2
+ l1 = l2
+ i2 = i2 + l2
+ ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0
+ elseif ((l1 < 4) .and. (l2 < 4)) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ ! if flog2 less flog1, than ls2 first map and ls1 second map
+ if (map(i2 + 3) <= map(i1 + 3)) exit
+ call task3(done)
+ return
+ end if
+ end do
+ call task2(done)
+ end subroutine task1
+ recursive subroutine task2(done)
+ logical, intent(out) :: done
+ done = .false.
+ kt = i1
+ i1 = i2
+ i2 = kt
+ kt = l1
+ l1 = l2
+ l2 = kt
+ call task3(done)
+ end subroutine task2
+ recursive subroutine task3(done)
+ logical, intent(out) :: done
+ logical :: check
+ done = .false.
+ ! determine interpolate in scaled l-value
+ fll1 = map(i1 + 2)
+ fll2 = map(i2 + 2)
+ dfl = (fnl - fll1) / (fll2 - fll1)
+ flog1 = map(i1 + 3)
+ flog2 = map(i2 + 3)
+ fkb1 = 0.0_wp
+ fkb2 = 0.0_wp
+ if (l1 >= 4) then
+ ! b/b0 loop
+ check = .true.
+ do j2 = 4, l2
+ fincr2 = map(i2 + j2)
+ if (fkb2 + fincr2 > fnb) then
+ check = .false.
+ exit
+ end if
+ fkb2 = fkb2 + fincr2
+ flog2 = flog2 - fistep
+ end do
+ if (check) then
+ itime = itime + 1
+ if (itime == 1) then
+ call task2(done)
+ return
+ end if
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ end if
+ if (itime /= 1) then
+ if (j2 == 4) then
+ call task4(done)
+ return
+ end if
+ sl2 = flog2 / fkb2
+ check = .true.
+ do j1 = 4, l1
+ fincr1 = map(i1 + j1)
+ fkb1 = fkb1 + fincr1
+ flog1 = flog1 - fistep
+ fkbj1 = ((flog1 / fistep) * fincr1 + fkb1) / ((fincr1 / fistep) * sl2 + 1.0_wp)
+ if (fkbj1 <= fkb1) then
+ check = .false.
+ exit
+ end if
+ end do
+ if (check) then
+ if (fkbj1 <= fkb2) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ end if
+ end if
+ if (fkbj1 <= fkb2) then
+ fkbm = fkbj1 + (fkb2 - fkbj1) * dfl
+ flogm = fkbm * sl2
+ flog2 = flog2 - fistep
+ fkb2 = fkb2 + fincr2
+ sl1 = flog1 / fkb1
+ sl2 = flog2 / fkb2
+ call task5(done)
+ return
+ else
+ fkb1 = 0.0_wp
+ end if
+ end if
+ fkb2 = 0.0_wp
+ end if
+ j2 = 4
+ fincr2 = map(i2 + j2)
+ flog2 = map(i2 + 3)
+ flog1 = map(i1 + 3)
+ call task4(done)
+ end subroutine task3
+ recursive subroutine task4(done)
+ logical, intent(out) :: done
+ done = .false.
+ flogm = flog1 + (flog2 - flog1) * dfl
+ fkbm = 0.0_wp
+ fkb2 = fkb2 + fincr2
+ flog2 = flog2 - fistep
+ sl2 = flog2 / fkb2
+ if (l1 < 4) then
+ fincr1 = 0.0_wp
+ sl1 = -900000.0_wp
+ call task6(done)
+ return
+ else
+ j1 = 4
+ fincr1 = map(i1 + j1)
+ fkb1 = fkb1 + fincr1
+ flog1 = flog1 - fistep
+ sl1 = flog1 / fkb1
+ end if
+ call task5(done)
+ end subroutine task4
+ recursive subroutine task5(done)
+ logical, intent(out) :: done
+ done = .false.
+ do while (sl1 >= sl2)
+ fkbj2 = ((flog2 / fistep) * fincr2 + fkb2) / ((fincr2 / fistep) * sl1 + 1.0_wp)
+ fkb = fkb1 + (fkbj2 - fkb1) * dfl
+ flog = fkb * sl1
+ if (fkb >= fnb) then
+ call task7(done)
+ return
+ end if
+ fkbm = fkb
+ flogm = flog
+ if (j1 >= l1) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ j1 = j1 + 1
+ fincr1 = map(i1 + j1)
+ flog1 = flog1 - fistep
+ fkb1 = fkb1 + fincr1
+ sl1 = flog1 / fkb1
+ end if
+ end do
+ call task6(done)
+ end subroutine task5
+ recursive subroutine task6(done)
+ logical, intent(out) :: done
+ done = .false.
+ fkbj1 = ((flog1 / fistep) * fincr1 + fkb1) / ((fincr1 / fistep) * sl2 + 1.0_wp)
+ fkb = fkbj1 + (fkb2 - fkbj1) * dfl
+ flog = fkb * sl2
+ if (fkb < fnb) then
+ fkbm = fkb
+ flogm = flog
+ if (j2 >= l2) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ j2 = j2 + 1
+ fincr2 = map(i2 + j2)
+ flog2 = flog2 - fistep
+ fkb2 = fkb2 + fincr2
+ sl2 = flog2 / fkb2
+ call task5(done)
+ return
+ end if
+ end if
+ call task7(done)
+ end subroutine task6
+ recursive subroutine task7(done)
+ logical, intent(out) :: done
+ if (fkb < fkbm + 1.0e-10_wp) then
+ trara2 = 0.0_wp
+ else
+ trara2 = flogm + (flog - flogm) * ((fnb - fkbm) / (fkb - fkbm))
+ trara2 = max(trara2, 0.0_wp)
+ end if
+ done = .true.
+ end subroutine task7
-end function trara2
+ end function trara2
end module trmfun_module
diff --git a/src/radbelt_c_module.f90 b/src/radbelt_c_module.f90
index 94c7a21..e81fc1a 100644
--- a/src/radbelt_c_module.f90
+++ b/src/radbelt_c_module.f90
@@ -2,7 +2,7 @@
!>
! Experimental C interface to the radbelt module.
- module radbelt_c_module
+module radbelt_c_module
use iso_c_binding, only: c_double, c_int, c_char, c_null_char, &
c_intptr_t, c_ptr, c_loc, c_f_pointer, &
@@ -11,194 +11,194 @@ module radbelt_c_module
implicit none
- contains
+contains
!*****************************************************************************************
!*****************************************************************************************
!>
! Convert C string to Fortran
-function c2f_str(cstr) result(fstr)
+ function c2f_str(cstr) result(fstr)
- character(kind=c_char,len=1),dimension(:),intent(in) :: cstr !! string from C
- character(len=:),allocatable :: fstr !! fortran string
+ character(kind=c_char, len=1), dimension(:), intent(in) :: cstr !! string from C
+ character(len=:), allocatable :: fstr !! fortran string
- integer :: i !! counter
+ integer :: i !! counter
- fstr = ''
- do i = 1, size(cstr)
- fstr = fstr//cstr(i)
- end do
- fstr = trim(fstr)
+ fstr = ''
+ do i = 1, size(cstr)
+ fstr = fstr//cstr(i)
+ end do
+ fstr = trim(fstr)
-end function c2f_str
+ end function c2f_str
!*****************************************************************************************
!>
! Convert an integer pointer to a [[radbelt_type]] pointer.
-subroutine int_pointer_to_f_pointer(ipointer, p)
+ subroutine int_pointer_to_f_pointer(ipointer, p)
- integer(c_intptr_t),intent(in) :: ipointer !! integer pointer from C
- type(radbelt_type),pointer :: p !! fortran pointer
+ integer(c_intptr_t), intent(in) :: ipointer !! integer pointer from C
+ type(radbelt_type), pointer :: p !! fortran pointer
- type(c_ptr) :: cp
+ type(c_ptr) :: cp
- cp = transfer(ipointer, c_null_ptr)
- if (c_associated(cp)) then
- call c_f_pointer(cp, p)
- else
- p => null()
- end if
+ cp = transfer(ipointer, c_null_ptr)
+ if (c_associated(cp)) then
+ call c_f_pointer(cp, p)
+ else
+ p => null()
+ end if
-end subroutine int_pointer_to_f_pointer
+ end subroutine int_pointer_to_f_pointer
!*****************************************************************************************
!>
! create a [[radbelt_type]] from C
-subroutine initialize_c(ipointer) bind(C, name="initialize_c")
+ subroutine initialize_c(ipointer) bind(C, name="initialize_c")
- integer(c_intptr_t),intent(out) :: ipointer
- type(radbelt_type),pointer :: p
- type(c_ptr) :: cp
+ integer(c_intptr_t), intent(out) :: ipointer
+ type(radbelt_type), pointer :: p
+ type(c_ptr) :: cp
- allocate(p)
- cp = c_loc(p)
- ipointer = transfer(cp, 0_c_intptr_t)
+ allocate (p)
+ cp = c_loc(p)
+ ipointer = transfer(cp, 0_c_intptr_t)
-end subroutine initialize_c
+ end subroutine initialize_c
!*****************************************************************************************
!>
! destroy a [[radbelt_type]] from C
-subroutine destroy_c(ipointer) bind(C, name="destroy_c")
+ subroutine destroy_c(ipointer) bind(C, name="destroy_c")
- integer(c_intptr_t),intent(in) :: ipointer
- type(radbelt_type),pointer :: p
+ integer(c_intptr_t), intent(in) :: ipointer
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer,p)
- if (associated(p)) deallocate(p)
+ call int_pointer_to_f_pointer(ipointer, p)
+ if (associated(p)) deallocate (p)
-end subroutine destroy_c
+ end subroutine destroy_c
!*****************************************************************************************
!>
! C interface for setting the `trm` data file path
-subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name="set_trm_file_path_c")
+ subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name="set_trm_file_path_c")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `aep8_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: aep8_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `aep8_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: aep8_dir
- character(len=:),allocatable :: aep8_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: aep8_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
- aep8_dir_ = c2f_str(aep8_dir)
- call p%set_trm_file_path(aep8_dir_)
- else
- error stop 'error in set_trm_file_path_c: class is not associated'
- end if
+ if (associated(p)) then
+ aep8_dir_ = c2f_str(aep8_dir)
+ call p%set_trm_file_path(aep8_dir_)
+ else
+ error stop 'error in set_trm_file_path_c: class is not associated'
+ end if
- end subroutine set_trm_file_path_c
+ end subroutine set_trm_file_path_c
!*****************************************************************************************
!*****************************************************************************************
!>
! C interface for setting the `igrf` data file path
- subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name="set_igrf_file_path")
+ subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name="set_igrf_file_path")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `igrf_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: igrf_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `igrf_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: igrf_dir
- character(len=:),allocatable :: igrf_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: igrf_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
- igrf_dir_ = c2f_str(igrf_dir)
- call p%set_igrf_file_path(igrf_dir_)
- else
- error stop 'error in set_igrf_file_path: class is not associated'
- end if
+ if (associated(p)) then
+ igrf_dir_ = c2f_str(igrf_dir)
+ call p%set_igrf_file_path(igrf_dir_)
+ else
+ error stop 'error in set_igrf_file_path: class is not associated'
+ end if
- end subroutine set_igrf_file_path_c
+ end subroutine set_igrf_file_path_c
!*****************************************************************************************
!*****************************************************************************************
!>
! C interface for setting the data file paths
- subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name="set_data_files_paths_c")
+ subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name="set_data_files_paths_c")
- integer(c_intptr_t),intent(in) :: ipointer
- integer(c_int),intent(in) :: n !! size of `aep8_dir`
- character(kind=c_char,len=1),dimension(n),intent(in) :: aep8_dir
- integer(c_int),intent(in) :: m !! size of `igrf_dir`
- character(kind=c_char,len=1),dimension(m),intent(in) :: igrf_dir
+ integer(c_intptr_t), intent(in) :: ipointer
+ integer(c_int), intent(in) :: n !! size of `aep8_dir`
+ character(kind=c_char, len=1), dimension(n), intent(in) :: aep8_dir
+ integer(c_int), intent(in) :: m !! size of `igrf_dir`
+ character(kind=c_char, len=1), dimension(m), intent(in) :: igrf_dir
- character(len=:),allocatable :: aep8_dir_, igrf_dir_
- type(radbelt_type),pointer :: p
+ character(len=:), allocatable :: aep8_dir_, igrf_dir_
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
+ if (associated(p)) then
- aep8_dir_ = c2f_str(aep8_dir)
- igrf_dir_ = c2f_str(igrf_dir)
+ aep8_dir_ = c2f_str(aep8_dir)
+ igrf_dir_ = c2f_str(igrf_dir)
- call p%set_data_files_paths(aep8_dir_, igrf_dir_)
+ call p%set_data_files_paths(aep8_dir_, igrf_dir_)
- else
- error stop 'error in set_data_files_paths_c: class is not associated'
- end if
+ else
+ error stop 'error in set_data_files_paths_c: class is not associated'
+ end if
- end subroutine set_data_files_paths_c
+ end subroutine set_data_files_paths_c
!*****************************************************************************************
!*****************************************************************************************
!>
! C interface to [[get_flux_g]].
-subroutine get_flux_g_c(ipointer,lon,lat,height,year,e,imname,flux) bind(C, name="get_flux_g_c")
+ subroutine get_flux_g_c(ipointer, lon, lat, height, year, e, imname, flux) bind(C, name="get_flux_g_c")
- integer(c_intptr_t),intent(in) :: ipointer
- real(c_double),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(c_double),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(c_double),intent(in) :: height !! altitude in km above sea level
- real(c_double),intent(in) :: year !! decimal year for which geomagnetic field is to
+ integer(c_intptr_t), intent(in) :: ipointer
+ real(c_double), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(c_double), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(c_double), intent(in) :: height !! altitude in km above sea level
+ real(c_double), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(c_double),intent(in) :: e !! minimum energy
- integer(c_int),intent(in) :: imname !! which method to use:
+ real(c_double), intent(in) :: e !! minimum energy
+ integer(c_int), intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(c_double),intent(out) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(c_double), intent(out) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type),pointer :: p
+ type(radbelt_type), pointer :: p
- call int_pointer_to_f_pointer(ipointer, p)
+ call int_pointer_to_f_pointer(ipointer, p)
- if (associated(p)) then
+ if (associated(p)) then
- flux = p%get_flux(lon,lat,height,year,e,imname)
+ flux = p%get_flux(lon, lat, height, year, e, imname)
- else
- error stop 'error in get_flux_g_c: class is not associated'
- end if
+ else
+ error stop 'error in get_flux_g_c: class is not associated'
+ end if
-end subroutine get_flux_g_c
+ end subroutine get_flux_g_c
!*****************************************************************************************
- end module radbelt_c_module
+end module radbelt_c_module
!*****************************************************************************************
\ No newline at end of file
diff --git a/src/radbelt_kinds_module.F90 b/src/radbelt_kinds_module.F90
index b814007..de741b7 100644
--- a/src/radbelt_kinds_module.F90
+++ b/src/radbelt_kinds_module.F90
@@ -2,36 +2,36 @@
!>
! Numeric kind definitions for radbelt.
- module radbelt_kinds_module
+module radbelt_kinds_module
- use,intrinsic :: iso_fortran_env
+ use, intrinsic :: iso_fortran_env
implicit none
private
#ifdef REAL32
- integer,parameter,public :: wp = real32 !! Real working precision [4 bytes]
+ integer, parameter, public :: wp = real32 !! Real working precision [4 bytes]
#elif REAL64
- integer,parameter,public :: wp = real64 !! Real working precision [8 bytes]
+ integer, parameter, public :: wp = real64 !! Real working precision [8 bytes]
#elif REAL128
- integer,parameter,public :: wp = real128 !! Real working precision [16 bytes]
+ integer, parameter, public :: wp = real128 !! Real working precision [16 bytes]
#else
- integer,parameter,public :: wp = real64 !! Real working precision if not specified [8 bytes]
+ integer, parameter, public :: wp = real64 !! Real working precision if not specified [8 bytes]
#endif
#ifdef INT8
- integer,parameter,public :: ip = int8 !! Integer working precision [1 byte]
+ integer, parameter, public :: ip = int8 !! Integer working precision [1 byte]
#elif INT16
- integer,parameter,public :: ip = int16 !! Integer working precision [2 bytes]
+ integer, parameter, public :: ip = int16 !! Integer working precision [2 bytes]
#elif INT32
- integer,parameter,public :: ip = int32 !! Integer working precision [4 bytes]
+ integer, parameter, public :: ip = int32 !! Integer working precision [4 bytes]
#elif INT64
- integer,parameter,public :: ip = int64 !! Integer working precision [8 bytes]
+ integer, parameter, public :: ip = int64 !! Integer working precision [8 bytes]
#else
- integer,parameter,public :: ip = int32 !! Integer working precision if not specified [4 bytes]
+ integer, parameter, public :: ip = int32 !! Integer working precision if not specified [4 bytes]
#endif
!*****************************************************************************************
- end module radbelt_kinds_module
+end module radbelt_kinds_module
!*****************************************************************************************
diff --git a/src/radbelt_module.f90 b/src/radbelt_module.f90
index 7a0ff78..2f30265 100644
--- a/src/radbelt_module.f90
+++ b/src/radbelt_module.f90
@@ -8,61 +8,61 @@
module radbelt_module
- use radbelt_kinds_module
- use trmfun_module
- use shellig_module
-
- implicit none
-
- type,public :: radbelt_type
- !! the main class that can be used to get the flux.
- private
- type(trm_type) :: trm
- type(shellig_type) :: igrf
- contains
- private
- generic,public :: get_flux => get_flux_g_, get_flux_c_
- procedure :: get_flux_g_, get_flux_c_
- procedure,public :: set_trm_file_path, &
- set_igrf_file_path, &
- set_data_files_paths
- end type radbelt_type
-
- interface get_flux
- !! simple function versions for testing
- procedure :: get_flux_g
- procedure :: get_flux_c
- end interface
- public :: get_flux
-
- contains
+ use radbelt_kinds_module
+ use trmfun_module
+ use shellig_module
+
+ implicit none
+
+ type, public :: radbelt_type
+ !! the main class that can be used to get the flux.
+ private
+ type(trm_type) :: trm
+ type(shellig_type) :: igrf
+ contains
+ private
+ generic, public :: get_flux => get_flux_g_, get_flux_c_
+ procedure :: get_flux_g_, get_flux_c_
+ procedure, public :: set_trm_file_path, &
+ set_igrf_file_path, &
+ set_data_files_paths
+ end type radbelt_type
+
+ interface get_flux
+ !! simple function versions for testing
+ procedure :: get_flux_g
+ procedure :: get_flux_c
+ end interface
+ public :: get_flux
+
+contains
!*****************************************************************************************
!>
! Set the `trm` path.
- subroutine set_trm_file_path(me, dir)
+ subroutine set_trm_file_path(me, dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
- call me%trm%set_data_file_dir(trim(dir))
+ call me%trm%set_data_file_dir(trim(dir))
- end subroutine set_trm_file_path
+ end subroutine set_trm_file_path
!*****************************************************************************************
!*****************************************************************************************
!>
! Set the `igrf` path.
- subroutine set_igrf_file_path(me, dir)
+ subroutine set_igrf_file_path(me, dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
- call me%igrf%set_data_file_dir(trim(dir))
+ call me%igrf%set_data_file_dir(trim(dir))
- end subroutine set_igrf_file_path
+ end subroutine set_igrf_file_path
!*****************************************************************************************
!*****************************************************************************************
@@ -71,46 +71,46 @@ end subroutine set_igrf_file_path
! If not used or blank, the folder `data/aep8` and `data/igrf` in the
! current working directory is assumed
- subroutine set_data_files_paths(me, aep8_dir, igrf_dir)
+ subroutine set_data_files_paths(me, aep8_dir, igrf_dir)
- class(radbelt_type),intent(inout) :: me
- character(len=*),intent(in) :: aep8_dir
- character(len=*),intent(in) :: igrf_dir
+ class(radbelt_type), intent(inout) :: me
+ character(len=*), intent(in) :: aep8_dir
+ character(len=*), intent(in) :: igrf_dir
- call me%set_trm_file_path(trim(aep8_dir))
- call me%set_igrf_file_path(trim(igrf_dir))
+ call me%set_trm_file_path(trim(aep8_dir))
+ call me%set_igrf_file_path(trim(igrf_dir))
- end subroutine set_data_files_paths
+ end subroutine set_data_files_paths
!*****************************************************************************************
!*****************************************************************************************
!>
! Calculate the flux of trapped particles at a specific location and time.
- function get_flux_g_(me,lon,lat,height,year,e,imname) result(flux)
+ function get_flux_g_(me, lon, lat, height, year, e, imname) result(flux)
- class(radbelt_type),intent(inout) :: me
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(radbelt_type), intent(inout) :: me
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- real(wp) :: xl !! l value
- real(wp) :: bbx
+ real(wp) :: xl !! l value
+ real(wp) :: bbx
- call me%igrf%igrf(lon,lat,height,year,xl,bbx)
- call me%trm%aep8(e,xl,bbx,imname,flux)
+ call me%igrf%igrf(lon, lat, height, year, xl, bbx)
+ call me%trm%aep8(e, xl, bbx, imname, flux)
- end function get_flux_g_
+ end function get_flux_g_
!*****************************************************************************************
!*****************************************************************************************
@@ -121,27 +121,27 @@ end function get_flux_g_
!@note This routine is not efficient at all since it will reload all the
! files every time it is called.
- function get_flux_g(lon,lat,height,year,e,imname) result(flux)
+ function get_flux_g(lon, lat, height, year, e, imname) result(flux)
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type) :: radbelt
+ type(radbelt_type) :: radbelt
- flux = radbelt%get_flux(lon,lat,height,year,e,imname)
+ flux = radbelt%get_flux(lon, lat, height, year, e, imname)
- end function get_flux_g
+ end function get_flux_g
!*****************************************************************************************
!*****************************************************************************************
@@ -149,28 +149,28 @@ end function get_flux_g
! Calculate the flux of trapped particles at a specific location and time.
! This is an alternate version of [[get_flux_g_]] for cartesian coordinates.
- function get_flux_c_(me,v,year,e,imname) result(flux)
+ function get_flux_c_(me, v, year, e, imname) result(flux)
- class(radbelt_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(radbelt_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- real(wp) :: xl !! l value
- real(wp) :: bbx
+ real(wp) :: xl !! l value
+ real(wp) :: bbx
- call me%igrf%igrfc(v,year,xl,bbx)
- call me%trm%aep8(e,xl,bbx,imname,flux)
+ call me%igrf%igrfc(v, year, xl, bbx)
+ call me%trm%aep8(e, xl, bbx, imname, flux)
- end function get_flux_c_
+ end function get_flux_c_
!*****************************************************************************************
!*****************************************************************************************
@@ -181,24 +181,24 @@ end function get_flux_c_
!@note This routine is not efficient at all since it will reload all the
! files every time it is called.
- function get_flux_c(v,year,e,imname) result(flux)
+ function get_flux_c(v, year, e, imname) result(flux)
- real(wp),dimension(3),intent(in) :: v
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), dimension(3), intent(in) :: v
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(in) :: e !! minimum energy
- integer,intent(in) :: imname !! which method to use:
+ real(wp), intent(in) :: e !! minimum energy
+ integer, intent(in) :: imname !! which method to use:
!!
!! * 1 -- particle species: electrons, solar activity: min
!! * 2 -- particle species: electrons, solar activity: max
!! * 3 -- particle species: protons, solar activity: min
!! * 4 -- particle species: protons, solar activity: max
- real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
+ real(wp) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1.
- type(radbelt_type) :: radbelt
+ type(radbelt_type) :: radbelt
- flux = radbelt%get_flux(v,year,e,imname)
+ flux = radbelt%get_flux(v, year, e, imname)
- end function get_flux_c
+ end function get_flux_c
end module radbelt_module
diff --git a/src/shellig.f90 b/src/shellig.f90
index 388d230..232016a 100644
--- a/src/shellig.f90
+++ b/src/shellig.f90
@@ -11,302 +11,302 @@
! * 5/31/00-DKB- Updated to IGRF-45-00; new coeff.: IGRF00, IGRF00s
! * 3/24/05-DKB- Updated to IGRF-45-10; new coeff.: IGRF05, IGRF05s
- module shellig_module
+module shellig_module
- use radbelt_kinds_module
+ use radbelt_kinds_module
- implicit none
+ implicit none
- private
+ private
- integer,parameter :: filename_len = 14 !! length of the model data file names
+ integer, parameter :: filename_len = 14 !! length of the model data file names
- ! parameters formerly in `gener` common block
- real(wp),parameter :: Era = 6371.2_wp !! earth radius for normalization of cartesian coordinates (6371.2 km)
- real(wp),parameter :: erequ = 6378.16_wp
- real(wp),parameter :: erpol = 6356.775_wp
- real(wp),parameter :: Aquad = erequ*erequ !! square of major half axis for
+ ! parameters formerly in `gener` common block
+ real(wp), parameter :: Era = 6371.2_wp !! earth radius for normalization of cartesian coordinates (6371.2 km)
+ real(wp), parameter :: erequ = 6378.16_wp
+ real(wp), parameter :: erpol = 6356.775_wp
+ real(wp), parameter :: Aquad = erequ * erequ !! square of major half axis for
!! earth ellipsoid as recommended by international
!! astronomical union
- real(wp),parameter :: Bquad = erpol*erpol !! square of minor half axis for
+ real(wp), parameter :: Bquad = erpol * erpol !! square of minor half axis for
!! earth ellipsoid as recommended by international
!! astronomical union
- real(wp),parameter :: Umr = atan(1.0_wp)*4.0_wp/180.0_wp !! atan(1.0)*4./180. *umr=
+ real(wp), parameter :: Umr = atan(1.0_wp) * 4.0_wp / 180.0_wp !! atan(1.0)*4./180. *umr=
- real(wp),dimension(3,3),parameter :: u = reshape([ +0.3511737_wp , -0.9148385_wp , -0.1993679_wp , &
- +0.9335804_wp , +0.3583680_wp , +0.0000000_wp , &
- +0.0714471_wp , -0.1861260_wp , +0.9799247_wp], [3,3])
- integer,parameter :: max_loop_index = 3333 !! used in [[shellg]] for the field line integration loop
+ real(wp), dimension(3, 3), parameter :: u = reshape([+0.3511737_wp, -0.9148385_wp, -0.1993679_wp, &
+ +0.9335804_wp, +0.3583680_wp, +0.0000000_wp, &
+ +0.0714471_wp, -0.1861260_wp, +0.9799247_wp], [3, 3])
+ integer, parameter :: max_loop_index = 3333 !! used in [[shellg]] for the field line integration loop
- type,public :: shellig_type
- private
+ type, public :: shellig_type
+ private
- character(len=:),allocatable :: igrf_dir !! directory containing the data files
+ character(len=:), allocatable :: igrf_dir !! directory containing the data files
- ! formerly in the `fidb0` common block
- real(wp),dimension(3) :: sp = 0.0_wp
+ ! formerly in the `fidb0` common block
+ real(wp), dimension(3) :: sp = 0.0_wp
- ! formerly in blank common
- real(wp),dimension(3) :: xi = 0.0_wp
- real(wp),dimension(144) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]]
+ ! formerly in blank common
+ real(wp), dimension(3) :: xi = 0.0_wp
+ real(wp), dimension(144) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]]
- ! formerly in `model` common block
- integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read
- character(len=:),allocatable :: name !! file name
- integer :: nmax = 0 !! maximum order of spherical harmonics
- real(wp) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated
- real(wp),dimension(144) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2)
- integer :: nmax1 = 0 !! saved variables from the file
- integer :: nmax2 = 0 !! saved variables from the file
- real(wp),dimension(144) :: g_cache = 0.0_wp !! saved `g` from the file
+ ! formerly in `model` common block
+ integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read
+ character(len=:), allocatable :: name !! file name
+ integer :: nmax = 0 !! maximum order of spherical harmonics
+ real(wp) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated
+ real(wp), dimension(144) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2)
+ integer :: nmax1 = 0 !! saved variables from the file
+ integer :: nmax2 = 0 !! saved variables from the file
+ real(wp), dimension(144) :: g_cache = 0.0_wp !! saved `g` from the file
- ! formerly saved vars in shellg:
- real(wp) :: step = 0.20_wp !! step size for field line tracing
- real(wp) :: steq = 0.03_wp !! step size for integration
+ ! formerly saved vars in shellg:
+ real(wp) :: step = 0.20_wp !! step size for field line tracing
+ real(wp) :: steq = 0.03_wp !! step size for integration
- ! from feldcof, so we can cache the coefficients
- real(wp),dimension(120) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ???
+ ! from feldcof, so we can cache the coefficients
+ real(wp), dimension(120) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ???
- real(wp),dimension(:,:),allocatable :: p !! this was `p(8,100)` in the original code.
+ real(wp), dimension(:, :), allocatable :: p !! this was `p(8,100)` in the original code.
!! used for the field line integration loop.
!! changed it to be allocatable since it was
!! changed to be p(8,3334).
- contains
- private
+ contains
+ private
- procedure,public :: igrf, igrfc
+ procedure, public :: igrf, igrfc
- procedure, public :: feldcof
- procedure, public :: feldg, feldc
- procedure, public :: shellg, shellc
- procedure, public :: findb0
- procedure :: stoer, feldi
- procedure,public :: set_data_file_dir, get_data_file_dir
- procedure,public :: destroy => destroy_shellig_type
+ procedure, public :: feldcof
+ procedure, public :: feldg, feldc
+ procedure, public :: shellg, shellc
+ procedure, public :: findb0
+ procedure :: stoer, feldi
+ procedure, public :: set_data_file_dir, get_data_file_dir
+ procedure, public :: destroy => destroy_shellig_type
- end type shellig_type
+ end type shellig_type
- contains
+contains
!*****************************************************************************************
!*****************************************************************************************
!>
! Destroy a [[shellig_type]].
- subroutine destroy_shellig_type(me)
- class(shellig_type),intent(out) :: me
- end subroutine destroy_shellig_type
+ subroutine destroy_shellig_type(me)
+ class(shellig_type), intent(out) :: me
+ end subroutine destroy_shellig_type
!*****************************************************************************************
!>
! Set the directory containing the data files.
- subroutine set_data_file_dir(me,dir)
- class(shellig_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
- me%igrf_dir = trim(dir)
- end subroutine set_data_file_dir
+ subroutine set_data_file_dir(me, dir)
+ class(shellig_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
+ me%igrf_dir = trim(dir)
+ end subroutine set_data_file_dir
!*****************************************************************************************
!>
! Get the directory containing the data files.
- function get_data_file_dir(me) result(dir)
- class(shellig_type),intent(in) :: me
- character(len=:),allocatable :: dir
- if (allocated(me%igrf_dir)) then
- dir = trim(me%igrf_dir) // '/'
- else
- dir = 'data/igrf/' ! default
- end if
- end function get_data_file_dir
+ function get_data_file_dir(me) result(dir)
+ class(shellig_type), intent(in) :: me
+ character(len=:), allocatable :: dir
+ if (allocated(me%igrf_dir)) then
+ dir = trim(me%igrf_dir)//'/'
+ else
+ dir = 'data/igrf/' ! default
+ end if
+ end function get_data_file_dir
!*****************************************************************************************
!>
! Wrapper for IGRF functions.
- subroutine igrf(me,lon,lat,height,year,xl,bbx)
+ subroutine igrf(me, lon, lat, height, year, xl, bbx)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: lon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: lat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: height !! altitude in km above sea level
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: lon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: lat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: height !! altitude in km above sea level
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: xl !! l-value
- real(wp),intent(out) :: bbx !! b_total / b_equatorial ratio
-
- real(wp) :: bab1 , babs , bdel , bdown , beast , &
- beq , bequ , bnorth , dimo , rr0
- integer :: icode
- logical :: val
-
- real(wp),parameter :: stps = 0.05_wp
-
- ! JW : do we need to reset some or all of these ?
- me%sp = 0.0_wp
- me%xi = 0.0_wp
- me%h = 0.0_wp
- me%step = 0.20_wp
- me%steq = 0.03_wp
-
- call me%feldcof(year,dimo)
- call me%feldg(lat,lon,height,bnorth,beast,bdown,babs)
- call me%shellg(lat,lon,height,dimo,xl,icode,bab1)
-
- bequ = dimo/(xl*xl*xl)
- if ( icode==1 ) then
- bdel = 1.0e-3_wp
- call me%findb0(stps,bdel,val,beq,rr0)
- if ( val ) bequ = beq
- endif
- bbx = babs/bequ
-
- end subroutine igrf
+ real(wp), intent(out) :: xl !! l-value
+ real(wp), intent(out) :: bbx !! b_total / b_equatorial ratio
+
+ real(wp) :: bab1, babs, bdel, bdown, beast, &
+ beq, bequ, bnorth, dimo, rr0
+ integer :: icode
+ logical :: val
+
+ real(wp), parameter :: stps = 0.05_wp
+
+ ! JW : do we need to reset some or all of these ?
+ me%sp = 0.0_wp
+ me%xi = 0.0_wp
+ me%h = 0.0_wp
+ me%step = 0.20_wp
+ me%steq = 0.03_wp
+
+ call me%feldcof(year, dimo)
+ call me%feldg(lat, lon, height, bnorth, beast, bdown, babs)
+ call me%shellg(lat, lon, height, dimo, xl, icode, bab1)
+
+ bequ = dimo / (xl * xl * xl)
+ if (icode == 1) then
+ bdel = 1.0e-3_wp
+ call me%findb0(stps, bdel, val, beq, rr0)
+ if (val) bequ = beq
+ end if
+ bbx = babs / bequ
+
+ end subroutine igrf
!*****************************************************************************************
!*****************************************************************************************
!>
! Alternate version of [[igrf]] for cartesian coordinates.
- subroutine igrfc(me,v,year,xl,bbx)
+ subroutine igrfc(me, v, year, xl, bbx)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! x-axis pointing to equator at 0 longitude
!! y-axis pointing to equator at 90 long.
!! z-axis pointing to north pole
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: xl !! l-value
- real(wp),intent(out) :: bbx !! b_total / b_equatorial ratio
-
- real(wp) :: bab1 , bdel , beq , bequ , dimo , rr0
- integer :: icode
- logical :: val
- real(wp),dimension(3) :: b
-
- real(wp),parameter :: stps = 0.05_wp
-
- ! JW : do we need to reset some or all of these ?
- me%sp = 0.0_wp
- me%xi = 0.0_wp
- me%h = 0.0_wp
- me%step = 0.20_wp
- me%steq = 0.03_wp
-
- call me%feldcof(year,dimo)
- call me%feldc(v,b)
- call me%shellc(v,dimo,xl,icode,bab1)
-
- bequ = dimo/(xl*xl*xl)
- if ( icode==1 ) then
- bdel = 1.0e-3_wp
- call me%findb0(stps,bdel,val,beq,rr0)
- if ( val ) bequ = beq
- endif
- bbx = norm2(b)/bequ
-
- end subroutine igrfc
+ real(wp), intent(out) :: xl !! l-value
+ real(wp), intent(out) :: bbx !! b_total / b_equatorial ratio
+
+ real(wp) :: bab1, bdel, beq, bequ, dimo, rr0
+ integer :: icode
+ logical :: val
+ real(wp), dimension(3) :: b
+
+ real(wp), parameter :: stps = 0.05_wp
+
+ ! JW : do we need to reset some or all of these ?
+ me%sp = 0.0_wp
+ me%xi = 0.0_wp
+ me%h = 0.0_wp
+ me%step = 0.20_wp
+ me%steq = 0.03_wp
+
+ call me%feldcof(year, dimo)
+ call me%feldc(v, b)
+ call me%shellc(v, dimo, xl, icode, bab1)
+
+ bequ = dimo / (xl * xl * xl)
+ if (icode == 1) then
+ bdel = 1.0e-3_wp
+ call me%findb0(stps, bdel, val, beq, rr0)
+ if (val) bequ = beq
+ end if
+ bbx = norm2(b) / bequ
+
+ end subroutine igrfc
!*****************************************************************************************
!*****************************************************************************************
!>
- subroutine findb0(me,stps,bdel,value,bequ,rr0)
-
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: stps
- real(wp),intent(inout) :: bdel
- real(wp),intent(out) :: bequ
- logical,intent(out) :: value
- real(wp),intent(out) :: rr0
-
- real(wp) :: b , bdelta , bmin , bold , bq1 , &
- bq2 , bq3 , p(8,4) , r1 , r2 , r3 , &
- rold , step , step12 , zz
- integer :: i , irun , j , n
-
- step=stps
- irun=0
- rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
-
- main : do
- irun=irun+1
- if (irun>5) then
- value=.false.
- exit main
- endif
- ! first three points
- p(1,2)=me%sp(1)
- p(2,2)=me%sp(2)
- p(3,2)=me%sp(3)
- step=-sign(step,p(3,2))
- call me%stoer(p(1,2),bq2,r2)
- p(1,3)=p(1,2)+0.5_wp*step*p(4,2)
- p(2,3)=p(2,2)+0.5_wp*step*p(5,2)
- p(3,3)=p(3,2)+0.5_wp*step
- call me%stoer(p(1,3),bq3,r3)
- p(1,1)=p(1,2)-step*(2.0_wp*p(4,2)-p(4,3))
- p(2,1)=p(2,2)-step*(2.0_wp*p(5,2)-p(5,3))
- p(3,1)=p(3,2)-step
- call me%stoer(p(1,1),bq1,r1)
- p(1,3)=p(1,2)+step*(20.0_wp*p(4,3)-3.*p(4,2)+p(4,1))/18.0_wp
- p(2,3)=p(2,2)+step*(20.0_wp*p(5,3)-3.*p(5,2)+p(5,1))/18.0_wp
- p(3,3)=p(3,2)+step
- call me%stoer(p(1,3),bq3,r3)
- ! invert sense if required
- if (bq3>bq1) then
- step=-step
- r3=r1
- bq3=bq1
- do i=1,5
- zz=p(i,1)
- p(i,1)=p(i,3)
- p(i,3)=zz
- end do
- end if
- ! initialization
- step12=step/12.0_wp
- value=.true.
- bmin=1.0e4_wp
- bold=1.0e4_wp
- ! corrector (field line tracing)
- n=0
- corrector : do
- p(1,3)=p(1,2)+step12*(5.0_wp*p(4,3)+8.0_wp*p(4,2)-p(4,1))
- n=n+1
- p(2,3)=p(2,2)+step12*(5.0_wp*p(5,3)+8.0_wp*p(5,2)-p(5,1))
- ! predictor (field line tracing)
- p(1,4)=p(1,3)+step12*(23.0_wp*p(4,3)-16.0_wp*p(4,2)+5.0_wp*p(4,1))
- p(2,4)=p(2,3)+step12*(23.0_wp*p(5,3)-16.0_wp*p(5,2)+5.0_wp*p(5,1))
- p(3,4)=p(3,3)+step
- call me%stoer(p(1,4),bq3,r3)
- do j=1,3
- do i=1,8
- p(i,j)=p(i,j+1)
+ subroutine findb0(me, stps, bdel, value, bequ, rr0)
+
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: stps
+ real(wp), intent(inout) :: bdel
+ real(wp), intent(out) :: bequ
+ logical, intent(out) :: value
+ real(wp), intent(out) :: rr0
+
+ real(wp) :: b, bdelta, bmin, bold, bq1, &
+ bq2, bq3, p(8, 4), r1, r2, r3, &
+ rold, step, step12, zz
+ integer :: i, irun, j, n
+
+ step = stps
+ irun = 0
+ rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+
+ main: do
+ irun = irun + 1
+ if (irun > 5) then
+ value = .false.
+ exit main
+ end if
+ ! first three points
+ p(1, 2) = me%sp(1)
+ p(2, 2) = me%sp(2)
+ p(3, 2) = me%sp(3)
+ step = -sign(step, p(3, 2))
+ call me%stoer(p(1, 2), bq2, r2)
+ p(1, 3) = p(1, 2) + 0.5_wp * step * p(4, 2)
+ p(2, 3) = p(2, 2) + 0.5_wp * step * p(5, 2)
+ p(3, 3) = p(3, 2) + 0.5_wp * step
+ call me%stoer(p(1, 3), bq3, r3)
+ p(1, 1) = p(1, 2) - step * (2.0_wp * p(4, 2) - p(4, 3))
+ p(2, 1) = p(2, 2) - step * (2.0_wp * p(5, 2) - p(5, 3))
+ p(3, 1) = p(3, 2) - step
+ call me%stoer(p(1, 1), bq1, r1)
+ p(1, 3) = p(1, 2) + step * (20.0_wp * p(4, 3) - 3.*p(4, 2) + p(4, 1)) / 18.0_wp
+ p(2, 3) = p(2, 2) + step * (20.0_wp * p(5, 3) - 3.*p(5, 2) + p(5, 1)) / 18.0_wp
+ p(3, 3) = p(3, 2) + step
+ call me%stoer(p(1, 3), bq3, r3)
+ ! invert sense if required
+ if (bq3 > bq1) then
+ step = -step
+ r3 = r1
+ bq3 = bq1
+ do i = 1, 5
+ zz = p(i, 1)
+ p(i, 1) = p(i, 3)
+ p(i, 3) = zz
end do
- end do
- b=sqrt(bq3)
- if (bbold) exit corrector
- bold=b
- rold=1.0_wp/r3
- me%sp(1)=p(1,4)
- me%sp(2)=p(2,4)
- me%sp(3)=p(3,4)
- end do corrector
- if (bold/=bmin) value=.false.
- bdelta=(b-bold)/bold
- if (bdelta<=bdel) exit main
- step=step/10.0_wp
- end do main
-
- rr0=rold
- bequ=bold
- bdel=bdelta
-
- end subroutine findb0
+ end if
+ ! initialization
+ step12 = step / 12.0_wp
+ value = .true.
+ bmin = 1.0e4_wp
+ bold = 1.0e4_wp
+ ! corrector (field line tracing)
+ n = 0
+ corrector: do
+ p(1, 3) = p(1, 2) + step12 * (5.0_wp * p(4, 3) + 8.0_wp * p(4, 2) - p(4, 1))
+ n = n + 1
+ p(2, 3) = p(2, 2) + step12 * (5.0_wp * p(5, 3) + 8.0_wp * p(5, 2) - p(5, 1))
+ ! predictor (field line tracing)
+ p(1, 4) = p(1, 3) + step12 * (23.0_wp * p(4, 3) - 16.0_wp * p(4, 2) + 5.0_wp * p(4, 1))
+ p(2, 4) = p(2, 3) + step12 * (23.0_wp * p(5, 3) - 16.0_wp * p(5, 2) + 5.0_wp * p(5, 1))
+ p(3, 4) = p(3, 3) + step
+ call me%stoer(p(1, 4), bq3, r3)
+ do j = 1, 3
+ do i = 1, 8
+ p(i, j) = p(i, j + 1)
+ end do
+ end do
+ b = sqrt(bq3)
+ if (b < bmin) bmin = b
+ if (b > bold) exit corrector
+ bold = b
+ rold = 1.0_wp / r3
+ me%sp(1) = p(1, 4)
+ me%sp(2) = p(2, 4)
+ me%sp(3) = p(3, 4)
+ end do corrector
+ if (bold /= bmin) value = .false.
+ bdelta = (b - bold) / bold
+ if (bdelta <= bdel) exit main
+ step = step / 10.0_wp
+ end do main
+
+ rr0 = rold
+ bequ = bold
+ bdel = bdelta
+
+ end subroutine findb0
!*****************************************************************************************
!>
@@ -315,26 +315,26 @@ end subroutine findb0
!@note In the original code, this was an ENTRY point in [[shellg]] and didn't
! include all the outputs.
- subroutine shellc(me,v,dimo,fl,icode,b0)
+ subroutine shellc(me, v, dimo, fl, icode, b0)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
!! * z-axis pointing to north pole
- real(wp),intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
- real(wp),intent(out) :: fl !! l-value
- integer,intent(out) :: icode !! * =1 normal completion
+ real(wp), intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
+ real(wp), intent(out) :: fl !! l-value
+ integer, intent(out) :: icode !! * =1 normal completion
!! * =2 unphysical conjugate point (fl meaningless)
!! * =3 shell parameter greater than limit up to
!! which accurate calculation is required;
!! approximation is used.
- real(wp),intent(out) :: b0 !! magnetic field strength in gauss
- real(wp) :: glat,glon,alt !! not used
+ real(wp), intent(out) :: b0 !! magnetic field strength in gauss
+ real(wp) :: glat, glon, alt !! not used
- call me%shellg(glat,glon,alt,dimo,fl,icode,b0,v)
+ call me%shellg(glat, glon, alt, dimo, fl, icode, b0, v)
- end subroutine shellc
+ end subroutine shellc
!*****************************************************************************************
!>
@@ -351,21 +351,21 @@ end subroutine shellc
! - USING CORRECT DIPOL MOMENT I.E.,DIFFERENT COMMON/MODEL/
! - USING IGRF EARTH MAGNETIC FIELD MODELS FROM 1945 TO 1990
- subroutine shellg(me,glat,glon,alt,dimo,fl,icode,b0,v)
+ subroutine shellg(me, glat, glon, alt, dimo, fl, icode, b0, v)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: glat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: glon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: alt !! altitude in km above sea level
- real(wp),intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
- real(wp),intent(out) :: fl !! l-value
- integer,intent(out) :: icode !! * =1 normal completion
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: glat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: glon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: alt !! altitude in km above sea level
+ real(wp), intent(in) :: dimo !! dipol moment in gauss (normalized to earth radius)
+ real(wp), intent(out) :: fl !! l-value
+ integer, intent(out) :: icode !! * =1 normal completion
!! * =2 unphysical conjugate point (fl meaningless)
!! * =3 shell parameter greater than limit up to
!! which accurate calculation is required;
!! approximation is used.
- real(wp),intent(out) :: b0 !! magnetic field strength in gauss
- real(wp),dimension(3),intent(in),optional :: v !! cartesian coordinates in earth radii (6371.2 km)
+ real(wp), intent(out) :: b0 !! magnetic field strength in gauss
+ real(wp), dimension(3), intent(in), optional :: v !! cartesian coordinates in earth radii (6371.2 km)
!!
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
@@ -374,251 +374,251 @@ subroutine shellg(me,glat,glon,alt,dimo,fl,icode,b0,v)
!! If this argument is present, it is used
!! instead of glat,glon,alt. See [[shellc]].
- real(wp) :: arg1 , arg2 , bequ , bq1 , bq2 , bq3 , c0 , c1 , c2 , c3 , &
- d0 , d1 , d2, dimob0 , e0 , e1 , e2 , ff , fi , gg , &
- hli , oradik , oterm , r , r1 , r2 , r3 , r3h , radik , &
- rq , step12 , step2 , stp , t , term , xx , z , zq , zz
- integer :: i , iequ , n
-
- real(wp),parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3`
- real(wp),parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3`
-
- if (.not. allocated(me%p)) allocate(me%p(8,max_loop_index+1)) ! because `p(:,n+1)` in the loop
-
- bequ = 1.0e10_wp
-
- if (present(v)) then
- me%xi(1) = v(1)
- me%xi(2) = v(2)
- me%xi(3) = v(3)
- else
- me%xi = geo_to_cart(glat,glon,alt)
- end if
-
- associate (p => me%p)
-
- ! convert to dipol-oriented co-ordinates
- rq = 1.0_wp/(me%xi(1)*me%xi(1)+me%xi(2)*me%xi(2)+me%xi(3)*me%xi(3))
- r3h = sqrt(rq*sqrt(rq))
- p(1,2) = (me%xi(1)*u(1,1)+me%xi(2)*u(2,1)+me%xi(3)*u(3,1))*r3h
- p(2,2) = (me%xi(1)*u(1,2)+me%xi(2)*u(2,2))*r3h
- p(3,2) = (me%xi(1)*u(1,3)+me%xi(2)*u(2,3)+me%xi(3)*u(3,3))*rq
- ! first three points of field line
- me%step = -sign(me%step,p(3,2))
- call me%stoer(p(1,2),bq2,r2)
- b0 = sqrt(bq2)
- p(1,3) = p(1,2) + 0.5_wp*me%step*p(4,2)
- p(2,3) = p(2,2) + 0.5_wp*me%step*p(5,2)
- p(3,3) = p(3,2) + 0.5_wp*me%step
- call me%stoer(p(1,3),bq3,r3)
- p(1,1) = p(1,2) - me%step*(2.0_wp*p(4,2)-p(4,3))
- p(2,1) = p(2,2) - me%step*(2.0_wp*p(5,2)-p(5,3))
- p(3,1) = p(3,2) - me%step
- call me%stoer(p(1,1),bq1,r1)
- p(1,3) = p(1,2) + me%step*(20.0_wp*p(4,3)-3.*p(4,2)+p(4,1))/18.0_wp
- p(2,3) = p(2,2) + me%step*(20.0_wp*p(5,3)-3.*p(5,2)+p(5,1))/18.0_wp
- p(3,3) = p(3,2) + me%step
- call me%stoer(p(1,3),bq3,r3)
- ! invert sense if required
- if ( bq3>bq1 ) then
- me%step = -me%step
- r3 = r1
- bq3 = bq1
- do i = 1 , 7
- zz = p(i,1)
- p(i,1) = p(i,3)
- p(i,3) = zz
- enddo
- endif
- ! search for lowest magnetic field strength
- if ( bq11.0_wp ) then
- ! predictor (field line tracing)
- p(1,n+1) = p(1,n) + step12*(23.0_wp*p(4,n)-16.0_wp*p(4,n-1)+5.0_wp*p(4,n-2))
- p(2,n+1) = p(2,n) + step12*(23.0_wp*p(5,n)-16.0_wp*p(5,n-1)+5.0_wp*p(5,n-2))
- p(3,n+1) = p(3,n) + me%step
- call me%stoer(p(1,n+1),bq3,r3)
- ! search for lowest magnetic field strength
- if ( bq3 me%p)
+
+ ! convert to dipol-oriented co-ordinates
+ rq = 1.0_wp / (me%xi(1) * me%xi(1) + me%xi(2) * me%xi(2) + me%xi(3) * me%xi(3))
+ r3h = sqrt(rq * sqrt(rq))
+ p(1, 2) = (me%xi(1) * u(1, 1) + me%xi(2) * u(2, 1) + me%xi(3) * u(3, 1)) * r3h
+ p(2, 2) = (me%xi(1) * u(1, 2) + me%xi(2) * u(2, 2)) * r3h
+ p(3, 2) = (me%xi(1) * u(1, 3) + me%xi(2) * u(2, 3) + me%xi(3) * u(3, 3)) * rq
+ ! first three points of field line
+ me%step = -sign(me%step, p(3, 2))
+ call me%stoer(p(1, 2), bq2, r2)
+ b0 = sqrt(bq2)
+ p(1, 3) = p(1, 2) + 0.5_wp * me%step * p(4, 2)
+ p(2, 3) = p(2, 2) + 0.5_wp * me%step * p(5, 2)
+ p(3, 3) = p(3, 2) + 0.5_wp * me%step
+ call me%stoer(p(1, 3), bq3, r3)
+ p(1, 1) = p(1, 2) - me%step * (2.0_wp * p(4, 2) - p(4, 3))
+ p(2, 1) = p(2, 2) - me%step * (2.0_wp * p(5, 2) - p(5, 3))
+ p(3, 1) = p(3, 2) - me%step
+ call me%stoer(p(1, 1), bq1, r1)
+ p(1, 3) = p(1, 2) + me%step * (20.0_wp * p(4, 3) - 3.*p(4, 2) + p(4, 1)) / 18.0_wp
+ p(2, 3) = p(2, 2) + me%step * (20.0_wp * p(5, 3) - 3.*p(5, 2) + p(5, 1)) / 18.0_wp
+ p(3, 3) = p(3, 2) + me%step
+ call me%stoer(p(1, 3), bq3, r3)
+ ! invert sense if required
+ if (bq3 > bq1) then
+ me%step = -me%step
+ r3 = r1
+ bq3 = bq1
+ do i = 1, 7
+ zz = p(i, 1)
+ p(i, 1) = p(i, 3)
+ p(i, 3) = zz
+ end do
+ end if
+ ! search for lowest magnetic field strength
+ if (bq1 < bequ) then
+ bequ = bq1
+ iequ = 1
+ end if
+ if (bq2 < bequ) then
+ bequ = bq2
+ iequ = 2
+ end if
+ if (bq3 < bequ) then
+ bequ = bq3
+ iequ = 3
+ end if
+ ! initialization of integration loops
+ step12 = me%step / 12.0_wp
+ step2 = me%step + me%step
+ me%steq = sign(me%steq, me%step)
+ fi = 0.0_wp
+ icode = 1
+ oradik = 0.0_wp
+ oterm = 0.0_wp
+ stp = r2 * me%steq
+ z = p(3, 2) + stp
+ stp = stp / 0.75_wp
+ p(8, 1) = step2 * (p(1, 1) * p(4, 1) + p(2, 1) * p(5, 1))
+ p(8, 2) = step2 * (p(1, 2) * p(4, 2) + p(2, 2) * p(5, 2))
+ ! main loop (field line tracing)
+ main: do n = 3, max_loop_index
+ ! corrector (field line tracing)
+ p(1, n) = p(1, n - 1) + step12 * (5.0_wp * p(4, n) + 8.0_wp * p(4, n - 1) - p(4, n - 2))
+ p(2, n) = p(2, n - 1) + step12 * (5.0_wp * p(5, n) + 8.0_wp * p(5, n - 1) - p(5, n - 2))
+ ! prepare expansion coefficients for interpolation
+ ! of slowly varying quantities
+ p(8, n) = step2 * (p(1, n) * p(4, n) + p(2, n) * p(5, n))
+ c0 = p(1, n - 1)**2 + p(2, n - 1)**2
+ c1 = p(8, n - 1)
+ c2 = (p(8, n) - p(8, n - 2)) * 0.25_wp
+ c3 = (p(8, n) + p(8, n - 2) - c1 - c1) / 6.0_wp
+ d0 = p(6, n - 1)
+ d1 = (p(6, n) - p(6, n - 2)) * 0.5_wp
+ d2 = (p(6, n) + p(6, n - 2) - d0 - d0) * 0.5_wp
+ e0 = p(7, n - 1)
+ e1 = (p(7, n) - p(7, n - 2)) * 0.5_wp
+ e2 = (p(7, n) + p(7, n - 2) - e0 - e0) * 0.5_wp
+ inner: do
+ ! inner loop (for quadrature)
+ t = (z - p(3, n - 1)) / me%step
+ if (t > 1.0_wp) then
+ ! predictor (field line tracing)
+ p(1, n + 1) = p(1, n) + step12 * (23.0_wp * p(4, n) - 16.0_wp * p(4, n - 1) + 5.0_wp * p(4, n - 2))
+ p(2, n + 1) = p(2, n) + step12 * (23.0_wp * p(5, n) - 16.0_wp * p(5, n - 1) + 5.0_wp * p(5, n - 2))
+ p(3, n + 1) = p(3, n) + me%step
+ call me%stoer(p(1, n + 1), bq3, r3)
+ ! search for lowest magnetic field strength
+ if (bq3 < bequ) then
+ iequ = n + 1
+ bequ = bq3
+ end if
+ exit inner
+ else
+ hli = 0.5_wp * (((c3 * t + c2) * t + c1) * t + c0)
+ zq = z * z
+ r = hli + sqrt(hli * hli + zq)
+ if (r <= rmin) then
+ ! approximation for high values of l.
+ icode = 3
+ t = -p(3, n - 1) / me%step
+ fl = 1.0_wp / (abs(((c3 * t + c2) * t + c1) * t + c0) + 1.0e-15_wp)
+ return
+ end if
+ rq = r * r
+ ff = sqrt(1.0_wp + 3.0_wp * zq / rq)
+ radik = b0 - ((d2 * t + d1) * t + d0) * r * rq * ff
+ if (r > rmax) then
+ icode = 2
+ radik = radik - 12.0_wp * (r - rmax)**2
+ end if
+ if (radik + radik <= oradik) exit main
+ term = sqrt(radik) * ff * ((e2 * t + e1) * t + e0) / (rq + zq)
+ fi = fi + stp * (oterm + term)
+ oradik = radik
+ oterm = term
+ stp = r * me%steq
+ z = z + stp
+ end if
+ end do inner
+ end do main
+ if (iequ < 2) iequ = 2
+ me%sp(1) = p(1, iequ - 1)
+ me%sp(2) = p(2, iequ - 1)
+ me%sp(3) = p(3, iequ - 1)
+ if (oradik >= 1.0e-15_wp) fi = fi + stp / 0.75_wp * oterm * oradik / (oradik - radik)
+
+ ! the minimal allowable value of fi was changed from 1e-15 to 1e-12,
+ ! because 1e-38 is the minimal allowable arg. for alog in our envir.
+ ! d. bilitza, nov 87.
+ fi = 0.5_wp * abs(fi) / sqrt(b0) + 1.0e-12_wp
+
+ ! compute l from b and i. same as carmel in invar.
+ ! correct dipole moment is used here. d. bilitza, nov 87.
+ dimob0 = dimo / b0
+ arg1 = log(fi)
+ arg2 = log(dimob0)
+ ! arg = fi*fi*fi/dimob0
+ ! if(abs(arg)>88.0_wp) arg=88.0_wp
+ xx = 3 * arg1 - arg2
+ if (xx > 23.0_wp) then
+ gg = xx - 3.0460681_wp
+ elseif (xx > 11.7_wp) then
+ gg = (((((2.8212095e-8_wp * xx - 3.8049276e-6_wp) * xx + &
+ 2.170224e-4_wp) * xx - 6.7310339e-3_wp) * xx + &
+ 1.2038224e-1_wp) * xx - 1.8461796e-1_wp) * xx + 2.0007187_wp
+ elseif (xx > +3.0_wp) then
+ gg = ((((((((6.3271665e-10_wp * xx - 3.958306e-8_wp) * xx + &
+ 9.9766148e-07_wp) * xx - 1.2531932e-5_wp) * xx + &
+ 7.9451313e-5_wp) * xx - 3.2077032e-4_wp) * xx + &
+ 2.1680398e-3_wp) * xx + 1.2817956e-2_wp) * xx + &
+ 4.3510529e-1_wp) * xx + 6.222355e-1_wp
+ elseif (xx > -3.0_wp) then
+ gg = ((((((((2.6047023e-10_wp * xx + 2.3028767e-9_wp) * xx - &
+ 2.1997983e-8_wp) * xx - 5.3977642e-7_wp) * xx - &
+ 3.3408822e-6_wp) * xx + 3.8379917e-5_wp) * xx + &
+ 1.1784234e-3_wp) * xx + 1.4492441e-2_wp) * xx + &
+ 4.3352788e-1_wp) * xx + 6.228644e-1_wp
+ elseif (xx > -22.0_wp) then
+ gg = ((((((((-8.1537735e-14_wp * xx + 8.3232531e-13_wp) * xx + &
+ 1.0066362e-9_wp) * xx + 8.1048663e-8_wp) * xx + &
+ 3.2916354e-6_wp) * xx + 8.2711096e-5_wp) * xx + &
+ 1.3714667e-3_wp) * xx + 1.5017245e-2_wp) * xx + &
+ 4.3432642e-1_wp) * xx + 6.2337691e-1_wp
else
- hli = 0.5_wp*(((c3*t+c2)*t+c1)*t+c0)
- zq = z*z
- r = hli + sqrt(hli*hli+zq)
- if ( r<=rmin ) then
- ! approximation for high values of l.
- icode = 3
- t = -p(3,n-1)/me%step
- fl = 1.0_wp/(abs(((c3*t+c2)*t+c1)*t+c0)+1.0e-15_wp)
- return
- endif
- rq = r*r
- ff = sqrt(1.0_wp+3.0_wp*zq/rq)
- radik = b0 - ((d2*t+d1)*t+d0)*r*rq*ff
- if ( r>rmax ) then
- icode = 2
- radik = radik - 12.0_wp*(r-rmax)**2
- endif
- if ( radik+radik<=oradik ) exit main
- term = sqrt(radik)*ff*((e2*t+e1)*t+e0)/(rq+zq)
- fi = fi + stp*(oterm+term)
- oradik = radik
- oterm = term
- stp = r*me%steq
- z = z + stp
- endif
- enddo inner
- enddo main
- if ( iequ<2 ) iequ = 2
- me%sp(1) = p(1,iequ-1)
- me%sp(2) = p(2,iequ-1)
- me%sp(3) = p(3,iequ-1)
- if ( oradik>=1.0e-15_wp ) fi = fi + stp/0.75_wp*oterm*oradik/(oradik-radik)
-
- ! the minimal allowable value of fi was changed from 1e-15 to 1e-12,
- ! because 1e-38 is the minimal allowable arg. for alog in our envir.
- ! d. bilitza, nov 87.
- fi = 0.5_wp*abs(fi)/sqrt(b0) + 1.0e-12_wp
-
- ! compute l from b and i. same as carmel in invar.
- ! correct dipole moment is used here. d. bilitza, nov 87.
- dimob0 = dimo/b0
- arg1 = log(fi)
- arg2 = log(dimob0)
- ! arg = fi*fi*fi/dimob0
- ! if(abs(arg)>88.0_wp) arg=88.0_wp
- xx = 3*arg1 - arg2
- if ( xx>23.0_wp ) then
- gg = xx - 3.0460681_wp
- elseif ( xx>11.7_wp ) then
- gg = (((((2.8212095e-8_wp*xx-3.8049276e-6_wp)*xx+&
- 2.170224e-4_wp)*xx-6.7310339e-3_wp)*xx+&
- 1.2038224e-1_wp)*xx-1.8461796e-1_wp)*xx + 2.0007187_wp
- elseif ( xx>+3.0_wp ) then
- gg = ((((((((6.3271665e-10_wp*xx-3.958306e-8_wp)*xx+&
- 9.9766148e-07_wp)*xx-1.2531932e-5_wp)*xx+&
- 7.9451313e-5_wp)*xx-3.2077032e-4_wp)*xx+&
- 2.1680398e-3_wp)*xx+1.2817956e-2_wp)*xx+&
- 4.3510529e-1_wp)*xx + 6.222355e-1_wp
- elseif ( xx>-3.0_wp ) then
- gg = ((((((((2.6047023e-10_wp*xx+2.3028767e-9_wp)*xx-&
- 2.1997983e-8_wp)*xx-5.3977642e-7_wp)*xx-&
- 3.3408822e-6_wp)*xx+3.8379917e-5_wp)*xx+&
- 1.1784234e-3_wp)*xx+1.4492441e-2_wp)*xx+&
- 4.3352788e-1_wp)*xx + 6.228644e-1_wp
- elseif ( xx>-22.0_wp ) then
- gg = ((((((((-8.1537735e-14_wp*xx+8.3232531e-13_wp)*xx+&
- 1.0066362e-9_wp)*xx+8.1048663e-8_wp)*xx+&
- 3.2916354e-6_wp)*xx+8.2711096e-5_wp)*xx+&
- 1.3714667e-3_wp)*xx+1.5017245e-2_wp)*xx+&
- 4.3432642e-1_wp)*xx + 6.2337691e-1_wp
- else
- gg = 3.33338e-1_wp*xx + 3.0062102e-1_wp
- endif
- fl = exp(log((1.0_wp+exp(gg))*dimob0)/3.0_wp)
-
- end associate
-
-end subroutine shellg
+ gg = 3.33338e-1_wp * xx + 3.0062102e-1_wp
+ end if
+ fl = exp(log((1.0_wp + exp(gg)) * dimob0) / 3.0_wp)
+
+ end associate
+
+ end subroutine shellg
!*****************************************************************************************
!>
! subroutine used for field line tracing in [[shellg]].
! calls entry point [[feldi]] in geomagnetic field subroutine [[feldg]]
-subroutine stoer(me,p,bq,r)
-
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(7),intent(inout) :: p
- real(wp),intent(out) :: bq
- real(wp),intent(out) :: r
-
- real(wp) :: dr , dsq , dx , dxm , dy , dym , dz , &
- dzm , fli , q , rq , wr , xm , ym , zm
-
- ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates
- zm = P(3)
- fli = P(1)*P(1) + P(2)*P(2) + 1.0e-15_wp
- R = 0.5_wp*(fli+sqrt(fli*fli+(zm+zm)**2))
- rq = R*R
- wr = sqrt(R)
- xm = P(1)*wr
- ym = P(2)*wr
- ! transform to geographic co-ordinate system
- me%Xi(1) = xm*u(1,1) + ym*u(1,2) + zm*u(1,3)
- me%Xi(2) = xm*u(2,1) + ym*u(2,2) + zm*u(2,3)
- me%Xi(3) = xm*u(3,1) + zm*u(3,3)
- ! compute derivatives
- ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results
- ! are the same; dkb Feb 1998.
- ! JW : feb 2024 : xi, h now class variables.
- call me%feldi()
- q = me%H(1)/rq
- dx = me%H(3) + me%H(3) + q*me%Xi(1)
- dy = me%H(4) + me%H(4) + q*me%Xi(2)
- dz = me%H(2) + me%H(2) + q*me%Xi(3)
- ! transform back to geomagnetic co-ordinate system
- dxm = u(1,1)*dx + u(2,1)*dy + u(3,1)*dz
- dym = u(1,2)*dx + u(2,2)*dy
- dzm = u(1,3)*dx + u(2,3)*dy + u(3,3)*dz
- dr = (xm*dxm+ym*dym+zm*dzm)/R
- ! form slowly varying expressions
- P(4) = (wr*dxm-0.5_wp*P(1)*dr)/(R*dzm)
- P(5) = (wr*dym-0.5_wp*P(2)*dr)/(R*dzm)
- dsq = rq*(dxm*dxm+dym*dym+dzm*dzm)
- Bq = dsq*rq*rq
- P(6) = sqrt(dsq/(rq+3.0_wp*zm*zm))
- P(7) = P(6)*(rq+zm*zm)/(rq*dzm)
-
-end subroutine stoer
+ subroutine stoer(me, p, bq, r)
+
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(7), intent(inout) :: p
+ real(wp), intent(out) :: bq
+ real(wp), intent(out) :: r
+
+ real(wp) :: dr, dsq, dx, dxm, dy, dym, dz, &
+ dzm, fli, q, rq, wr, xm, ym, zm
+
+ ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates
+ zm = P(3)
+ fli = P(1) * P(1) + P(2) * P(2) + 1.0e-15_wp
+ R = 0.5_wp * (fli + sqrt(fli * fli + (zm + zm)**2))
+ rq = R * R
+ wr = sqrt(R)
+ xm = P(1) * wr
+ ym = P(2) * wr
+ ! transform to geographic co-ordinate system
+ me%Xi(1) = xm * u(1, 1) + ym * u(1, 2) + zm * u(1, 3)
+ me%Xi(2) = xm * u(2, 1) + ym * u(2, 2) + zm * u(2, 3)
+ me%Xi(3) = xm * u(3, 1) + zm * u(3, 3)
+ ! compute derivatives
+ ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results
+ ! are the same; dkb Feb 1998.
+ ! JW : feb 2024 : xi, h now class variables.
+ call me%feldi()
+ q = me%H(1) / rq
+ dx = me%H(3) + me%H(3) + q * me%Xi(1)
+ dy = me%H(4) + me%H(4) + q * me%Xi(2)
+ dz = me%H(2) + me%H(2) + q * me%Xi(3)
+ ! transform back to geomagnetic co-ordinate system
+ dxm = u(1, 1) * dx + u(2, 1) * dy + u(3, 1) * dz
+ dym = u(1, 2) * dx + u(2, 2) * dy
+ dzm = u(1, 3) * dx + u(2, 3) * dy + u(3, 3) * dz
+ dr = (xm * dxm + ym * dym + zm * dzm) / R
+ ! form slowly varying expressions
+ P(4) = (wr * dxm - 0.5_wp * P(1) * dr) / (R * dzm)
+ P(5) = (wr * dym - 0.5_wp * P(2) * dr) / (R * dzm)
+ dsq = rq * (dxm * dxm + dym * dym + dzm * dzm)
+ Bq = dsq * rq * rq
+ P(6) = sqrt(dsq / (rq + 3.0_wp * zm * zm))
+ P(7) = P(6) * (rq + zm * zm) / (rq * dzm)
+
+ end subroutine stoer
!*****************************************************************************************
!>
@@ -636,200 +636,200 @@ end subroutine stoer
!@note In the original code, [[feldc] and [[feldi]] were
! ENTRY points to this routine
- subroutine feldg(me,glat,glon,alt,bnorth,beast,bdown,babs)
+ subroutine feldg(me, glat, glon, alt, bnorth, beast, bdown, babs)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: glat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: glon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: alt !! altitude in km above sea level
- real(wp),intent(out) :: bnorth, beast, bdown !! components of the field with respect
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: glat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: glon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: alt !! altitude in km above sea level
+ real(wp), intent(out) :: bnorth, beast, bdown !! components of the field with respect
!! to the local geodetic coordinate system, with axis
!! pointing in the tangential plane to the north, east
!! and downward.
- real(wp),intent(out) :: Babs !! magnetic field strength in gauss
-
- real(wp) :: brho , bxxx , byyy , bzzz , cp , ct , d , f , rho , &
- rlat , rlon , rq , s , sp , st , t , &
- x , xxx , y , yyy , z , zzz
- integer :: i , ih , ihmax , il , imax , k , last , m
-
- ! same calculation as geo_to_cart, but not used here
- ! because the intermediate variables are also used below.
- rlat = glat*umr
- ct = sin(rlat)
- st = cos(rlat)
- d = sqrt(aquad-(aquad-bquad)*ct*ct)
- rlon = glon*umr
- cp = cos(rlon)
- sp = sin(rlon)
- zzz = (alt+bquad/d)*ct/era
- rho = (alt+aquad/d)*st/era
- xxx = rho*cp
- yyy = rho*sp
-
- rq = 1.0_wp/(xxx*xxx+yyy*yyy+zzz*zzz)
- me%xi = [xxx,yyy,zzz] * rq
-
- ihmax=me%nmax*me%nmax+1
- last=ihmax+me%nmax+me%nmax
- imax=me%nmax+me%nmax-1
- do i=ihmax,last
- me%h(i)=me%g(i)
- end do
- do k=1,3,2
- i=imax
- ih=ihmax
- do
- il=ih-i
- f=2.0_wp/real(i-k+2, wp)
- x=me%xi(1)*f
- y=me%xi(2)*f
- z=me%xi(3)*(f+f)
- i=i-2
- if ((i-1)>=0) then
- if ((i-1)>0) then
- do m=3,i,2
- me%h(il+m+1)=me%g(il+m+1)+z*me%h(ih+m+1)+x*(me%h(ih+m+3)-&
- me%h(ih+m-1))-y*(me%h(ih+m+2)+me%h(ih+m-2))
- me%h(il+m)=me%g(il+m)+z*me%h(ih+m)+x*(me%h(ih+m+2)-&
- me%h(ih+m-2))+y*(me%h(ih+m+3)+me%h(ih+m-1))
- end do
- end if
- me%h(il+2)=me%g(il+2)+z*me%h(ih+2)+x*me%h(ih+4)-y*(me%h(ih+3)+me%h(ih))
- me%h(il+1)=me%g(il+1)+z*me%h(ih+1)+y*me%h(ih+4)+x*(me%h(ih+3)-me%h(ih))
- end if
- me%h(il)=me%g(il)+z*me%h(ih)+2.0_wp*(x*me%h(ih+1)+y*me%h(ih+2))
- ih=il
- if (i= 0) then
+ if ((i - 1) > 0) then
+ do m = 3, i, 2
+ me%h(il + m + 1) = me%g(il + m + 1) + z * me%h(ih + m + 1) + x * (me%h(ih + m + 3) - &
+ me%h(ih + m - 1)) - y * (me%h(ih + m + 2) + me%h(ih + m - 2))
+ me%h(il + m) = me%g(il + m) + z * me%h(ih + m) + x * (me%h(ih + m + 2) - &
+ me%h(ih + m - 2)) + y * (me%h(ih + m + 3) + me%h(ih + m - 1))
+ end do
+ end if
+ me%h(il + 2) = me%g(il + 2) + z * me%h(ih + 2) + x * me%h(ih + 4) - y * (me%h(ih + 3) + me%h(ih))
+ me%h(il + 1) = me%g(il + 1) + z * me%h(ih + 1) + y * me%h(ih + 4) + x * (me%h(ih + 3) - me%h(ih))
+ end if
+ me%h(il) = me%g(il) + z * me%h(ih) + 2.0_wp * (x * me%h(ih + 1) + y * me%h(ih + 2))
+ ih = il
+ if (i < k) exit
+ end do
+ end do
+
+ s = 0.5_wp * me%h(1) + 2.0_wp * (me%h(2) * me%xi(3) + me%h(3) * me%xi(1) + me%h(4) * me%xi(2))
+ t = (rq + rq) * sqrt(rq)
+ bxxx = t * (me%h(3) - s * xxx)
+ byyy = t * (me%h(4) - s * yyy)
+ bzzz = t * (me%h(2) - s * zzz)
+
+ babs = sqrt(bxxx * bxxx + byyy * byyy + bzzz * bzzz)
+ beast = byyy * cp - bxxx * sp
+ brho = byyy * sp + bxxx * cp
+ bnorth = bzzz * st - brho * ct
+ bdown = -bzzz * ct - brho * st
+
+ end subroutine feldg
!*****************************************************************************************
!>
! Alternate version of [[feldg]] to be used with cartesian coordinates
- subroutine feldc(me,v,b)
+ subroutine feldc(me, v, b)
- class(shellig_type),intent(inout) :: me
- real(wp),dimension(3),intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
+ class(shellig_type), intent(inout) :: me
+ real(wp), dimension(3), intent(in) :: v !! cartesian coordinates in earth radii (6371.2 km)
!! x-axis pointing to equator at 0 longitude
!! y-axis pointing to equator at 90 long.
!! z-axis pointing to north pole
- real(wp),intent(out) :: b(3) !! field components
-
- real(wp) :: f , rq , s , t , x , xxx , y , yyy , z , zzz
- integer :: i , ih , ihmax , il , imax , k , last , m
-
- xxx=v(1)
- yyy=v(2)
- zzz=v(3)
-
- rq=1.0_wp/(xxx*xxx+yyy*yyy+zzz*zzz)
- me%xi = [xxx,yyy,zzz] * rq
-
- ihmax=me%nmax*me%nmax+1
- last=ihmax+me%nmax+me%nmax
- imax=me%nmax+me%nmax-1
- do i=ihmax,last
- me%h(i)=me%g(i)
- end do
- do k=1,3,2
- i=imax
- ih=ihmax
- do
- il=ih-i
- f=2.0_wp/real(i-k+2, wp)
- x=me%xi(1)*f
- y=me%xi(2)*f
- z=me%xi(3)*(f+f)
- i=i-2
- if ((i-1)>=0) then
- if ((i-1)>0) then
- do m=3,i,2
- me%h(il+m+1)=me%g(il+m+1)+z*me%h(ih+m+1)+x*(me%h(ih+m+3)-&
- me%h(ih+m-1))-y*(me%h(ih+m+2)+me%h(ih+m-2))
- me%h(il+m)=me%g(il+m)+z*me%h(ih+m)+x*(me%h(ih+m+2)-&
- me%h(ih+m-2))+y*(me%h(ih+m+3)+me%h(ih+m-1))
- end do
- end if
- me%h(il+2)=me%g(il+2)+z*me%h(ih+2)+x*me%h(ih+4)-y*(me%h(ih+3)+me%h(ih))
- me%h(il+1)=me%g(il+1)+z*me%h(ih+1)+y*me%h(ih+4)+x*(me%h(ih+3)-me%h(ih))
- end if
- me%h(il)=me%g(il)+z*me%h(ih)+2.0_wp*(x*me%h(ih+1)+y*me%h(ih+2))
- ih=il
- if (i= 0) then
+ if ((i - 1) > 0) then
+ do m = 3, i, 2
+ me%h(il + m + 1) = me%g(il + m + 1) + z * me%h(ih + m + 1) + x * (me%h(ih + m + 3) - &
+ me%h(ih + m - 1)) - y * (me%h(ih + m + 2) + me%h(ih + m - 2))
+ me%h(il + m) = me%g(il + m) + z * me%h(ih + m) + x * (me%h(ih + m + 2) - &
+ me%h(ih + m - 2)) + y * (me%h(ih + m + 3) + me%h(ih + m - 1))
+ end do
+ end if
+ me%h(il + 2) = me%g(il + 2) + z * me%h(ih + 2) + x * me%h(ih + 4) - y * (me%h(ih + 3) + me%h(ih))
+ me%h(il + 1) = me%g(il + 1) + z * me%h(ih + 1) + y * me%h(ih + 4) + x * (me%h(ih + 3) - me%h(ih))
+ end if
+ me%h(il) = me%g(il) + z * me%h(ih) + 2.0_wp * (x * me%h(ih + 1) + y * me%h(ih + 2))
+ ih = il
+ if (i < k) exit
+ end do
+ end do
- s=0.5_wp*me%h(1)+2.0_wp*(me%h(2)*me%xi(3)+me%h(3)*me%xi(1)+me%h(4)*me%xi(2))
- t=(rq+rq)*sqrt(rq)
+ s = 0.5_wp * me%h(1) + 2.0_wp * (me%h(2) * me%xi(3) + me%h(3) * me%xi(1) + me%h(4) * me%xi(2))
+ t = (rq + rq) * sqrt(rq)
- b(1)=t*(me%h(3)-s*xxx)
- b(2)=t*(me%h(4)-s*yyy)
- b(3)=t*(me%h(2)-s*zzz)
+ b(1) = t * (me%h(3) - s * xxx)
+ b(2) = t * (me%h(4) - s * yyy)
+ b(3) = t * (me%h(2) - s * zzz)
- end subroutine feldc
+ end subroutine feldc
!*****************************************************************************************
!>
! Used for `l` computation.
- subroutine feldi(me)
-
- class(shellig_type),intent(inout) :: me
-
- real(wp) :: f , x , y , z
- integer :: i , ih , ihmax , il , imax , k , last , m
-
- ihmax=me%nmax*me%nmax+1
- last=ihmax+me%nmax+me%nmax
- imax=me%nmax+me%nmax-1
- do i=ihmax,last
- me%h(i)=me%g(i)
- end do
- do k=1,3,2
- i=imax
- ih=ihmax
- do
- il=ih-i
- f=2.0_wp/real(i-k+2, wp)
- x=me%xi(1)*f
- y=me%xi(2)*f
- z=me%xi(3)*(f+f)
- i=i-2
- if ((i-1)>=0) then
- if ((i-1)>0) then
- do m=3,i,2
- me%h(il+m+1)=me%g(il+m+1)+z*me%h(ih+m+1)+x*(me%h(ih+m+3)-&
- me%h(ih+m-1))-y*(me%h(ih+m+2)+me%h(ih+m-2))
- me%h(il+m)=me%g(il+m)+z*me%h(ih+m)+x*(me%h(ih+m+2)-&
- me%h(ih+m-2))+y*(me%h(ih+m+3)+me%h(ih+m-1))
- end do
- end if
- me%h(il+2)=me%g(il+2)+z*me%h(ih+2)+x*me%h(ih+4)-y*(me%h(ih+3)+me%h(ih))
- me%h(il+1)=me%g(il+1)+z*me%h(ih+1)+y*me%h(ih+4)+x*(me%h(ih+3)-me%h(ih))
- end if
- me%h(il)=me%g(il)+z*me%h(ih)+2.0_wp*(x*me%h(ih+1)+y*me%h(ih+2))
- ih=il
- if (i= 0) then
+ if ((i - 1) > 0) then
+ do m = 3, i, 2
+ me%h(il + m + 1) = me%g(il + m + 1) + z * me%h(ih + m + 1) + x * (me%h(ih + m + 3) - &
+ me%h(ih + m - 1)) - y * (me%h(ih + m + 2) + me%h(ih + m - 2))
+ me%h(il + m) = me%g(il + m) + z * me%h(ih + m) + x * (me%h(ih + m + 2) - &
+ me%h(ih + m - 2)) + y * (me%h(ih + m + 3) + me%h(ih + m - 1))
+ end do
+ end if
+ me%h(il + 2) = me%g(il + 2) + z * me%h(ih + 2) + x * me%h(ih + 4) - y * (me%h(ih + 3) + me%h(ih))
+ me%h(il + 1) = me%g(il + 1) + z * me%h(ih + 1) + y * me%h(ih + 4) + x * (me%h(ih + 3) - me%h(ih))
+ end if
+ me%h(il) = me%g(il) + z * me%h(ih) + 2.0_wp * (x * me%h(ih + 1) + y * me%h(ih + 2))
+ ih = il
+ if (i < k) exit
+ end do
+ end do
- end subroutine feldi
+ end subroutine feldi
!*****************************************************************************************
!>
@@ -844,100 +844,100 @@ end subroutine feldi
! * updated to IGRF-2000 version -dkb- 5/31/2000
! * updated to IGRF-2005 version -dkb- 3/24/2000
- subroutine feldcof(me,year,dimo)
+ subroutine feldcof(me, year, dimo)
- class(shellig_type),intent(inout) :: me
- real(wp),intent(in) :: year !! decimal year for which geomagnetic field is to
+ class(shellig_type), intent(inout) :: me
+ real(wp), intent(in) :: year !! decimal year for which geomagnetic field is to
!! be calculated (e.g.:1995.5 for day 185 of 1995)
- real(wp),intent(out) :: dimo !! geomagnetic dipol moment in gauss (normalized
+ real(wp), intent(out) :: dimo !! geomagnetic dipol moment in gauss (normalized
!! to earth's radius) at the time (year)
- real(wp) :: dte1 , dte2 , erad , gha(144) , sqrt2
- integer :: i , ier , j , l , m , n , iyea
- character(len=:),allocatable :: fil2
- real(wp) :: x , f0 , f !! these were double precision in original
+ real(wp) :: dte1, dte2, erad, gha(144), sqrt2
+ integer :: i, ier, j, l, m, n, iyea
+ character(len=:), allocatable :: fil2
+ real(wp) :: x, f0, f !! these were double precision in original
!! code while everything else was single precision
- ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1
- character(len=filename_len),dimension(17),parameter :: filmod = [&
- 'dgrf1945.dat ' , 'dgrf1950.dat ' , 'dgrf1955.dat ' , 'dgrf1960.dat ' , &
- 'dgrf1965.dat ' , 'dgrf1970.dat ' , 'dgrf1975.dat ' , 'dgrf1980.dat ' , &
- 'dgrf1985.dat ' , 'dgrf1990.dat ' , 'dgrf1995.dat ' , 'dgrf2000.dat ' , &
- 'dgrf2005.dat ' , 'dgrf2010.dat ' , 'dgrf2015.dat ' , 'igrf2020.dat ' , &
- 'igrf2020s.dat']
- real(wp),dimension(17),parameter :: dtemod = [1945.0_wp , 1950.0_wp , 1955.0_wp , &
- 1960.0_wp , 1965.0_wp , 1970.0_wp , &
- 1975.0_wp , 1980.0_wp , 1985.0_wp , &
- 1990.0_wp , 1995.0_wp , 2000.0_wp , &
- 2005.0_wp , 2010.0_wp , 2015.0_wp , &
- 2020.0_wp , 2025.0_wp]
- integer,parameter :: numye = size(dtemod)-1 ! number of 5-year priods represented by IGRF
- integer,parameter :: is = 0 !! * is=0 for schmidt normalization
+ ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1
+ character(len=filename_len), dimension(17), parameter :: filmod = [ &
+ 'dgrf1945.dat ', 'dgrf1950.dat ', 'dgrf1955.dat ', 'dgrf1960.dat ', &
+ 'dgrf1965.dat ', 'dgrf1970.dat ', 'dgrf1975.dat ', 'dgrf1980.dat ', &
+ 'dgrf1985.dat ', 'dgrf1990.dat ', 'dgrf1995.dat ', 'dgrf2000.dat ', &
+ 'dgrf2005.dat ', 'dgrf2010.dat ', 'dgrf2015.dat ', 'igrf2020.dat ', &
+ 'igrf2020s.dat']
+ real(wp), dimension(17), parameter :: dtemod = [1945.0_wp, 1950.0_wp, 1955.0_wp, &
+ 1960.0_wp, 1965.0_wp, 1970.0_wp, &
+ 1975.0_wp, 1980.0_wp, 1985.0_wp, &
+ 1990.0_wp, 1995.0_wp, 2000.0_wp, &
+ 2005.0_wp, 2010.0_wp, 2015.0_wp, &
+ 2020.0_wp, 2025.0_wp]
+ integer, parameter :: numye = size(dtemod) - 1 ! number of 5-year priods represented by IGRF
+ integer, parameter :: is = 0 !! * is=0 for schmidt normalization
!! * is=1 gauss normalization
- logical :: read_file
-
- !-- determine igrf-years for input-year
- me%time = year
- iyea = int(year/5.0_wp)*5
- read_file = iyea /= me%iyea ! if we have to read the file
- me%iyea = iyea
- l = (me%iyea-1945)/5 + 1
- if ( l<1 ) l = 1
- if ( l>numye ) l = numye
- dte1 = dtemod(l)
- me%name = me%get_data_file_dir() // trim(filmod(l))
- dte2 = dtemod(l+1)
- fil2 = me%get_data_file_dir() // trim(filmod(l+1))
- if (read_file) then
- ! get igrf coefficients for the boundary years
- ! [if they have not ready been loaded]
- call getshc(me%name,me%nmax1,erad,me%g,ier)
- if ( ier/=0 ) error stop 'error reading file: '//trim(me%name)
- me%g_cache = me%g ! because it is modified below, we have to cache the original values from the file
- call getshc(fil2,me%nmax2,erad,me%gh2,ier)
- if ( ier/=0 ) error stop 'error reading file: '//trim(fil2)
- else
- me%g = me%g_cache
- end if
- !-- determine igrf coefficients for year
- if ( l<=numye-1 ) then
- call intershc(year,dte1,me%nmax1,me%g,dte2,me%nmax2,me%gh2,me%nmax,gha)
- else
- call extrashc(year,dte1,me%nmax1,me%g,me%nmax2,me%gh2,me%nmax,gha)
- endif
- !-- determine magnetic dipol moment and coeffiecients g
- f0 = 0.0_wp
- do j = 1 , 3
- f = gha(j)*1.0e-5_wp
- f0 = f0 + f*f
- enddo
- dimo = sqrt(f0)
-
- me%g(1) = 0.0_wp
- i = 2
- f0 = 1.0e-5_wp
- if ( is==0 ) f0 = -f0
- sqrt2 = sqrt(2.0_wp)
-
- do n = 1 , me%nmax
- x = n
- f0 = f0*x*x/(4.0_wp*x-2.0_wp)
- if ( is==0 ) f0 = f0*(2.0_wp*x-1.0_wp)/x
- f = f0*0.5_wp
- if ( is==0 ) f = f*sqrt2
- me%g(i) = gha(i-1)*f0
- i = i + 1
- do m = 1 , n
- f = f*(x+m)/(x-m+1.0_wp)
- if ( is==0 ) f = f*sqrt((x-m+1.0_wp)/(x+m))
- me%g(i) = gha(i-1)*f
- me%g(i+1) = gha(i)*f
- i = i + 2
- enddo
- enddo
-
-end subroutine feldcof
+ logical :: read_file
+
+ !-- determine igrf-years for input-year
+ me%time = year
+ iyea = int(year / 5.0_wp) * 5
+ read_file = iyea /= me%iyea ! if we have to read the file
+ me%iyea = iyea
+ l = (me%iyea - 1945) / 5 + 1
+ if (l < 1) l = 1
+ if (l > numye) l = numye
+ dte1 = dtemod(l)
+ me%name = me%get_data_file_dir()//trim(filmod(l))
+ dte2 = dtemod(l + 1)
+ fil2 = me%get_data_file_dir()//trim(filmod(l + 1))
+ if (read_file) then
+ ! get igrf coefficients for the boundary years
+ ! [if they have not ready been loaded]
+ call getshc(me%name, me%nmax1, erad, me%g, ier)
+ if (ier /= 0) error stop 'error reading file: '//trim(me%name)
+ me%g_cache = me%g ! because it is modified below, we have to cache the original values from the file
+ call getshc(fil2, me%nmax2, erad, me%gh2, ier)
+ if (ier /= 0) error stop 'error reading file: '//trim(fil2)
+ else
+ me%g = me%g_cache
+ end if
+ !-- determine igrf coefficients for year
+ if (l <= numye - 1) then
+ call intershc(year, dte1, me%nmax1, me%g, dte2, me%nmax2, me%gh2, me%nmax, gha)
+ else
+ call extrashc(year, dte1, me%nmax1, me%g, me%nmax2, me%gh2, me%nmax, gha)
+ end if
+ !-- determine magnetic dipol moment and coeffiecients g
+ f0 = 0.0_wp
+ do j = 1, 3
+ f = gha(j) * 1.0e-5_wp
+ f0 = f0 + f * f
+ end do
+ dimo = sqrt(f0)
+
+ me%g(1) = 0.0_wp
+ i = 2
+ f0 = 1.0e-5_wp
+ if (is == 0) f0 = -f0
+ sqrt2 = sqrt(2.0_wp)
+
+ do n = 1, me%nmax
+ x = n
+ f0 = f0 * x * x / (4.0_wp * x - 2.0_wp)
+ if (is == 0) f0 = f0 * (2.0_wp * x - 1.0_wp) / x
+ f = f0 * 0.5_wp
+ if (is == 0) f = f * sqrt2
+ me%g(i) = gha(i - 1) * f0
+ i = i + 1
+ do m = 1, n
+ f = f * (x + m) / (x - m + 1.0_wp)
+ if (is == 0) f = f * sqrt((x - m + 1.0_wp) / (x + m))
+ me%g(i) = gha(i - 1) * f
+ me%g(i + 1) = gha(i) * f
+ i = i + 2
+ end do
+ end do
+
+ end subroutine feldcof
!*****************************************************************************************
!>
@@ -948,82 +948,82 @@ end subroutine feldcof
! * Version 1.01, A. Zunde, USGS, MS 964,
! Box 25046 Federal Center, Denver, CO 80225
-subroutine getshc(Fspec,Nmax,Erad,Gh,Ier)
+ subroutine getshc(Fspec, Nmax, Erad, Gh, Ier)
- character(len=*),intent(in) :: Fspec !! File specification
- integer,intent(out) :: Nmax !! Maximum degree and order of model
- real(wp),intent(out) :: Erad !! Earth's radius associated with the spherical
+ character(len=*), intent(in) :: Fspec !! File specification
+ integer, intent(out) :: Nmax !! Maximum degree and order of model
+ real(wp), intent(out) :: Erad !! Earth's radius associated with the spherical
!! harmonic coefficients, in the same units as
!! elevation
- real(wp),dimension(*),intent(out) :: Gh !! Schmidt quasi-normal internal spherical
+ real(wp), dimension(*), intent(out) :: Gh !! Schmidt quasi-normal internal spherical
!! harmonic coefficients
- integer,intent(out) :: Ier !! Error number:
+ integer, intent(out) :: Ier !! Error number:
!!
!! * 0, no error
!! * -2, records out of order
!! * FORTRAN run-time error number
- integer :: iu !! logical unit number
- real(wp) :: g , h
- integer :: i , m , mm , n , nn
-
- read_file : block
- ! ---------------------------------------------------------------
- ! Open coefficient file. Read past first header record.
- ! Read degree and order of model and Earth's radius.
- ! ---------------------------------------------------------------
- OPEN (newunit=Iu,FILE=Fspec,STATUS='OLD',IOSTAT=Ier)
- if (Ier/=0) then
- write(*,*) 'Error opening file: '//trim(fspec)
- exit read_file
- end if
- READ (Iu,*,IOSTAT=Ier)
- if (Ier/=0) exit read_file
- READ (Iu,*,IOSTAT=Ier) Nmax , Erad
- if (Ier/=0) exit read_file
-
- ! ---------------------------------------------------------------
- ! Read the coefficient file, arranged as follows:
- !
- ! N M G H
- ! ----------------------
- ! / 1 0 GH(1) -
- ! / 1 1 GH(2) GH(3)
- ! / 2 0 GH(4) -
- ! / 2 1 GH(5) GH(6)
- ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8)
- ! records \ 3 0 GH(9) -
- ! \ . . . .
- ! \ . . . .
- ! NMAX*(NMAX+2) \ . . . .
- ! elements in GH \ NMAX NMAX . .
- !
- ! N and M are, respectively, the degree and order of the
- ! coefficient.
- ! ---------------------------------------------------------------
- i = 0
- main: DO nn = 1 , Nmax
- DO mm = 0 , nn
- READ (Iu,*,IOSTAT=Ier) n , m , g , h
- if (Ier/=0) exit main
- IF ( nn/=n .OR. mm/=m ) THEN
- Ier = -2
- EXIT main
- ENDIF
- i = i + 1
- Gh(i) = g
- IF ( m/=0 ) THEN
- i = i + 1
- Gh(i) = h
- ENDIF
- ENDDO
- ENDDO main
+ integer :: iu !! logical unit number
+ real(wp) :: g, h
+ integer :: i, m, mm, n, nn
+
+ read_file: block
+ ! ---------------------------------------------------------------
+ ! Open coefficient file. Read past first header record.
+ ! Read degree and order of model and Earth's radius.
+ ! ---------------------------------------------------------------
+ open (newunit=Iu, FILE=Fspec, STATUS='OLD', IOSTAT=Ier)
+ if (Ier /= 0) then
+ write (*, *) 'Error opening file: '//trim(fspec)
+ exit read_file
+ end if
+ read (Iu, *, IOSTAT=Ier)
+ if (Ier /= 0) exit read_file
+ read (Iu, *, IOSTAT=Ier) Nmax, Erad
+ if (Ier /= 0) exit read_file
+
+ ! ---------------------------------------------------------------
+ ! Read the coefficient file, arranged as follows:
+ !
+ ! N M G H
+ ! ----------------------
+ ! / 1 0 GH(1) -
+ ! / 1 1 GH(2) GH(3)
+ ! / 2 0 GH(4) -
+ ! / 2 1 GH(5) GH(6)
+ ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8)
+ ! records \ 3 0 GH(9) -
+ ! \ . . . .
+ ! \ . . . .
+ ! NMAX*(NMAX+2) \ . . . .
+ ! elements in GH \ NMAX NMAX . .
+ !
+ ! N and M are, respectively, the degree and order of the
+ ! coefficient.
+ ! ---------------------------------------------------------------
+ i = 0
+ main: do nn = 1, Nmax
+ do mm = 0, nn
+ read (Iu, *, IOSTAT=Ier) n, m, g, h
+ if (Ier /= 0) exit main
+ if (nn /= n .or. mm /= m) then
+ Ier = -2
+ exit main
+ end if
+ i = i + 1
+ Gh(i) = g
+ if (m /= 0) then
+ i = i + 1
+ Gh(i) = h
+ end if
+ end do
+ end do main
- end block read_file
+ end block read_file
- CLOSE (Iu)
+ close (Iu)
-END subroutine getshc
+ end subroutine getshc
!*****************************************************************************************
!>
@@ -1041,47 +1041,47 @@ END subroutine getshc
! * Version 1.01, A. Zunde
! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225
-subroutine intershc(date,dte1,nmax1,gh1,dte2,nmax2,gh2,nmax,gh)
-
- real(wp),intent(in) :: date !! Date of resulting model (in decimal year)
- real(wp),intent(in) :: dte1 !! Date of earlier model
- integer,intent(in) :: nmax1 !! Maximum degree and order of earlier model
- real(wp),intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model
- real(wp),intent(in) :: dte2 !! Date of later model
- integer,intent(in) :: nmax2 !! Maximum degree and order of later model
- real(wp),intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model
- real(wp),intent(out) :: gh(*) !! Coefficients of resulting model
- integer,intent(out) :: nmax !! Maximum degree and order of resulting model
-
- real(wp) :: factor
- integer :: i , k , l
-
- factor = (date-dte1)/(dte2-dte1)
-
- if ( nmax1==nmax2 ) then
- k = nmax1*(nmax1+2)
- nmax = nmax1
- elseif ( nmax1>nmax2 ) then
- k = nmax2*(nmax2+2)
- l = nmax1*(nmax1+2)
- do i = k + 1 , l
- gh(i) = gh1(i) + factor*(-gh1(i))
- enddo
- nmax = nmax1
- else
- k = nmax1*(nmax1+2)
- l = nmax2*(nmax2+2)
- do i = k + 1 , l
- gh(i) = factor*gh2(i)
- enddo
- nmax = nmax2
- endif
-
- do i = 1 , k
- gh(i) = gh1(i) + factor*(gh2(i)-gh1(i))
- enddo
-
-end subroutine intershc
+ subroutine intershc(date, dte1, nmax1, gh1, dte2, nmax2, gh2, nmax, gh)
+
+ real(wp), intent(in) :: date !! Date of resulting model (in decimal year)
+ real(wp), intent(in) :: dte1 !! Date of earlier model
+ integer, intent(in) :: nmax1 !! Maximum degree and order of earlier model
+ real(wp), intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model
+ real(wp), intent(in) :: dte2 !! Date of later model
+ integer, intent(in) :: nmax2 !! Maximum degree and order of later model
+ real(wp), intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model
+ real(wp), intent(out) :: gh(*) !! Coefficients of resulting model
+ integer, intent(out) :: nmax !! Maximum degree and order of resulting model
+
+ real(wp) :: factor
+ integer :: i, k, l
+
+ factor = (date - dte1) / (dte2 - dte1)
+
+ if (nmax1 == nmax2) then
+ k = nmax1 * (nmax1 + 2)
+ nmax = nmax1
+ elseif (nmax1 > nmax2) then
+ k = nmax2 * (nmax2 + 2)
+ l = nmax1 * (nmax1 + 2)
+ do i = k + 1, l
+ gh(i) = gh1(i) + factor * (-gh1(i))
+ end do
+ nmax = nmax1
+ else
+ k = nmax1 * (nmax1 + 2)
+ l = nmax2 * (nmax2 + 2)
+ do i = k + 1, l
+ gh(i) = factor * gh2(i)
+ end do
+ nmax = nmax2
+ end if
+
+ do i = 1, k
+ gh(i) = gh1(i) + factor * (gh2(i) - gh1(i))
+ end do
+
+ end subroutine intershc
!*****************************************************************************************
!>
@@ -1099,77 +1099,77 @@ end subroutine intershc
! * Version 1.01, A. Zunde
! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225
-subroutine extrashc(date,dte1,nmax1,gh1,nmax2,gh2,nmax,gh)
-
- real(wp),intent(in) :: date !! Date of resulting model (in decimal year)
- real(wp),intent(in) :: dte1 !! Date of base model
- integer,intent(in) :: nmax1 !! Maximum degree and order of base model
- real(wp),intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model
- integer,intent(in) :: nmax2 !! Maximum degree and order of rate-of-change model
- real(wp),intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model
- real(wp),intent(out) :: gh(*) !! Coefficients of resulting model
- integer,intent(out) :: nmax !! Maximum degree and order of resulting model
-
- real(wp) :: factor
- integer :: i , k , l
-
- factor = (date-dte1)
-
- if ( nmax1==nmax2 ) then
- k = nmax1*(nmax1+2)
- nmax = nmax1
- elseif ( nmax1>nmax2 ) then
- k = nmax2*(nmax2+2)
- l = nmax1*(nmax1+2)
- do i = k + 1 , l
- gh(i) = gh1(i)
- enddo
- nmax = nmax1
- else
- k = nmax1*(nmax1+2)
- l = nmax2*(nmax2+2)
- do i = k + 1 , l
- gh(i) = factor*gh2(i)
- enddo
- nmax = nmax2
- endif
-
- do i = 1 , k
- gh(i) = gh1(i) + factor*gh2(i)
- enddo
-
-end subroutine extrashc
+ subroutine extrashc(date, dte1, nmax1, gh1, nmax2, gh2, nmax, gh)
+
+ real(wp), intent(in) :: date !! Date of resulting model (in decimal year)
+ real(wp), intent(in) :: dte1 !! Date of base model
+ integer, intent(in) :: nmax1 !! Maximum degree and order of base model
+ real(wp), intent(in) :: gh1(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model
+ integer, intent(in) :: nmax2 !! Maximum degree and order of rate-of-change model
+ real(wp), intent(in) :: gh2(*) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model
+ real(wp), intent(out) :: gh(*) !! Coefficients of resulting model
+ integer, intent(out) :: nmax !! Maximum degree and order of resulting model
+
+ real(wp) :: factor
+ integer :: i, k, l
+
+ factor = (date - dte1)
+
+ if (nmax1 == nmax2) then
+ k = nmax1 * (nmax1 + 2)
+ nmax = nmax1
+ elseif (nmax1 > nmax2) then
+ k = nmax2 * (nmax2 + 2)
+ l = nmax1 * (nmax1 + 2)
+ do i = k + 1, l
+ gh(i) = gh1(i)
+ end do
+ nmax = nmax1
+ else
+ k = nmax1 * (nmax1 + 2)
+ l = nmax2 * (nmax2 + 2)
+ do i = k + 1, l
+ gh(i) = factor * gh2(i)
+ end do
+ nmax = nmax2
+ end if
+
+ do i = 1, k
+ gh(i) = gh1(i) + factor * gh2(i)
+ end do
+
+ end subroutine extrashc
!*****************************************************************************************
!>
! geodetic to scaled cartesian coordinates
-pure function geo_to_cart(glat,glon,alt) result(x)
+ pure function geo_to_cart(glat, glon, alt) result(x)
- real(wp),intent(in) :: glat !! geodetic latitude in degrees (north)
- real(wp),intent(in) :: glon !! geodetic longitude in degrees (east)
- real(wp),intent(in) :: alt !! altitude in km above sea level
- real(wp),dimension(3) :: x !! cartesian coordinates in earth radii (6371.2 km)
+ real(wp), intent(in) :: glat !! geodetic latitude in degrees (north)
+ real(wp), intent(in) :: glon !! geodetic longitude in degrees (east)
+ real(wp), intent(in) :: alt !! altitude in km above sea level
+ real(wp), dimension(3) :: x !! cartesian coordinates in earth radii (6371.2 km)
!!
!! * x-axis pointing to equator at 0 longitude
!! * y-axis pointing to equator at 90 long.
!! * z-axis pointing to north pole
- real(wp) :: rlat !! latitude in radians
- real(wp) :: rlon !! longitude in radians
- real(wp) :: d, rho
+ real(wp) :: rlat !! latitude in radians
+ real(wp) :: rlon !! longitude in radians
+ real(wp) :: d, rho
- ! deg to radians:
- rlat = glat*umr
- rlon = glon*umr
+ ! deg to radians:
+ rlat = glat * umr
+ rlon = glon * umr
- ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code
- associate (ct => sin(rlat), st => cos(rlat), cp => cos(rlon), sp => sin(rlon))
- d = sqrt(aquad-(aquad-bquad)*ct*ct)
- rho = (alt+aquad/d)*st/era
- x = [rho*cp, rho*sp, (alt+bquad/d)*ct/era]
- end associate
+ ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code
+ associate (ct => sin(rlat), st => cos(rlat), cp => cos(rlon), sp => sin(rlon))
+ d = sqrt(aquad - (aquad - bquad) * ct * ct)
+ rho = (alt + aquad / d) * st / era
+ x = [rho * cp, rho * sp, (alt + bquad / d) * ct / era]
+ end associate
-end function geo_to_cart
+ end function geo_to_cart
-end module SHELLIG_module
\ No newline at end of file
+end module SHELLIG_module
diff --git a/src/trmfun.f90 b/src/trmfun.f90
index feacd6d..19dfac3 100644
--- a/src/trmfun.f90
+++ b/src/trmfun.f90
@@ -7,121 +7,121 @@
module trmfun_module
- use radbelt_kinds_module
+ use radbelt_kinds_module
- implicit none
+ implicit none
- private
+ private
- character(len=10),dimension(4),parameter :: mname = [ 'ae8min.asc' , &
- 'ae8max.asc' , &
- 'ap8min.asc' , &
- 'ap8max.asc'] !! data files available
+ character(len=10), dimension(4), parameter :: mname = ['ae8min.asc', &
+ 'ae8max.asc', &
+ 'ap8min.asc', &
+ 'ap8max.asc'] !! data files available
- type,public :: trm_type
+ type, public :: trm_type
!! main class for the `aep8` model
- private
+ private
- character(len=:),allocatable :: aep8_dir !! directory containing the data files
+ character(len=:), allocatable :: aep8_dir !! directory containing the data files
- ! data read from the files:
- character(len=:),allocatable :: file_loaded !! the file that has been loaded
- integer,dimension(8) :: ihead = 0
- integer,dimension(:),allocatable :: map
+ ! data read from the files:
+ character(len=:), allocatable :: file_loaded !! the file that has been loaded
+ integer, dimension(8) :: ihead = 0
+ integer, dimension(:), allocatable :: map
- real(wp) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux.
+ real(wp) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux.
!! formerly stored in common block `tra2`
- ! formerly saved variables in trara1:
- real(wp) :: f1 = 1.001_wp
- real(wp) :: f2 = 1.002_wp
+ ! formerly saved variables in trara1:
+ real(wp) :: f1 = 1.001_wp
+ real(wp) :: f2 = 1.002_wp
- contains
- private
- procedure,public :: aep8 !! main routine
- procedure,public :: trara1, trara2 !! low-level routine
- procedure,public :: set_data_file_dir, get_data_file_dir
- end type trm_type
+ contains
+ private
+ procedure, public :: aep8 !! main routine
+ procedure, public :: trara1, trara2 !! low-level routine
+ procedure, public :: set_data_file_dir, get_data_file_dir
+ end type trm_type
- contains
+contains
!*****************************************************************************************
!>
! Set the directory containing the data files.
- subroutine set_data_file_dir(me,dir)
- class(trm_type),intent(inout) :: me
- character(len=*),intent(in) :: dir
- me%aep8_dir = trim(dir)
- end subroutine set_data_file_dir
+ subroutine set_data_file_dir(me, dir)
+ class(trm_type), intent(inout) :: me
+ character(len=*), intent(in) :: dir
+ me%aep8_dir = trim(dir)
+ end subroutine set_data_file_dir
!*****************************************************************************************
!>
! Get the directory containing the data files.
- function get_data_file_dir(me) result(dir)
- class(trm_type),intent(in) :: me
- character(len=:),allocatable :: dir
- if (allocated(me%aep8_dir)) then
- dir = trim(me%aep8_dir) // '/'
- else
- dir = 'data/aep8/' ! default
- end if
- end function get_data_file_dir
+ function get_data_file_dir(me) result(dir)
+ class(trm_type), intent(in) :: me
+ character(len=:), allocatable :: dir
+ if (allocated(me%aep8_dir)) then
+ dir = trim(me%aep8_dir)//'/'
+ else
+ dir = 'data/aep8/' ! default
+ end if
+ end function get_data_file_dir
!*****************************************************************************************
!>
! Main wrapper for the radiation model.
! Reads the coefficient file and calls the low-level routine.
- subroutine aep8(me,e,l,bb0,imname,flux)
-
- class(trm_type),intent(inout) :: me
-
- real(wp),intent(in) :: e
- real(wp),intent(in) :: l
- real(wp),intent(in) :: bb0
- integer,intent(in) :: imname !! which model to load (index in `mname` array)
- real(wp),intent(out) :: flux
-
- real(wp) :: ee(1), f(1) !! temp variables
- integer :: i , ierr, iuaeap , nmap
- character(len=:),allocatable :: name
- logical :: load_file
-
- name = me%get_data_file_dir() // trim(mname(Imname)) ! the file to load
-
- ! JW : do we need to reset some or all of these ?
- me%fistep = 0.0_wp
- me%f1 = 1.001_wp
- me%f2 = 1.002_wp
-
- ! check to see if this file has already been loaded
- ! [the class can store one file at a time]
- load_file = .true.
- if (allocated(me%file_loaded)) then
- if (name == me%file_loaded) load_file = .false.
- end if
-
- if (load_file) then
- open (newunit = iuaeap,file=name,status='OLD',iostat=ierr,form='FORMATTED')
- if ( ierr/=0 ) then
- error stop 'error reading '//trim(name)
- end if
- read (iuaeap,'(1X,12I6)') me%ihead
- nmap = me%ihead(8)
- allocate(me%map(nmap))
- read (iuaeap,'(1X,12I6)') (me%map(i),i=1,nmap)
- close (iuaeap)
- me%file_loaded = trim(name)
- end if
-
- ee(1) = e
- call me%trara1(me%ihead,me%map,L,Bb0,ee,f,1)
- flux = f(1)
- IF ( Flux>0.0_wp ) Flux = 10.0_wp**Flux
-
- end subroutine aep8
+ subroutine aep8(me, e, l, bb0, imname, flux)
+
+ class(trm_type), intent(inout) :: me
+
+ real(wp), intent(in) :: e
+ real(wp), intent(in) :: l
+ real(wp), intent(in) :: bb0
+ integer, intent(in) :: imname !! which model to load (index in `mname` array)
+ real(wp), intent(out) :: flux
+
+ real(wp) :: ee(1), f(1) !! temp variables
+ integer :: i, ierr, iuaeap, nmap
+ character(len=:), allocatable :: name
+ logical :: load_file
+
+ name = me%get_data_file_dir()//trim(mname(Imname)) ! the file to load
+
+ ! JW : do we need to reset some or all of these ?
+ me%fistep = 0.0_wp
+ me%f1 = 1.001_wp
+ me%f2 = 1.002_wp
+
+ ! check to see if this file has already been loaded
+ ! [the class can store one file at a time]
+ load_file = .true.
+ if (allocated(me%file_loaded)) then
+ if (name == me%file_loaded) load_file = .false.
+ end if
+
+ if (load_file) then
+ open (newunit=iuaeap, file=name, status='OLD', iostat=ierr, form='FORMATTED')
+ if (ierr /= 0) then
+ error stop 'error reading '//trim(name)
+ end if
+ read (iuaeap, '(1X,12I6)') me%ihead
+ nmap = me%ihead(8)
+ allocate (me%map(nmap))
+ read (iuaeap, '(1X,12I6)') (me%map(i), i=1, nmap)
+ close (iuaeap)
+ me%file_loaded = trim(name)
+ end if
+
+ ee(1) = e
+ call me%trara1(me%ihead, me%map, L, Bb0, ee, f, 1)
+ flux = f(1)
+ if (Flux > 0.0_wp) Flux = 10.0_wp**Flux
+
+ end subroutine aep8
!*****************************************************************************************
!*****************************************************************************************
@@ -130,114 +130,114 @@ end subroutine aep8
! strength and l-value. function [[trara2]] is used to interpolate in
! b-l-space.
- subroutine trara1(me,descr,map,fl,bb0,e,f,n)
+ subroutine trara1(me, descr, map, fl, bb0, e, f, n)
- class(trm_type),intent(inout) :: me
- integer,intent(in) :: n !! number of energies
- integer,intent(in) :: descr(8) !! header of specified trapped radition model
- real(wp),intent(in) :: e(n) !! array of energies in mev
- real(wp),intent(in) :: fl !! l-value
- real(wp),intent(in) :: bb0 !! =b/b0 magnetic field strength normalized
+ class(trm_type), intent(inout) :: me
+ integer, intent(in) :: n !! number of energies
+ integer, intent(in) :: descr(8) !! header of specified trapped radition model
+ real(wp), intent(in) :: e(n) !! array of energies in mev
+ real(wp), intent(in) :: fl !! l-value
+ real(wp), intent(in) :: bb0 !! =b/b0 magnetic field strength normalized
!! to field strength at magnetic equator
- integer,intent(in) :: map(*) !! map of trapped radition model
+ integer, intent(in) :: map(*) !! map of trapped radition model
!! (descr and map are explained at the begin
!! of the main program model)
- real(wp),intent(out) :: f(n) !! decadic logarithm of integral fluxes in
+ real(wp), intent(out) :: f(n) !! decadic logarithm of integral fluxes in
!! particles/(cm*cm*sec)
- real(wp) :: e0 , e1 , e2 , escale , f0 , fscale , xnl
- real(wp) :: bb0_ !! local copy of `bb0`. in the original code
+ real(wp) :: e0, e1, e2, escale, f0, fscale, xnl
+ real(wp) :: bb0_ !! local copy of `bb0`. in the original code
!! this was modified by this routine.
!! added this so `bb0` could be `intent(in)`
- integer :: i0 , i1 , i2 , i3 , ie , l3 , nb , nl
- logical :: s0 , s1 , s2
-
- e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
- f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
- i0 = 0 ! to avoid -Wmaybe-uninitialized warnings
- s0 = .false. ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW
-
- bb0_ = bb0
- me%fistep = descr(7)/descr(2)
- escale = descr(4)
- fscale = descr(7)
- xnl = min(15.6_wp,abs(fl))
- nl = int(xnl*descr(5))
- if ( bb0_<1.0_wp ) bb0_ = 1.0_wp
- nb = int((bb0_-1.0_wp)*descr(6))
-
- ! i2 is the number of elements in the flux map for the first energy.
- ! i3 is the index of the last element of the second energy map.
- ! l3 is the length of the map for the third energy.
- ! e1 is the energy of the first energy map (unscaled)
- ! e2 is the energy of the second energy map (unscaled)
- i1 = 0
- i2 = map(1)
- i3 = i2 + map(i2+1)
- l3 = map(i3+1)
- e1 = map(i1+2)/escale
- e2 = map(i2+2)/escale
-
- ! s0, s1, s2 are logical variables which indicate whether the flux for
- ! a particular e, b, l point has already been found in a previous call
- ! to function trara2. if not, s.. =.true.
- s1 = .true.
- s2 = .true.
-
- ! energy loop
-
- do ie = 1 , n
-
- ! for each energy e(i) find the successive energies e0,e1,e2 in
- ! model map, which obey e0 < e1 < e(i) < e2 .
-
- do while ( (e(ie)>e2) .and. (l3/=0) )
- i0 = i1
- i1 = i2
- i2 = i3
- i3 = i3 + l3
- l3 = map(i3+1)
- e0 = e1
- e1 = e2
- e2 = map(i2+2)/escale
- s0 = s1
- s1 = s2
- s2 = .true.
- f0 = me%f1
- me%f1 = me%f2
- enddo
-
- ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0-
- ! space to find fluxes f1,f2 [if they have not already been
- ! calculated for a previous e(i)].
-
- if ( s1 ) me%f1 = me%trara2(map(i1+3),nl,nb)/fscale
- if ( s2 ) me%f2 = me%trara2(map(i2+3),nl,nb)/fscale
- s1 = .false.
- s2 = .false.
-
- ! finally, interpolate in energy.
-
- f(ie) = me%f1 + (me%f2-me%f1)*(e(ie)-e1)/(e2-e1)
- if ( me%f2<=0.0_wp ) then
- if ( i1/=0 ) then
- ! --------- special interpolation ---------------------------------
- ! if the flux for the second energy cannot be found (i.e. f2=0.0),
- ! and the zeroth energy map has been defined (i.e. i1 not equal 0),
- ! then interpolate using the flux maps for the zeroth and first
- ! energy and choose the minimum of this interpolations and the
- ! interpolation that was done with f2=0.
- if ( s0 ) f0 = me%trara2(map(i0+3),nl,nb)/fscale
- s0 = .false.
- f(ie) = min(f(ie),f0+(me%f1-f0)*(e(ie)-e0)/(e1-e0))
- endif
- endif
-
- ! the logarithmic flux is always kept greater or equal zero.
-
- f(ie) = max(f(ie),0.0_wp)
- enddo
-end subroutine trara1
+ integer :: i0, i1, i2, i3, ie, l3, nb, nl
+ logical :: s0, s1, s2
+
+ e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+ f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings
+ i0 = 0 ! to avoid -Wmaybe-uninitialized warnings
+ s0 = .false. ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW
+
+ bb0_ = bb0
+ me%fistep = descr(7) / descr(2)
+ escale = descr(4)
+ fscale = descr(7)
+ xnl = min(15.6_wp, abs(fl))
+ nl = int(xnl * descr(5))
+ if (bb0_ < 1.0_wp) bb0_ = 1.0_wp
+ nb = int((bb0_ - 1.0_wp) * descr(6))
+
+ ! i2 is the number of elements in the flux map for the first energy.
+ ! i3 is the index of the last element of the second energy map.
+ ! l3 is the length of the map for the third energy.
+ ! e1 is the energy of the first energy map (unscaled)
+ ! e2 is the energy of the second energy map (unscaled)
+ i1 = 0
+ i2 = map(1)
+ i3 = i2 + map(i2 + 1)
+ l3 = map(i3 + 1)
+ e1 = map(i1 + 2) / escale
+ e2 = map(i2 + 2) / escale
+
+ ! s0, s1, s2 are logical variables which indicate whether the flux for
+ ! a particular e, b, l point has already been found in a previous call
+ ! to function trara2. if not, s.. =.true.
+ s1 = .true.
+ s2 = .true.
+
+ ! energy loop
+
+ do ie = 1, n
+
+ ! for each energy e(i) find the successive energies e0,e1,e2 in
+ ! model map, which obey e0 < e1 < e(i) < e2 .
+
+ do while ((e(ie) > e2) .and. (l3 /= 0))
+ i0 = i1
+ i1 = i2
+ i2 = i3
+ i3 = i3 + l3
+ l3 = map(i3 + 1)
+ e0 = e1
+ e1 = e2
+ e2 = map(i2 + 2) / escale
+ s0 = s1
+ s1 = s2
+ s2 = .true.
+ f0 = me%f1
+ me%f1 = me%f2
+ end do
+
+ ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0-
+ ! space to find fluxes f1,f2 [if they have not already been
+ ! calculated for a previous e(i)].
+
+ if (s1) me%f1 = me%trara2(map(i1 + 3), nl, nb) / fscale
+ if (s2) me%f2 = me%trara2(map(i2 + 3), nl, nb) / fscale
+ s1 = .false.
+ s2 = .false.
+
+ ! finally, interpolate in energy.
+
+ f(ie) = me%f1 + (me%f2 - me%f1) * (e(ie) - e1) / (e2 - e1)
+ if (me%f2 <= 0.0_wp) then
+ if (i1 /= 0) then
+ ! --------- special interpolation ---------------------------------
+ ! if the flux for the second energy cannot be found (i.e. f2=0.0),
+ ! and the zeroth energy map has been defined (i.e. i1 not equal 0),
+ ! then interpolate using the flux maps for the zeroth and first
+ ! energy and choose the minimum of this interpolations and the
+ ! interpolation that was done with f2=0.
+ if (s0) f0 = me%trara2(map(i0 + 3), nl, nb) / fscale
+ s0 = .false.
+ f(ie) = min(f(ie), f0 + (me%f1 - f0) * (e(ie) - e0) / (e1 - e0))
+ end if
+ end if
+
+ ! the logarithmic flux is always kept greater or equal zero.
+
+ f(ie) = max(f(ie), 0.0_wp)
+ end do
+ end subroutine trara1
!*****************************************************************************************
!>
@@ -248,258 +248,258 @@ end subroutine trara1
! see main program 'model' for explanation of map format
! scaling factors.
-function trara2(me,map,il,ib)
+ function trara2(me, map, il, ib)
- class(trm_type),intent(inout) :: me
- integer,intent(in) :: map(*) !! is sub-map (for specific energy) of
+ class(trm_type), intent(inout) :: me
+ integer, intent(in) :: map(*) !! is sub-map (for specific energy) of
!! trapped radiation model map
- integer,intent(in) :: il !! scaled l-value
- integer,intent(in) :: ib !! scaled b/b0-1
- real(wp) :: trara2 !! scaled logarithm of particle flux
-
- real(wp) :: dfl , fincr1 , fincr2 , fistep , fkb , fkb1 , fkb2 , fkbj1 , fkbj2 , &
- fkbm , fll1 , fll2 , flog , flog1 , flog2 , flogm , &
- fnb , fnl , sl1 , sl2
- integer :: i1 , i2 , itime , j1 , j2 , kt , l1 , l2
- logical :: dummy
-
- fistep = me%fistep
-
- !********
- ! to avoid -Wmaybe-uninitialized warning
- dfl = 0.0_wp
- fincr1 = 0.0_wp
- fincr2 = 0.0_wp
- fkb = 0.0_wp
- fkb1 = 0.0_wp
- fkb2 = 0.0_wp
- fkbm = 0.0_wp
- flog = 0.0_wp
- flog1 = 0.0_wp
- flog2 = 0.0_wp
- flogm = 0.0_wp
- fnb = 0.0_wp
- fnl = 0.0_wp
- sl2 = 0.0_wp
- i1 = 0
- i2 = 0
- itime = 0
- j2 = 0
- l1 = 0
- l2 = 0
- !********
-
- ! these are recursive functions that
- ! replace the gotos in the original code
- call task1(dummy)
-
- contains
-
- recursive subroutine task1(done)
- logical,intent(out) :: done
- done = .false.
- fnl = il
- fnb = ib
- itime = 0
- i2 = 0
- do
- ! find consecutive sub-sub-maps for scaled l-values ls1,ls2,
- ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps.
- ! i1,i2 are indeces of first elements minus 1.
- l2 = map(i2+1)
- if ( map(i2+2)<=il ) then
+ integer, intent(in) :: il !! scaled l-value
+ integer, intent(in) :: ib !! scaled b/b0-1
+ real(wp) :: trara2 !! scaled logarithm of particle flux
+
+ real(wp) :: dfl, fincr1, fincr2, fistep, fkb, fkb1, fkb2, fkbj1, fkbj2, &
+ fkbm, fll1, fll2, flog, flog1, flog2, flogm, &
+ fnb, fnl, sl1, sl2
+ integer :: i1, i2, itime, j1, j2, kt, l1, l2
+ logical :: dummy
+
+ fistep = me%fistep
+
+ !********
+ ! to avoid -Wmaybe-uninitialized warning
+ dfl = 0.0_wp
+ fincr1 = 0.0_wp
+ fincr2 = 0.0_wp
+ fkb = 0.0_wp
+ fkb1 = 0.0_wp
+ fkb2 = 0.0_wp
+ fkbm = 0.0_wp
+ flog = 0.0_wp
+ flog1 = 0.0_wp
+ flog2 = 0.0_wp
+ flogm = 0.0_wp
+ fnb = 0.0_wp
+ fnl = 0.0_wp
+ sl2 = 0.0_wp
+ i1 = 0
+ i2 = 0
+ itime = 0
+ j2 = 0
+ l1 = 0
+ l2 = 0
+ !********
+
+ ! these are recursive functions that
+ ! replace the gotos in the original code
+ call task1(dummy)
+
+ contains
+
+ recursive subroutine task1(done)
+ logical, intent(out) :: done
+ done = .false.
+ fnl = il
+ fnb = ib
+ itime = 0
+ i2 = 0
+ do
+ ! find consecutive sub-sub-maps for scaled l-values ls1,ls2,
+ ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps.
+ ! i1,i2 are indeces of first elements minus 1.
+ l2 = map(i2 + 1)
+ if (map(i2 + 2) <= il) then
+ i1 = i2
+ l1 = l2
+ i2 = i2 + l2
+ ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0
+ elseif ((l1 < 4) .and. (l2 < 4)) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ ! if flog2 less flog1, than ls2 first map and ls1 second map
+ if (map(i2 + 3) <= map(i1 + 3)) exit
+ call task3(done)
+ return
+ end if
+ end do
+ call task2(done)
+ end subroutine task1
+ recursive subroutine task2(done)
+ logical, intent(out) :: done
+ done = .false.
+ kt = i1
i1 = i2
+ i2 = kt
+ kt = l1
l1 = l2
- i2 = i2 + l2
- ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0
- elseif ( (l1<4) .and. (l2<4) ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- ! if flog2 less flog1, than ls2 first map and ls1 second map
- if ( map(i2+3)<=map(i1+3) ) exit
+ l2 = kt
call task3(done)
- return
- endif
- enddo
- call task2(done)
- end subroutine task1
- recursive subroutine task2(done)
- logical,intent(out) :: done
- done = .false.
- kt = i1
- i1 = i2
- i2 = kt
- kt = l1
- l1 = l2
- l2 = kt
- call task3(done)
- end subroutine task2
- recursive subroutine task3(done)
- logical,intent(out) :: done
- logical :: check
- done = .false.
- ! determine interpolate in scaled l-value
- fll1 = map(i1+2)
- fll2 = map(i2+2)
- dfl = (fnl-fll1)/(fll2-fll1)
- flog1 = map(i1+3)
- flog2 = map(i2+3)
- fkb1 = 0.0_wp
- fkb2 = 0.0_wp
- if ( l1>=4 ) then
- ! b/b0 loop
- check = .true.
- do j2 = 4 , l2
- fincr2 = map(i2+j2)
- if ( fkb2+fincr2>fnb ) then
- check = .false.
- exit
+ end subroutine task2
+ recursive subroutine task3(done)
+ logical, intent(out) :: done
+ logical :: check
+ done = .false.
+ ! determine interpolate in scaled l-value
+ fll1 = map(i1 + 2)
+ fll2 = map(i2 + 2)
+ dfl = (fnl - fll1) / (fll2 - fll1)
+ flog1 = map(i1 + 3)
+ flog2 = map(i2 + 3)
+ fkb1 = 0.0_wp
+ fkb2 = 0.0_wp
+ if (l1 >= 4) then
+ ! b/b0 loop
+ check = .true.
+ do j2 = 4, l2
+ fincr2 = map(i2 + j2)
+ if (fkb2 + fincr2 > fnb) then
+ check = .false.
+ exit
+ end if
+ fkb2 = fkb2 + fincr2
+ flog2 = flog2 - fistep
+ end do
+ if (check) then
+ itime = itime + 1
+ if (itime == 1) then
+ call task2(done)
+ return
+ end if
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ end if
+ if (itime /= 1) then
+ if (j2 == 4) then
+ call task4(done)
+ return
+ end if
+ sl2 = flog2 / fkb2
+ check = .true.
+ do j1 = 4, l1
+ fincr1 = map(i1 + j1)
+ fkb1 = fkb1 + fincr1
+ flog1 = flog1 - fistep
+ fkbj1 = ((flog1 / fistep) * fincr1 + fkb1) / ((fincr1 / fistep) * sl2 + 1.0_wp)
+ if (fkbj1 <= fkb1) then
+ check = .false.
+ exit
+ end if
+ end do
+ if (check) then
+ if (fkbj1 <= fkb2) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ end if
+ end if
+ if (fkbj1 <= fkb2) then
+ fkbm = fkbj1 + (fkb2 - fkbj1) * dfl
+ flogm = fkbm * sl2
+ flog2 = flog2 - fistep
+ fkb2 = fkb2 + fincr2
+ sl1 = flog1 / fkb1
+ sl2 = flog2 / fkb2
+ call task5(done)
+ return
+ else
+ fkb1 = 0.0_wp
+ end if
+ end if
+ fkb2 = 0.0_wp
end if
+ j2 = 4
+ fincr2 = map(i2 + j2)
+ flog2 = map(i2 + 3)
+ flog1 = map(i1 + 3)
+ call task4(done)
+ end subroutine task3
+ recursive subroutine task4(done)
+ logical, intent(out) :: done
+ done = .false.
+ flogm = flog1 + (flog2 - flog1) * dfl
+ fkbm = 0.0_wp
fkb2 = fkb2 + fincr2
flog2 = flog2 - fistep
- enddo
- if (check) then
- itime = itime + 1
- if ( itime==1 ) then
- call task2(done)
- return
- endif
- trara2 = 0.0_wp
- done = .true.
- return
- end if
- if ( itime/=1 ) then
- if ( j2==4 ) then
- call task4(done)
- return
- endif
- sl2 = flog2/fkb2
- check = .true.
- do j1 = 4 , l1
- fincr1 = map(i1+j1)
- fkb1 = fkb1 + fincr1
- flog1 = flog1 - fistep
- fkbj1 = ((flog1/fistep)*fincr1+fkb1)/((fincr1/fistep)*sl2+1.0_wp)
- if ( fkbj1<=fkb1 ) then
- check = .false.
- exit
- end if
- enddo
- if (check) then
- if ( fkbj1<=fkb2 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- endif
- end if
- if ( fkbj1<=fkb2 ) then
- fkbm = fkbj1 + (fkb2-fkbj1)*dfl
- flogm = fkbm*sl2
- flog2 = flog2 - fistep
- fkb2 = fkb2 + fincr2
- sl1 = flog1/fkb1
- sl2 = flog2/fkb2
- call task5(done)
- return
+ sl2 = flog2 / fkb2
+ if (l1 < 4) then
+ fincr1 = 0.0_wp
+ sl1 = -900000.0_wp
+ call task6(done)
+ return
else
- fkb1 = 0.0_wp
- endif
- endif
- fkb2 = 0.0_wp
- endif
- j2 = 4
- fincr2 = map(i2+j2)
- flog2 = map(i2+3)
- flog1 = map(i1+3)
- call task4(done)
- end subroutine task3
- recursive subroutine task4(done)
- logical,intent(out) :: done
- done = .false.
- flogm = flog1 + (flog2-flog1)*dfl
- fkbm = 0.0_wp
- fkb2 = fkb2 + fincr2
- flog2 = flog2 - fistep
- sl2 = flog2/fkb2
- if ( l1<4 ) then
- fincr1 = 0.0_wp
- sl1 = -900000.0_wp
- call task6(done)
- return
- else
- j1 = 4
- fincr1 = map(i1+j1)
- fkb1 = fkb1 + fincr1
- flog1 = flog1 - fistep
- sl1 = flog1/fkb1
- endif
- call task5(done)
- end subroutine task4
- recursive subroutine task5(done)
- logical,intent(out) :: done
- done = .false.
- do while ( sl1>=sl2 )
- fkbj2 = ((flog2/fistep)*fincr2+fkb2)/((fincr2/fistep)*sl1+1.0_wp)
- fkb = fkb1 + (fkbj2-fkb1)*dfl
- flog = fkb*sl1
- if ( fkb>=fnb ) then
+ j1 = 4
+ fincr1 = map(i1 + j1)
+ fkb1 = fkb1 + fincr1
+ flog1 = flog1 - fistep
+ sl1 = flog1 / fkb1
+ end if
+ call task5(done)
+ end subroutine task4
+ recursive subroutine task5(done)
+ logical, intent(out) :: done
+ done = .false.
+ do while (sl1 >= sl2)
+ fkbj2 = ((flog2 / fistep) * fincr2 + fkb2) / ((fincr2 / fistep) * sl1 + 1.0_wp)
+ fkb = fkb1 + (fkbj2 - fkb1) * dfl
+ flog = fkb * sl1
+ if (fkb >= fnb) then
+ call task7(done)
+ return
+ end if
+ fkbm = fkb
+ flogm = flog
+ if (j1 >= l1) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ j1 = j1 + 1
+ fincr1 = map(i1 + j1)
+ flog1 = flog1 - fistep
+ fkb1 = fkb1 + fincr1
+ sl1 = flog1 / fkb1
+ end if
+ end do
+ call task6(done)
+ end subroutine task5
+ recursive subroutine task6(done)
+ logical, intent(out) :: done
+ done = .false.
+ fkbj1 = ((flog1 / fistep) * fincr1 + fkb1) / ((fincr1 / fistep) * sl2 + 1.0_wp)
+ fkb = fkbj1 + (fkb2 - fkbj1) * dfl
+ flog = fkb * sl2
+ if (fkb < fnb) then
+ fkbm = fkb
+ flogm = flog
+ if (j2 >= l2) then
+ trara2 = 0.0_wp
+ done = .true.
+ return
+ else
+ j2 = j2 + 1
+ fincr2 = map(i2 + j2)
+ flog2 = flog2 - fistep
+ fkb2 = fkb2 + fincr2
+ sl2 = flog2 / fkb2
+ call task5(done)
+ return
+ end if
+ end if
call task7(done)
- return
- endif
- fkbm = fkb
- flogm = flog
- if ( j1>=l1 ) then
- trara2 = 0.0_wp
- done = .true.
- return
- else
- j1 = j1 + 1
- fincr1 = map(i1+j1)
- flog1 = flog1 - fistep
- fkb1 = fkb1 + fincr1
- sl1 = flog1/fkb1
- endif
- enddo
- call task6(done)
- end subroutine task5
- recursive subroutine task6(done)
- logical,intent(out) :: done
- done = .false.
- fkbj1 = ((flog1/fistep)*fincr1+fkb1)/((fincr1/fistep)*sl2+1.0_wp)
- fkb = fkbj1 + (fkb2-fkbj1)*dfl
- flog = fkb*sl2
- if ( fkb=l2 ) then
- trara2 = 0.0_wp
+ end subroutine task6
+ recursive subroutine task7(done)
+ logical, intent(out) :: done
+ if (fkb < fkbm + 1.0e-10_wp) then
+ trara2 = 0.0_wp
+ else
+ trara2 = flogm + (flog - flogm) * ((fnb - fkbm) / (fkb - fkbm))
+ trara2 = max(trara2, 0.0_wp)
+ end if
done = .true.
- return
- else
- j2 = j2 + 1
- fincr2 = map(i2+j2)
- flog2 = flog2 - fistep
- fkb2 = fkb2 + fincr2
- sl2 = flog2/fkb2
- call task5(done)
- return
- endif
- endif
- call task7(done)
- end subroutine task6
- recursive subroutine task7(done)
- logical,intent(out) :: done
- if ( fkbtype~shellig_type igrf type~trm_type trm_type type~radbelt_type->type~trm_type trm Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial type( trm_type ), private :: trm type( shellig_type ), private :: igrf Type-Bound Procedures generic, public :: get_flux => get_flux_g_ , get_flux_c_ public function get_flux_g_ (me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c_ (me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. procedure, private :: get_flux_c_ public function get_flux_c_ (me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. procedure, private :: get_flux_g_ public function get_flux_g_ (me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. procedure, public :: set_data_files_paths public subroutine set_data_files_paths (me, aep8_dir, igrf_dir) Set the paths to the data files.\nIf not used or blank, the folder data/aep8 and data/igrf in the\ncurrent working directory is assumed Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: aep8_dir character(len=*), intent(in) :: igrf_dir procedure, public :: set_igrf_file_path public subroutine set_igrf_file_path (me, dir) Set the igrf path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir procedure, public :: set_trm_file_path public subroutine set_trm_file_path (me, dir) Set the trm path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir Source Code type , public :: radbelt_type !! the main class that can be used to get the flux. private type ( trm_type ) :: trm type ( shellig_type ) :: igrf contains private generic , public :: get_flux => get_flux_g_ , get_flux_c_ procedure :: get_flux_g_ , get_flux_c_ procedure , public :: set_trm_file_path , & set_igrf_file_path , & set_data_files_paths end type radbelt_type","tags":"","loc":"type/radbelt_type.html"},{"title":"trm_type – radbelt ","text":"type, public :: trm_type main class for the aep8 model Inherited by type~~trm_type~~InheritedByGraph type~trm_type trm_type type~radbelt_type radbelt_type type~radbelt_type->type~trm_type trm Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: aep8_dir directory containing the data files character(len=:), private, allocatable :: file_loaded the file that has been loaded integer, private, dimension(8) :: ihead = 0 integer, private, dimension(:), allocatable :: map real(kind=wp), private :: fistep = 0.0_wp the stepsize for the parameterization of the logarithm of flux.\nformerly stored in common block tra2 real(kind=wp), private :: f1 = 1.001_wp real(kind=wp), private :: f2 = 1.002_wp Type-Bound Procedures procedure, public :: aep8 main routine private subroutine aep8 (me, e, l, bb0, imname, flux) Main wrapper for the radiation model.\nReads the coefficient file and calls the low-level routine. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me real(kind=wp), intent(in) :: e real(kind=wp), intent(in) :: l real(kind=wp), intent(in) :: bb0 integer, intent(in) :: imname which model to load (index in mname array) real(kind=wp), intent(out) :: flux procedure, public :: trara2 low-level routine private function trara2 (me, map, il, ib) trara2 interpolates linearly in l-b/b0-map to obtain\n the logarithm of integral flux at given l and b/b0. Read more… Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: map (*) is sub-map (for specific energy) of\ntrapped radiation model map integer, intent(in) :: il scaled l-value integer, intent(in) :: ib scaled b/b0-1 Return Value real(kind=wp) scaled logarithm of particle flux procedure, public :: trara1 private subroutine trara1 (me, descr, map, fl, bb0, e, f, n) trara1 finds particle fluxes for given energies, magnetic field\nstrength and l-value. function trara2 is used to interpolate in\nb-l-space. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: descr (8) header of specified trapped radition model integer, intent(in) :: map (*) map of trapped radition model\n(descr and map are explained at the begin\nof the main program model) real(kind=wp), intent(in) :: fl l-value real(kind=wp), intent(in) :: bb0 =b/b0 magnetic field strength normalized\nto field strength at magnetic equator real(kind=wp), intent(in) :: e (n) array of energies in mev real(kind=wp), intent(out) :: f (n) decadic logarithm of integral fluxes in\nparticles/(cm cm sec) integer, intent(in) :: n number of energies procedure, public :: get_data_file_dir private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(in) :: me Return Value character(len=:), allocatable procedure, public :: set_data_file_dir private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me character(len=*), intent(in) :: dir Source Code type , public :: trm_type !! main class for the `aep8` model private character ( len = :), allocatable :: aep8_dir !! directory containing the data files ! data read from the files: character ( len = :), allocatable :: file_loaded !! the file that has been loaded integer , dimension ( 8 ) :: ihead = 0 integer , dimension (:), allocatable :: map real ( wp ) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux. !! formerly stored in common block `tra2` ! formerly saved variables in trara1: real ( wp ) :: f1 = 1.001_wp real ( wp ) :: f2 = 1.002_wp contains private procedure , public :: aep8 !! main routine procedure , public :: trara1 , trara2 !! low-level routine procedure , public :: set_data_file_dir , get_data_file_dir end type trm_type","tags":"","loc":"type/trm_type.html"},{"title":"shellig_type – radbelt ","text":"type, public :: shellig_type Inherited by type~~shellig_type~~InheritedByGraph type~shellig_type shellig_type type~radbelt_type radbelt_type type~radbelt_type->type~shellig_type igrf Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: igrf_dir directory containing the data files real(kind=wp), private, dimension(3) :: sp = 0.0_wp real(kind=wp), private, dimension(3) :: xi = 0.0_wp real(kind=wp), private, dimension(144) :: h = 0.0_wp Field model coefficients adjusted for shellg integer, private :: iyea = 0 the int year corresponding to the file name that has been read character(len=:), private, allocatable :: name file name integer, private :: nmax = 0 maximum order of spherical harmonics real(kind=wp), private :: Time = 0.0_wp year (decimal: 1973.5) for which magnetic field is to be calculated real(kind=wp), private, dimension(144) :: g = 0.0_wp g(m) -- normalized field coefficients (see feldcof ) m=nmax*(nmax+2) integer, private :: nmax1 = 0 saved variables from the file integer, private :: nmax2 = 0 saved variables from the file real(kind=wp), private, dimension(144) :: g_cache = 0.0_wp saved g from the file real(kind=wp), private :: step = 0.20_wp step size for field line tracing real(kind=wp), private :: steq = 0.03_wp step size for integration real(kind=wp), private, dimension(120) :: gh2 = 0.0_wp real(kind=wp), private, dimension(:,:), allocatable :: p this was p(8,100) in the original code.\nused for the field line integration loop.\nchanged it to be allocatable since it was\nchanged to be p(8,3334). Type-Bound Procedures procedure, public :: igrfc private subroutine igrfc (me, v, year, xl, bbx) Alternate version of igrf for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio procedure, public :: igrf private subroutine igrf (me, lon, lat, height, year, xl, bbx) Wrapper for IGRF functions. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio procedure, public :: feldcof private subroutine feldcof (me, year, dimo) Determines coefficients and dipol moment from IGRF models Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: dimo geomagnetic dipol moment in gauss (normalized\nto earth's radius) at the time (year) procedure, public :: feldc private subroutine feldc (me, v, b) Alternate version of feldg to be used with cartesian coordinates Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(out) :: b (3) field components procedure, public :: feldg private subroutine feldg (me, glat, glon, alt, bnorth, beast, bdown, Babs) Calculates earth magnetic field from spherical harmonics model Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(out) :: bnorth components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: beast components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: bdown components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: Babs magnetic field strength in gauss procedure, public :: shellc private subroutine shellc (me, v, dimo, fl, icode, b0) Wrapper to shellg to be used with cartesian coordinates. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\n* x-axis pointing to equator at 0 longitude\n* y-axis pointing to equator at 90 long.\n* z-axis pointing to north pole real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss procedure, public :: shellg private subroutine shellg (me, glat, glon, alt, dimo, fl, icode, b0, v) calculates l-value for specified geodaetic coordinates, altitude\n and gemagnetic field model. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss real(kind=wp), intent(in), optional, dimension(3) :: v cartesian coordinates in earth radii (6371.2 km) Read more… procedure, public :: findb0 private subroutine findb0 (me, stps, bdel, value, bequ, rr0) Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: stps real(kind=wp), intent(inout) :: bdel logical, intent(out) :: value real(kind=wp), intent(out) :: bequ real(kind=wp), intent(out) :: rr0 procedure, private :: feldi private subroutine feldi (me) Used for l computation. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me procedure, private :: stoer private subroutine stoer (me, p, bq, r) subroutine used for field line tracing in shellg .\ncalls entry point feldi in geomagnetic field subroutine feldg Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(inout), dimension(7) :: p real(kind=wp), intent(out) :: bq real(kind=wp), intent(out) :: r procedure, public :: get_data_file_dir private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(in) :: me Return Value character(len=:), allocatable procedure, public :: set_data_file_dir private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me character(len=*), intent(in) :: dir procedure, public :: destroy => destroy_shellig_type private subroutine destroy_shellig_type (me) Destroy a shellig_type . Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(out) :: me Source Code type , public :: shellig_type private character ( len = :), allocatable :: igrf_dir !! directory containing the data files ! formerly in the `fidb0` common block real ( wp ), dimension ( 3 ) :: sp = 0.0_wp ! formerly in blank common real ( wp ), dimension ( 3 ) :: xi = 0.0_wp real ( wp ), dimension ( 144 ) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]] ! formerly in `model` common block integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read character ( len = :), allocatable :: name !! file name integer :: nmax = 0 !! maximum order of spherical harmonics real ( wp ) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated real ( wp ), dimension ( 144 ) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2) integer :: nmax1 = 0 !! saved variables from the file integer :: nmax2 = 0 !! saved variables from the file real ( wp ), dimension ( 144 ) :: g_cache = 0.0_wp !! saved `g` from the file ! formerly saved vars in shellg: real ( wp ) :: step = 0.20_wp !! step size for field line tracing real ( wp ) :: steq = 0.03_wp !! step size for integration ! from feldcof, so we can cache the coefficients real ( wp ), dimension ( 120 ) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ??? real ( wp ), dimension (:,:), allocatable :: p !! this was `p(8,100)` in the original code. !! used for the field line integration loop. !! changed it to be allocatable since it was !! changed to be p(8,3334). contains private procedure , public :: igrf , igrfc procedure , public :: feldcof procedure , public :: feldg , feldc procedure , public :: shellg , shellc procedure , public :: findb0 procedure :: stoer , feldi procedure , public :: set_data_file_dir , get_data_file_dir procedure , public :: destroy => destroy_shellig_type end type shellig_type","tags":"","loc":"type/shellig_type.html"},{"title":"c2f_str – radbelt","text":"public function c2f_str(cstr) result(fstr) Convert C string to Fortran Arguments Type Intent Optional Attributes Name character(kind=c_char, len=1), intent(in), dimension(:) :: cstr string from C Return Value character(len=:), allocatable fortran string Called by proc~~c2f_str~~CalledByGraph proc~c2f_str radbelt_c_module::c2f_str proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~c2f_str proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~c2f_str proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~c2f_str Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function c2f_str ( cstr ) result ( fstr ) character ( kind = c_char , len = 1 ), dimension (:), intent ( in ) :: cstr !! string from C character ( len = :), allocatable :: fstr !! fortran string integer :: i !! counter fstr = '' do i = 1 , size ( cstr ) fstr = fstr // cstr ( i ) end do fstr = trim ( fstr ) end function c2f_str","tags":"","loc":"proc/c2f_str.html"},{"title":"int_pointer_to_f_pointer – radbelt","text":"public subroutine int_pointer_to_f_pointer(ipointer, p) Convert an integer pointer to a radbelt_type pointer. Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer integer pointer from C type( radbelt_type ), pointer :: p fortran pointer Called by proc~~int_pointer_to_f_pointer~~CalledByGraph proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~destroy_c radbelt_c_module::destroy_c proc~destroy_c->proc~int_pointer_to_f_pointer proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->proc~int_pointer_to_f_pointer proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~int_pointer_to_f_pointer proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~int_pointer_to_f_pointer proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~int_pointer_to_f_pointer Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine int_pointer_to_f_pointer ( ipointer , p ) integer ( c_intptr_t ), intent ( in ) :: ipointer !! integer pointer from C type ( radbelt_type ), pointer :: p !! fortran pointer type ( c_ptr ) :: cp cp = transfer ( ipointer , c_null_ptr ) if ( c_associated ( cp )) then call c_f_pointer ( cp , p ) else p => null () end if end subroutine int_pointer_to_f_pointer","tags":"","loc":"proc/int_pointer_to_f_pointer.html"},{"title":"initialize_c – radbelt","text":"public subroutine initialize_c(ipointer) bind(C, name=\"initialize_c\") create a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(out) :: ipointer Source Code subroutine initialize_c ( ipointer ) bind ( C , name = \"initialize_c\" ) integer ( c_intptr_t ), intent ( out ) :: ipointer type ( radbelt_type ), pointer :: p type ( c_ptr ) :: cp allocate ( p ) cp = c_loc ( p ) ipointer = transfer ( cp , 0_c_intptr_t ) end subroutine initialize_c","tags":"","loc":"proc/initialize_c.html"},{"title":"destroy_c – radbelt","text":"public subroutine destroy_c(ipointer) bind(C, name=\"destroy_c\") destroy a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer Calls proc~~destroy_c~~CallsGraph proc~destroy_c radbelt_c_module::destroy_c proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~destroy_c->proc~int_pointer_to_f_pointer Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine destroy_c ( ipointer ) bind ( C , name = \"destroy_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) deallocate ( p ) end subroutine destroy_c","tags":"","loc":"proc/destroy_c.html"},{"title":"set_trm_file_path_c – radbelt","text":"public subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name=\"set_trm_file_path_c\") C interface for setting the trm data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir integer(kind=c_int), intent(in) :: n size of aep8_dir Calls proc~~set_trm_file_path_c~~CallsGraph proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~c2f_str radbelt_c_module::c2f_str proc~set_trm_file_path_c->proc~c2f_str proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~set_trm_file_path_c->proc~int_pointer_to_f_pointer proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_trm_file_path_c->proc~set_trm_file_path proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_trm_file_path_c ( ipointer , aep8_dir , n ) bind ( C , name = \"set_trm_file_path_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir character ( len = :), allocatable :: aep8_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) call p % set_trm_file_path ( aep8_dir_ ) else error stop 'error in set_trm_file_path_c: class is not associated' end if end subroutine set_trm_file_path_c","tags":"","loc":"proc/set_trm_file_path_c.html"},{"title":"set_igrf_file_path_c – radbelt","text":"public subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name=\"set_igrf_file_path\") C interface for setting the igrf data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: igrf_dir integer(kind=c_int), intent(in) :: n size of igrf_dir Calls proc~~set_igrf_file_path_c~~CallsGraph proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~c2f_str radbelt_c_module::c2f_str proc~set_igrf_file_path_c->proc~c2f_str proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~set_igrf_file_path_c->proc~int_pointer_to_f_pointer proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_igrf_file_path_c->proc~set_igrf_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_igrf_file_path_c ( ipointer , igrf_dir , n ) bind ( C , name = \"set_igrf_file_path\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then igrf_dir_ = c2f_str ( igrf_dir ) call p % set_igrf_file_path ( igrf_dir_ ) else error stop 'error in set_igrf_file_path: class is not associated' end if end subroutine set_igrf_file_path_c","tags":"","loc":"proc/set_igrf_file_path_c.html"},{"title":"set_data_files_paths_c – radbelt","text":"public subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name=\"set_data_files_paths_c\") C interface for setting the data file paths Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir character(kind=c_char, len=1), intent(in), dimension(m) :: igrf_dir integer(kind=c_int), intent(in) :: n size of aep8_dir integer(kind=c_int), intent(in) :: m size of igrf_dir Calls proc~~set_data_files_paths_c~~CallsGraph proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~c2f_str radbelt_c_module::c2f_str proc~set_data_files_paths_c->proc~c2f_str proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~set_data_files_paths_c->proc~int_pointer_to_f_pointer proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths_c->proc~set_data_files_paths proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_files_paths->proc~set_igrf_file_path proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_files_paths->proc~set_trm_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_files_paths_c ( ipointer , aep8_dir , igrf_dir , n , m ) bind ( C , name = \"set_data_files_paths_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir integer ( c_int ), intent ( in ) :: m !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( m ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: aep8_dir_ , igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) igrf_dir_ = c2f_str ( igrf_dir ) call p % set_data_files_paths ( aep8_dir_ , igrf_dir_ ) else error stop 'error in set_data_files_paths_c: class is not associated' end if end subroutine set_data_files_paths_c","tags":"","loc":"proc/set_data_files_paths_c.html"},{"title":"get_flux_g_c – radbelt","text":"public subroutine get_flux_g_c(ipointer, lon, lat, height, year, e, imname, flux) bind(C, name=\"get_flux_g_c\") C interface to get_flux_g . Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer real(kind=c_double), intent(in) :: lon geodetic longitude in degrees (east) real(kind=c_double), intent(in) :: lat geodetic latitude in degrees (north) real(kind=c_double), intent(in) :: height altitude in km above sea level real(kind=c_double), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=c_double), intent(in) :: e minimum energy integer(kind=c_int), intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max real(kind=c_double), intent(out) :: flux The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_g_c~~CallsGraph proc~get_flux_g_c radbelt_c_module::get_flux_g_c none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_g_c->none~get_flux proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~get_flux_g_c->proc~int_pointer_to_f_pointer proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine get_flux_g_c ( ipointer , lon , lat , height , year , e , imname , flux ) bind ( C , name = \"get_flux_g_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer real ( c_double ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( c_double ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( c_double ), intent ( in ) :: height !! altitude in km above sea level real ( c_double ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( c_double ), intent ( in ) :: e !! minimum energy integer ( c_int ), intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( c_double ), intent ( out ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then flux = p % get_flux ( lon , lat , height , year , e , imname ) else error stop 'error in get_flux_g_c: class is not associated' end if end subroutine get_flux_g_c","tags":"","loc":"proc/get_flux_g_c.html"},{"title":"get_flux_g_ – radbelt","text":"public function get_flux_g_(me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_g_~~CallsGraph proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_g_~~CalledByGraph proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_g_ ( me , lon , lat , height , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrf ( lon , lat , height , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_g_","tags":"","loc":"proc/get_flux_g_.html"},{"title":"get_flux_g – radbelt","text":"public function get_flux_g(lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_g~~CallsGraph proc~get_flux_g radbelt_module::get_flux_g none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_g->none~get_flux proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_g~~CalledByGraph proc~get_flux_g radbelt_module::get_flux_g interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_g ( lon , lat , height , year , e , imname ) result ( flux ) real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( lon , lat , height , year , e , imname ) end function get_flux_g","tags":"","loc":"proc/get_flux_g.html"},{"title":"get_flux_c_ – radbelt","text":"public function get_flux_c_(me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_c_~~CallsGraph proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~feldcof shellig_module::shellig_type%feldcof proc~igrfc->proc~feldcof proc~findb0 shellig_module::shellig_type%findb0 proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellc->proc~shellg proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~shellg->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_c_~~CalledByGraph proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_c_ ( me , v , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrfc ( v , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_c_","tags":"","loc":"proc/get_flux_c_.html"},{"title":"get_flux_c – radbelt","text":"public function get_flux_c(v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_c~~CallsGraph proc~get_flux_c radbelt_module::get_flux_c none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_c->none~get_flux proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_c~~CalledByGraph proc~get_flux_c radbelt_module::get_flux_c interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_c ( v , year , e , imname ) result ( flux ) real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( v , year , e , imname ) end function get_flux_c","tags":"","loc":"proc/get_flux_c.html"},{"title":"set_trm_file_path – radbelt","text":"public subroutine set_trm_file_path(me, dir) Set the trm path. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir Calls proc~~set_trm_file_path~~CallsGraph proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_trm_file_path~~CalledByGraph proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_trm_file_path proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~set_trm_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_trm_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % trm % set_data_file_dir ( trim ( dir )) end subroutine set_trm_file_path","tags":"","loc":"proc/set_trm_file_path.html"},{"title":"set_igrf_file_path – radbelt","text":"public subroutine set_igrf_file_path(me, dir) Set the igrf path. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir Calls proc~~set_igrf_file_path~~CallsGraph proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_igrf_file_path~~CalledByGraph proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_igrf_file_path proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~set_igrf_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_igrf_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % igrf % set_data_file_dir ( trim ( dir )) end subroutine set_igrf_file_path","tags":"","loc":"proc/set_igrf_file_path.html"},{"title":"set_data_files_paths – radbelt","text":"public subroutine set_data_files_paths(me, aep8_dir, igrf_dir) Set the paths to the data files.\nIf not used or blank, the folder data/aep8 and data/igrf in the\ncurrent working directory is assumed Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: aep8_dir character(len=*), intent(in) :: igrf_dir Calls proc~~set_data_files_paths~~CallsGraph proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_files_paths->proc~set_igrf_file_path proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_files_paths->proc~set_trm_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_data_files_paths~~CalledByGraph proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_files_paths ( me , aep8_dir , igrf_dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: aep8_dir character ( len =* ), intent ( in ) :: igrf_dir call me % set_trm_file_path ( trim ( aep8_dir )) call me % set_igrf_file_path ( trim ( igrf_dir )) end subroutine set_data_files_paths","tags":"","loc":"proc/set_data_files_paths.html"},{"title":"get_flux – radbelt","text":"public interface get_flux simple function versions for testing Calls interface~~get_flux~~CallsGraph interface~get_flux radbelt_module::get_flux proc~get_flux_c radbelt_module::get_flux_c interface~get_flux->proc~get_flux_c proc~get_flux_g radbelt_module::get_flux_g interface~get_flux->proc~get_flux_g none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_c->none~get_flux proc~get_flux_g->none~get_flux proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures public function get_flux_g (lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c (v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1.","tags":"","loc":"interface/get_flux.html"},{"title":"get_data_file_dir – radbelt","text":"private function get_data_file_dir(me) result(dir) Get the directory containing the data files. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(in) :: me Return Value character(len=:), allocatable Called by proc~~get_data_file_dir~~CalledByGraph proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8 trmfun_module::trm_type%aep8 proc~aep8->proc~get_data_file_dir proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_data_file_dir ( me ) result ( dir ) class ( trm_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % aep8_dir )) then dir = trim ( me % aep8_dir ) // '/' else dir = 'data/aep8/' ! default end if end function get_data_file_dir","tags":"","loc":"proc/get_data_file_dir.html"},{"title":"trara2 – radbelt","text":"private function trara2(me, map, il, ib) trara2 interpolates linearly in l-b/b0-map to obtain\n the logarithm of integral flux at given l and b/b0. Note see main program 'model' for explanation of map format\n scaling factors. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: map (*) is sub-map (for specific energy) of\ntrapped radiation model map integer, intent(in) :: il scaled l-value integer, intent(in) :: ib scaled b/b0-1 Return Value real(kind=wp) scaled logarithm of particle flux Called by proc~~trara2~~CalledByGraph proc~trara2 trmfun_module::trm_type%trara2 proc~trara1 trmfun_module::trm_type%trara1 proc~trara1->proc~trara2 proc~aep8 trmfun_module::trm_type%aep8 proc~aep8->proc~trara1 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function trara2 ( me , map , il , ib ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: map ( * ) !! is sub-map (for specific energy) of !! trapped radiation model map integer , intent ( in ) :: il !! scaled l-value integer , intent ( in ) :: ib !! scaled b/b0-1 real ( wp ) :: trara2 !! scaled logarithm of particle flux real ( wp ) :: dfl , fincr1 , fincr2 , fistep , fkb , fkb1 , fkb2 , fkbj1 , fkbj2 , & fkbm , fll1 , fll2 , flog , flog1 , flog2 , flogm , & fnb , fnl , sl1 , sl2 integer :: i1 , i2 , itime , j1 , j2 , kt , l1 , l2 logical :: dummy fistep = me % fistep !******** ! to avoid -Wmaybe-uninitialized warning dfl = 0.0_wp fincr1 = 0.0_wp fincr2 = 0.0_wp fkb = 0.0_wp fkb1 = 0.0_wp fkb2 = 0.0_wp fkbm = 0.0_wp flog = 0.0_wp flog1 = 0.0_wp flog2 = 0.0_wp flogm = 0.0_wp fnb = 0.0_wp fnl = 0.0_wp sl2 = 0.0_wp i1 = 0 i2 = 0 itime = 0 j2 = 0 l1 = 0 l2 = 0 !******** ! these are recursive functions that ! replace the gotos in the original code call task1 ( dummy ) contains recursive subroutine task1 ( done ) logical , intent ( out ) :: done done = . false . fnl = il fnb = ib itime = 0 i2 = 0 do ! find consecutive sub-sub-maps for scaled l-values ls1,ls2, ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps. ! i1,i2 are indeces of first elements minus 1. l2 = map ( i2 + 1 ) if ( map ( i2 + 2 ) <= il ) then i1 = i2 l1 = l2 i2 = i2 + l2 ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0 elseif ( ( l1 < 4 ) . and . ( l2 < 4 ) ) then trara2 = 0.0_wp done = . true . return else ! if flog2 less flog1, than ls2 first map and ls1 second map if ( map ( i2 + 3 ) <= map ( i1 + 3 ) ) exit call task3 ( done ) return endif enddo call task2 ( done ) end subroutine task1 recursive subroutine task2 ( done ) logical , intent ( out ) :: done done = . false . kt = i1 i1 = i2 i2 = kt kt = l1 l1 = l2 l2 = kt call task3 ( done ) end subroutine task2 recursive subroutine task3 ( done ) logical , intent ( out ) :: done logical :: check done = . false . ! determine interpolate in scaled l-value fll1 = map ( i1 + 2 ) fll2 = map ( i2 + 2 ) dfl = ( fnl - fll1 ) / ( fll2 - fll1 ) flog1 = map ( i1 + 3 ) flog2 = map ( i2 + 3 ) fkb1 = 0.0_wp fkb2 = 0.0_wp if ( l1 >= 4 ) then ! b/b0 loop check = . true . do j2 = 4 , l2 fincr2 = map ( i2 + j2 ) if ( fkb2 + fincr2 > fnb ) then check = . false . exit end if fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep enddo if ( check ) then itime = itime + 1 if ( itime == 1 ) then call task2 ( done ) return endif trara2 = 0.0_wp done = . true . return end if if ( itime /= 1 ) then if ( j2 == 4 ) then call task4 ( done ) return endif sl2 = flog2 / fkb2 check = . true . do j1 = 4 , l1 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) if ( fkbj1 <= fkb1 ) then check = . false . exit end if enddo if ( check ) then if ( fkbj1 <= fkb2 ) then trara2 = 0.0_wp done = . true . return endif end if if ( fkbj1 <= fkb2 ) then fkbm = fkbj1 + ( fkb2 - fkbj1 ) * dfl flogm = fkbm * sl2 flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl1 = flog1 / fkb1 sl2 = flog2 / fkb2 call task5 ( done ) return else fkb1 = 0.0_wp endif endif fkb2 = 0.0_wp endif j2 = 4 fincr2 = map ( i2 + j2 ) flog2 = map ( i2 + 3 ) flog1 = map ( i1 + 3 ) call task4 ( done ) end subroutine task3 recursive subroutine task4 ( done ) logical , intent ( out ) :: done done = . false . flogm = flog1 + ( flog2 - flog1 ) * dfl fkbm = 0.0_wp fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep sl2 = flog2 / fkb2 if ( l1 < 4 ) then fincr1 = 0.0_wp sl1 = - 90000 0.0_wp call task6 ( done ) return else j1 = 4 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep sl1 = flog1 / fkb1 endif call task5 ( done ) end subroutine task4 recursive subroutine task5 ( done ) logical , intent ( out ) :: done done = . false . do while ( sl1 >= sl2 ) fkbj2 = (( flog2 / fistep ) * fincr2 + fkb2 ) / (( fincr2 / fistep ) * sl1 + 1.0_wp ) fkb = fkb1 + ( fkbj2 - fkb1 ) * dfl flog = fkb * sl1 if ( fkb >= fnb ) then call task7 ( done ) return endif fkbm = fkb flogm = flog if ( j1 >= l1 ) then trara2 = 0.0_wp done = . true . return else j1 = j1 + 1 fincr1 = map ( i1 + j1 ) flog1 = flog1 - fistep fkb1 = fkb1 + fincr1 sl1 = flog1 / fkb1 endif enddo call task6 ( done ) end subroutine task5 recursive subroutine task6 ( done ) logical , intent ( out ) :: done done = . false . fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) fkb = fkbj1 + ( fkb2 - fkbj1 ) * dfl flog = fkb * sl2 if ( fkb < fnb ) then fkbm = fkb flogm = flog if ( j2 >= l2 ) then trara2 = 0.0_wp done = . true . return else j2 = j2 + 1 fincr2 = map ( i2 + j2 ) flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl2 = flog2 / fkb2 call task5 ( done ) return endif endif call task7 ( done ) end subroutine task6 recursive subroutine task7 ( done ) logical , intent ( out ) :: done if ( fkb < fkbm + 1.0e-10_wp ) then trara2 = 0.0_wp else trara2 = flogm + ( flog - flogm ) * (( fnb - fkbm ) / ( fkb - fkbm )) trara2 = max ( trara2 , 0.0_wp ) endif done = . true . end subroutine task7 end function trara2","tags":"","loc":"proc/trara2.html"},{"title":"set_data_file_dir – radbelt","text":"private subroutine set_data_file_dir(me, dir) Set the directory containing the data files. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me character(len=*), intent(in) :: dir Called by proc~~set_data_file_dir~~CalledByGraph proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_trm_file_path->proc~set_data_file_dir proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_trm_file_path proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~set_trm_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_file_dir ( me , dir ) class ( trm_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % aep8_dir = trim ( dir ) end subroutine set_data_file_dir","tags":"","loc":"proc/set_data_file_dir.html"},{"title":"aep8 – radbelt","text":"private subroutine aep8(me, e, l, bb0, imname, flux) Main wrapper for the radiation model.\nReads the coefficient file and calls the low-level routine. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me real(kind=wp), intent(in) :: e real(kind=wp), intent(in) :: l real(kind=wp), intent(in) :: bb0 integer, intent(in) :: imname which model to load (index in mname array) real(kind=wp), intent(out) :: flux Calls proc~~aep8~~CallsGraph proc~aep8 trmfun_module::trm_type%aep8 proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~aep8~~CalledByGraph proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine aep8 ( me , e , l , bb0 , imname , flux ) class ( trm_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: e real ( wp ), intent ( in ) :: l real ( wp ), intent ( in ) :: bb0 integer , intent ( in ) :: imname !! which model to load (index in `mname` array) real ( wp ), intent ( out ) :: flux real ( wp ) :: ee ( 1 ), f ( 1 ) !! temp variables integer :: i , ierr , iuaeap , nmap character ( len = :), allocatable :: name logical :: load_file name = me % get_data_file_dir () // trim ( mname ( Imname )) ! the file to load ! JW : do we need to reset some or all of these ? me % fistep = 0.0_wp me % f1 = 1.001_wp me % f2 = 1.002_wp ! check to see if this file has already been loaded ! [the class can store one file at a time] load_file = . true . if ( allocated ( me % file_loaded )) then if ( name == me % file_loaded ) load_file = . false . end if if ( load_file ) then open ( newunit = iuaeap , file = name , status = 'OLD' , iostat = ierr , form = 'FORMATTED' ) if ( ierr /= 0 ) then error stop 'error reading ' // trim ( name ) end if read ( iuaeap , '(1X,12I6)' ) me % ihead nmap = me % ihead ( 8 ) allocate ( me % map ( nmap )) read ( iuaeap , '(1X,12I6)' ) ( me % map ( i ), i = 1 , nmap ) close ( iuaeap ) me % file_loaded = trim ( name ) end if ee ( 1 ) = e call me % trara1 ( me % ihead , me % map , L , Bb0 , ee , f , 1 ) flux = f ( 1 ) IF ( Flux > 0.0_wp ) Flux = 1 0.0_wp ** Flux end subroutine aep8","tags":"","loc":"proc/aep8.html"},{"title":"trara1 – radbelt","text":"private subroutine trara1(me, descr, map, fl, bb0, e, f, n) trara1 finds particle fluxes for given energies, magnetic field\nstrength and l-value. function trara2 is used to interpolate in\nb-l-space. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: descr (8) header of specified trapped radition model integer, intent(in) :: map (*) map of trapped radition model\n(descr and map are explained at the begin\nof the main program model) real(kind=wp), intent(in) :: fl l-value real(kind=wp), intent(in) :: bb0 =b/b0 magnetic field strength normalized\nto field strength at magnetic equator real(kind=wp), intent(in) :: e (n) array of energies in mev real(kind=wp), intent(out) :: f (n) decadic logarithm of integral fluxes in\nparticles/(cm cm sec) integer, intent(in) :: n number of energies Calls proc~~trara1~~CallsGraph proc~trara1 trmfun_module::trm_type%trara1 proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~trara1~~CalledByGraph proc~trara1 trmfun_module::trm_type%trara1 proc~aep8 trmfun_module::trm_type%aep8 proc~aep8->proc~trara1 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine trara1 ( me , descr , map , fl , bb0 , e , f , n ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: n !! number of energies integer , intent ( in ) :: descr ( 8 ) !! header of specified trapped radition model real ( wp ), intent ( in ) :: e ( n ) !! array of energies in mev real ( wp ), intent ( in ) :: fl !! l-value real ( wp ), intent ( in ) :: bb0 !! =b/b0 magnetic field strength normalized !! to field strength at magnetic equator integer , intent ( in ) :: map ( * ) !! map of trapped radition model !! (descr and map are explained at the begin !! of the main program model) real ( wp ), intent ( out ) :: f ( n ) !! decadic logarithm of integral fluxes in !! particles/(cm*cm*sec) real ( wp ) :: e0 , e1 , e2 , escale , f0 , fscale , xnl real ( wp ) :: bb0_ !! local copy of `bb0`. in the original code !! this was modified by this routine. !! added this so `bb0` could be `intent(in)` integer :: i0 , i1 , i2 , i3 , ie , l3 , nb , nl logical :: s0 , s1 , s2 e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings i0 = 0 ! to avoid -Wmaybe-uninitialized warnings s0 = . false . ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW bb0_ = bb0 me % fistep = descr ( 7 ) / descr ( 2 ) escale = descr ( 4 ) fscale = descr ( 7 ) xnl = min ( 1 5.6_wp , abs ( fl )) nl = int ( xnl * descr ( 5 )) if ( bb0_ < 1.0_wp ) bb0_ = 1.0_wp nb = int (( bb0_ - 1.0_wp ) * descr ( 6 )) ! i2 is the number of elements in the flux map for the first energy. ! i3 is the index of the last element of the second energy map. ! l3 is the length of the map for the third energy. ! e1 is the energy of the first energy map (unscaled) ! e2 is the energy of the second energy map (unscaled) i1 = 0 i2 = map ( 1 ) i3 = i2 + map ( i2 + 1 ) l3 = map ( i3 + 1 ) e1 = map ( i1 + 2 ) / escale e2 = map ( i2 + 2 ) / escale ! s0, s1, s2 are logical variables which indicate whether the flux for ! a particular e, b, l point has already been found in a previous call ! to function trara2. if not, s.. =.true. s1 = . true . s2 = . true . ! energy loop do ie = 1 , n ! for each energy e(i) find the successive energies e0,e1,e2 in ! model map, which obey e0 < e1 < e(i) < e2 . do while ( ( e ( ie ) > e2 ) . and . ( l3 /= 0 ) ) i0 = i1 i1 = i2 i2 = i3 i3 = i3 + l3 l3 = map ( i3 + 1 ) e0 = e1 e1 = e2 e2 = map ( i2 + 2 ) / escale s0 = s1 s1 = s2 s2 = . true . f0 = me % f1 me % f1 = me % f2 enddo ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0- ! space to find fluxes f1,f2 [if they have not already been ! calculated for a previous e(i)]. if ( s1 ) me % f1 = me % trara2 ( map ( i1 + 3 ), nl , nb ) / fscale if ( s2 ) me % f2 = me % trara2 ( map ( i2 + 3 ), nl , nb ) / fscale s1 = . false . s2 = . false . ! finally, interpolate in energy. f ( ie ) = me % f1 + ( me % f2 - me % f1 ) * ( e ( ie ) - e1 ) / ( e2 - e1 ) if ( me % f2 <= 0.0_wp ) then if ( i1 /= 0 ) then ! --------- special interpolation --------------------------------- ! if the flux for the second energy cannot be found (i.e. f2=0.0), ! and the zeroth energy map has been defined (i.e. i1 not equal 0), ! then interpolate using the flux maps for the zeroth and first ! energy and choose the minimum of this interpolations and the ! interpolation that was done with f2=0. if ( s0 ) f0 = me % trara2 ( map ( i0 + 3 ), nl , nb ) / fscale s0 = . false . f ( ie ) = min ( f ( ie ), f0 + ( me % f1 - f0 ) * ( e ( ie ) - e0 ) / ( e1 - e0 )) endif endif ! the logarithmic flux is always kept greater or equal zero. f ( ie ) = max ( f ( ie ), 0.0_wp ) enddo end subroutine trara1","tags":"","loc":"proc/trara1.html"},{"title":"get_data_file_dir – radbelt","text":"private function get_data_file_dir(me) result(dir) Get the directory containing the data files. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(in) :: me Return Value character(len=:), allocatable Called by proc~~get_data_file_dir~2~~CalledByGraph proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~get_data_file_dir~2 proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_data_file_dir ( me ) result ( dir ) class ( shellig_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % igrf_dir )) then dir = trim ( me % igrf_dir ) // '/' else dir = 'data/igrf/' ! default end if end function get_data_file_dir","tags":"","loc":"proc/get_data_file_dir~2.html"},{"title":"geo_to_cart – radbelt","text":"private pure function geo_to_cart(glat, glon, alt) result(x) geodetic to scaled cartesian coordinates Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level Return Value real(kind=wp), dimension(3) cartesian coordinates in earth radii (6371.2 km) x-axis pointing to equator at 0 longitude y-axis pointing to equator at 90 long. z-axis pointing to north pole Called by proc~~geo_to_cart~~CalledByGraph proc~geo_to_cart shellig_module::geo_to_cart proc~shellg shellig_module::shellig_type%shellg proc~shellg->proc~geo_to_cart proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~shellg proc~shellc shellig_module::shellig_type%shellc proc~shellc->proc~shellg proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~shellc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function geo_to_cart ( glat , glon , alt ) result ( x ) real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), dimension ( 3 ) :: x !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ) :: rlat !! latitude in radians real ( wp ) :: rlon !! longitude in radians real ( wp ) :: d , rho ! deg to radians: rlat = glat * umr rlon = glon * umr ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code associate ( ct => sin ( rlat ), st => cos ( rlat ), cp => cos ( rlon ), sp => sin ( rlon )) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rho = ( alt + aquad / d ) * st / era x = [ rho * cp , rho * sp , ( alt + bquad / d ) * ct / era ] end associate end function geo_to_cart","tags":"","loc":"proc/geo_to_cart.html"},{"title":"destroy_shellig_type – radbelt","text":"private subroutine destroy_shellig_type(me) Destroy a shellig_type . Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(out) :: me Source Code subroutine destroy_shellig_type ( me ) class ( shellig_type ), intent ( out ) :: me end subroutine destroy_shellig_type","tags":"","loc":"proc/destroy_shellig_type.html"},{"title":"set_data_file_dir – radbelt","text":"private subroutine set_data_file_dir(me, dir) Set the directory containing the data files. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me character(len=*), intent(in) :: dir Called by proc~~set_data_file_dir~2~~CalledByGraph proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_igrf_file_path->proc~set_data_file_dir~2 proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_igrf_file_path proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~set_igrf_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_file_dir ( me , dir ) class ( shellig_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % igrf_dir = trim ( dir ) end subroutine set_data_file_dir","tags":"","loc":"proc/set_data_file_dir~2.html"},{"title":"igrf – radbelt","text":"private subroutine igrf(me, lon, lat, height, year, xl, bbx) Wrapper for IGRF functions. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio Calls proc~~igrf~~CallsGraph proc~igrf shellig_module::shellig_type%igrf proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~igrf~~CalledByGraph proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine igrf ( me , lon , lat , height , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , babs , bdel , bdown , beast , & beq , bequ , bnorth , dimo , rr0 integer :: icode logical :: val real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldg ( lat , lon , height , bnorth , beast , bdown , babs ) call me % shellg ( lat , lon , height , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq endif bbx = babs / bequ end subroutine igrf","tags":"","loc":"proc/igrf.html"},{"title":"igrfc – radbelt","text":"private subroutine igrfc(me, v, year, xl, bbx) Alternate version of igrf for cartesian coordinates. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio Calls proc~~igrfc~~CallsGraph proc~igrfc shellig_module::shellig_type%igrfc proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~feldcof shellig_module::shellig_type%feldcof proc~igrfc->proc~feldcof proc~findb0 shellig_module::shellig_type%findb0 proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellc->proc~shellg proc~shellg->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~igrfc~~CalledByGraph proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine igrfc ( me , v , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , bdel , beq , bequ , dimo , rr0 integer :: icode logical :: val real ( wp ), dimension ( 3 ) :: b real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldc ( v , b ) call me % shellc ( v , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq endif bbx = norm2 ( b ) / bequ end subroutine igrfc","tags":"","loc":"proc/igrfc.html"},{"title":"findb0 – radbelt","text":"private subroutine findb0(me, stps, bdel, value, bequ, rr0) Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: stps real(kind=wp), intent(inout) :: bdel logical, intent(out) :: value real(kind=wp), intent(out) :: bequ real(kind=wp), intent(out) :: rr0 Calls proc~~findb0~~CallsGraph proc~findb0 shellig_module::shellig_type%findb0 proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~findb0~~CalledByGraph proc~findb0 shellig_module::shellig_type%findb0 proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~findb0 proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~findb0 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine findb0 ( me , stps , bdel , value , bequ , rr0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: stps real ( wp ), intent ( inout ) :: bdel real ( wp ), intent ( out ) :: bequ logical , intent ( out ) :: value real ( wp ), intent ( out ) :: rr0 real ( wp ) :: b , bdelta , bmin , bold , bq1 , & bq2 , bq3 , p ( 8 , 4 ) , r1 , r2 , r3 , & rold , step , step12 , zz integer :: i , irun , j , n step = stps irun = 0 rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings main : do irun = irun + 1 if ( irun > 5 ) then value = . false . exit main endif ! first three points p ( 1 , 2 ) = me % sp ( 1 ) p ( 2 , 2 ) = me % sp ( 2 ) p ( 3 , 2 ) = me % sp ( 3 ) step =- sign ( step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then step =- step r3 = r1 bq3 = bq1 do i = 1 , 5 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz end do end if ! initialization step12 = step / 1 2.0_wp value = . true . bmin = 1.0e4_wp bold = 1.0e4_wp ! corrector (field line tracing) n = 0 corrector : do p ( 1 , 3 ) = p ( 1 , 2 ) + step12 * ( 5.0_wp * p ( 4 , 3 ) + 8.0_wp * p ( 4 , 2 ) - p ( 4 , 1 )) n = n + 1 p ( 2 , 3 ) = p ( 2 , 2 ) + step12 * ( 5.0_wp * p ( 5 , 3 ) + 8.0_wp * p ( 5 , 2 ) - p ( 5 , 1 )) ! predictor (field line tracing) p ( 1 , 4 ) = p ( 1 , 3 ) + step12 * ( 2 3.0_wp * p ( 4 , 3 ) - 1 6.0_wp * p ( 4 , 2 ) + 5.0_wp * p ( 4 , 1 )) p ( 2 , 4 ) = p ( 2 , 3 ) + step12 * ( 2 3.0_wp * p ( 5 , 3 ) - 1 6.0_wp * p ( 5 , 2 ) + 5.0_wp * p ( 5 , 1 )) p ( 3 , 4 ) = p ( 3 , 3 ) + step call me % stoer ( p ( 1 , 4 ), bq3 , r3 ) do j = 1 , 3 do i = 1 , 8 p ( i , j ) = p ( i , j + 1 ) end do end do b = sqrt ( bq3 ) if ( b < bmin ) bmin = b if ( b > bold ) exit corrector bold = b rold = 1.0_wp / r3 me % sp ( 1 ) = p ( 1 , 4 ) me % sp ( 2 ) = p ( 2 , 4 ) me % sp ( 3 ) = p ( 3 , 4 ) end do corrector if ( bold /= bmin ) value = . false . bdelta = ( b - bold ) / bold if ( bdelta <= bdel ) exit main step = step / 1 0.0_wp end do main rr0 = rold bequ = bold bdel = bdelta end subroutine findb0","tags":"","loc":"proc/findb0.html"},{"title":"shellc – radbelt","text":"private subroutine shellc(me, v, dimo, fl, icode, b0) Wrapper to shellg to be used with cartesian coordinates. Note In the original code, this was an ENTRY point in shellg and didn't\n include all the outputs. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\n* x-axis pointing to equator at 0 longitude\n* y-axis pointing to equator at 90 long.\n* z-axis pointing to north pole real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode =1 normal completion =2 unphysical conjugate point (fl meaningless) =3 shell parameter greater than limit up to\n which accurate calculation is required;\n approximation is used. real(kind=wp), intent(out) :: b0 magnetic field strength in gauss Calls proc~~shellc~~CallsGraph proc~shellc shellig_module::shellig_type%shellc proc~shellg shellig_module::shellig_type%shellg proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~stoer shellig_module::shellig_type%stoer proc~shellg->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~shellc~~CalledByGraph proc~shellc shellig_module::shellig_type%shellc proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~shellc proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine shellc ( me , v , dimo , fl , icode , b0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ) :: glat , glon , alt !! not used call me % shellg ( glat , glon , alt , dimo , fl , icode , b0 , v ) end subroutine shellc","tags":"","loc":"proc/shellc.html"},{"title":"shellg – radbelt","text":"private subroutine shellg(me, glat, glon, alt, dimo, fl, icode, b0, v) calculates l-value for specified geodaetic coordinates, altitude\n and gemagnetic field model. Reference G. KLUGE, EUROPEAN SPACE OPERATIONS CENTER, INTERNAL NOTE\n NO. 67, 1970. G. KLUGE, COMPUTER PHYSICS COMMUNICATIONS 3, 31-35, 1972 History CHANGES (D. BILITZA, NOV 87): USING CORRECT DIPOL MOMENT I.E.,DIFFERENT COMMON/MODEL/ USING IGRF EARTH MAGNETIC FIELD MODELS FROM 1945 TO 1990 Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode =1 normal completion =2 unphysical conjugate point (fl meaningless) =3 shell parameter greater than limit up to\n which accurate calculation is required;\n approximation is used. real(kind=wp), intent(out) :: b0 magnetic field strength in gauss real(kind=wp), intent(in), optional, dimension(3) :: v cartesian coordinates in earth radii (6371.2 km) x-axis pointing to equator at 0 longitude y-axis pointing to equator at 90 long. z-axis pointing to north pole If this argument is present, it is used\ninstead of glat,glon,alt. See shellc . Calls proc~~shellg~~CallsGraph proc~shellg shellig_module::shellig_type%shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~stoer shellig_module::shellig_type%stoer proc~shellg->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~shellg~~CalledByGraph proc~shellg shellig_module::shellig_type%shellg proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~shellg proc~shellc shellig_module::shellig_type%shellc proc~shellc->proc~shellg proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~shellc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine shellg ( me , glat , glon , alt , dimo , fl , icode , b0 , v ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ), dimension ( 3 ), intent ( in ), optional :: v !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole !! !! If this argument is present, it is used !! instead of glat,glon,alt. See [[shellc]]. real ( wp ) :: arg1 , arg2 , bequ , bq1 , bq2 , bq3 , c0 , c1 , c2 , c3 , & d0 , d1 , d2 , dimob0 , e0 , e1 , e2 , ff , fi , gg , & hli , oradik , oterm , r , r1 , r2 , r3 , r3h , radik , & rq , step12 , step2 , stp , t , term , xx , z , zq , zz integer :: i , iequ , n real ( wp ), parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3` real ( wp ), parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3` if (. not . allocated ( me % p )) allocate ( me % p ( 8 , max_loop_index + 1 )) ! because `p(:,n+1)` in the loop bequ = 1.0e10_wp if ( present ( v )) then me % xi ( 1 ) = v ( 1 ) me % xi ( 2 ) = v ( 2 ) me % xi ( 3 ) = v ( 3 ) else me % xi = geo_to_cart ( glat , glon , alt ) end if associate ( p => me % p ) ! convert to dipol-oriented co-ordinates rq = 1.0_wp / ( me % xi ( 1 ) * me % xi ( 1 ) + me % xi ( 2 ) * me % xi ( 2 ) + me % xi ( 3 ) * me % xi ( 3 )) r3h = sqrt ( rq * sqrt ( rq )) p ( 1 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 1 ) + me % xi ( 2 ) * u ( 2 , 1 ) + me % xi ( 3 ) * u ( 3 , 1 )) * r3h p ( 2 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 2 ) + me % xi ( 2 ) * u ( 2 , 2 )) * r3h p ( 3 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 3 ) + me % xi ( 2 ) * u ( 2 , 3 ) + me % xi ( 3 ) * u ( 3 , 3 )) * rq ! first three points of field line me % step = - sign ( me % step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) b0 = sqrt ( bq2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * me % step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * me % step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - me % step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - me % step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - me % step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + me % step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + me % step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then me % step = - me % step r3 = r1 bq3 = bq1 do i = 1 , 7 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz enddo endif ! search for lowest magnetic field strength if ( bq1 < bequ ) then bequ = bq1 iequ = 1 endif if ( bq2 < bequ ) then bequ = bq2 iequ = 2 endif if ( bq3 < bequ ) then bequ = bq3 iequ = 3 endif ! initialization of integration loops step12 = me % step / 1 2.0_wp step2 = me % step + me % step me % steq = sign ( me % steq , me % step ) fi = 0.0_wp icode = 1 oradik = 0.0_wp oterm = 0.0_wp stp = r2 * me % steq z = p ( 3 , 2 ) + stp stp = stp / 0.75_wp p ( 8 , 1 ) = step2 * ( p ( 1 , 1 ) * p ( 4 , 1 ) + p ( 2 , 1 ) * p ( 5 , 1 )) p ( 8 , 2 ) = step2 * ( p ( 1 , 2 ) * p ( 4 , 2 ) + p ( 2 , 2 ) * p ( 5 , 2 )) ! main loop (field line tracing) main : do n = 3 , max_loop_index ! corrector (field line tracing) p ( 1 , n ) = p ( 1 , n - 1 ) + step12 * ( 5.0_wp * p ( 4 , n ) + 8.0_wp * p ( 4 , n - 1 ) - p ( 4 , n - 2 )) p ( 2 , n ) = p ( 2 , n - 1 ) + step12 * ( 5.0_wp * p ( 5 , n ) + 8.0_wp * p ( 5 , n - 1 ) - p ( 5 , n - 2 )) ! prepare expansion coefficients for interpolation ! of slowly varying quantities p ( 8 , n ) = step2 * ( p ( 1 , n ) * p ( 4 , n ) + p ( 2 , n ) * p ( 5 , n )) c0 = p ( 1 , n - 1 ) ** 2 + p ( 2 , n - 1 ) ** 2 c1 = p ( 8 , n - 1 ) c2 = ( p ( 8 , n ) - p ( 8 , n - 2 )) * 0.25_wp c3 = ( p ( 8 , n ) + p ( 8 , n - 2 ) - c1 - c1 ) / 6.0_wp d0 = p ( 6 , n - 1 ) d1 = ( p ( 6 , n ) - p ( 6 , n - 2 )) * 0.5_wp d2 = ( p ( 6 , n ) + p ( 6 , n - 2 ) - d0 - d0 ) * 0.5_wp e0 = p ( 7 , n - 1 ) e1 = ( p ( 7 , n ) - p ( 7 , n - 2 )) * 0.5_wp e2 = ( p ( 7 , n ) + p ( 7 , n - 2 ) - e0 - e0 ) * 0.5_wp inner : do ! inner loop (for quadrature) t = ( z - p ( 3 , n - 1 )) / me % step if ( t > 1.0_wp ) then ! predictor (field line tracing) p ( 1 , n + 1 ) = p ( 1 , n ) + step12 * ( 2 3.0_wp * p ( 4 , n ) - 1 6.0_wp * p ( 4 , n - 1 ) + 5.0_wp * p ( 4 , n - 2 )) p ( 2 , n + 1 ) = p ( 2 , n ) + step12 * ( 2 3.0_wp * p ( 5 , n ) - 1 6.0_wp * p ( 5 , n - 1 ) + 5.0_wp * p ( 5 , n - 2 )) p ( 3 , n + 1 ) = p ( 3 , n ) + me % step call me % stoer ( p ( 1 , n + 1 ), bq3 , r3 ) ! search for lowest magnetic field strength if ( bq3 < bequ ) then iequ = n + 1 bequ = bq3 endif exit inner else hli = 0.5_wp * ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) zq = z * z r = hli + sqrt ( hli * hli + zq ) if ( r <= rmin ) then ! approximation for high values of l. icode = 3 t = - p ( 3 , n - 1 ) / me % step fl = 1.0_wp / ( abs ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) + 1.0e-15_wp ) return endif rq = r * r ff = sqrt ( 1.0_wp + 3.0_wp * zq / rq ) radik = b0 - (( d2 * t + d1 ) * t + d0 ) * r * rq * ff if ( r > rmax ) then icode = 2 radik = radik - 1 2.0_wp * ( r - rmax ) ** 2 endif if ( radik + radik <= oradik ) exit main term = sqrt ( radik ) * ff * (( e2 * t + e1 ) * t + e0 ) / ( rq + zq ) fi = fi + stp * ( oterm + term ) oradik = radik oterm = term stp = r * me % steq z = z + stp endif enddo inner enddo main if ( iequ < 2 ) iequ = 2 me % sp ( 1 ) = p ( 1 , iequ - 1 ) me % sp ( 2 ) = p ( 2 , iequ - 1 ) me % sp ( 3 ) = p ( 3 , iequ - 1 ) if ( oradik >= 1.0e-15_wp ) fi = fi + stp / 0.75_wp * oterm * oradik / ( oradik - radik ) ! the minimal allowable value of fi was changed from 1e-15 to 1e-12, ! because 1e-38 is the minimal allowable arg. for alog in our envir. ! d. bilitza, nov 87. fi = 0.5_wp * abs ( fi ) / sqrt ( b0 ) + 1.0e-12_wp ! compute l from b and i. same as carmel in invar. ! correct dipole moment is used here. d. bilitza, nov 87. dimob0 = dimo / b0 arg1 = log ( fi ) arg2 = log ( dimob0 ) ! arg = fi*fi*fi/dimob0 ! if(abs(arg)>88.0_wp) arg=88.0_wp xx = 3 * arg1 - arg2 if ( xx > 2 3.0_wp ) then gg = xx - 3.0460681_wp elseif ( xx > 1 1.7_wp ) then gg = ((((( 2.8212095e-8_wp * xx - 3.8049276e-6_wp ) * xx + & 2.170224e-4_wp ) * xx - 6.7310339e-3_wp ) * xx + & 1.2038224e-1_wp ) * xx - 1.8461796e-1_wp ) * xx + 2.0007187_wp elseif ( xx >+ 3.0_wp ) then gg = (((((((( 6.3271665e-10_wp * xx - 3.958306e-8_wp ) * xx + & 9.9766148e-07_wp ) * xx - 1.2531932e-5_wp ) * xx + & 7.9451313e-5_wp ) * xx - 3.2077032e-4_wp ) * xx + & 2.1680398e-3_wp ) * xx + 1.2817956e-2_wp ) * xx + & 4.3510529e-1_wp ) * xx + 6.222355e-1_wp elseif ( xx >- 3.0_wp ) then gg = (((((((( 2.6047023e-10_wp * xx + 2.3028767e-9_wp ) * xx - & 2.1997983e-8_wp ) * xx - 5.3977642e-7_wp ) * xx - & 3.3408822e-6_wp ) * xx + 3.8379917e-5_wp ) * xx + & 1.1784234e-3_wp ) * xx + 1.4492441e-2_wp ) * xx + & 4.3352788e-1_wp ) * xx + 6.228644e-1_wp elseif ( xx >- 2 2.0_wp ) then gg = (((((((( - 8.1537735e-14_wp * xx + 8.3232531e-13_wp ) * xx + & 1.0066362e-9_wp ) * xx + 8.1048663e-8_wp ) * xx + & 3.2916354e-6_wp ) * xx + 8.2711096e-5_wp ) * xx + & 1.3714667e-3_wp ) * xx + 1.5017245e-2_wp ) * xx + & 4.3432642e-1_wp ) * xx + 6.2337691e-1_wp else gg = 3.33338e-1_wp * xx + 3.0062102e-1_wp endif fl = exp ( log (( 1.0_wp + exp ( gg )) * dimob0 ) / 3.0_wp ) end associate end subroutine shellg","tags":"","loc":"proc/shellg.html"},{"title":"stoer – radbelt","text":"private subroutine stoer(me, p, bq, r) subroutine used for field line tracing in shellg .\ncalls entry point feldi in geomagnetic field subroutine feldg Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(inout), dimension(7) :: p real(kind=wp), intent(out) :: bq real(kind=wp), intent(out) :: r Calls proc~~stoer~~CallsGraph proc~stoer shellig_module::shellig_type%stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~stoer~~CalledByGraph proc~stoer shellig_module::shellig_type%stoer proc~findb0 shellig_module::shellig_type%findb0 proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellg->proc~stoer proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~findb0 proc~igrf->proc~shellg proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~shellc->proc~shellg proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine stoer ( me , p , bq , r ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 7 ), intent ( inout ) :: p real ( wp ), intent ( out ) :: bq real ( wp ), intent ( out ) :: r real ( wp ) :: dr , dsq , dx , dxm , dy , dym , dz , & dzm , fli , q , rq , wr , xm , ym , zm ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates zm = P ( 3 ) fli = P ( 1 ) * P ( 1 ) + P ( 2 ) * P ( 2 ) + 1.0e-15_wp R = 0.5_wp * ( fli + sqrt ( fli * fli + ( zm + zm ) ** 2 )) rq = R * R wr = sqrt ( R ) xm = P ( 1 ) * wr ym = P ( 2 ) * wr ! transform to geographic co-ordinate system me % Xi ( 1 ) = xm * u ( 1 , 1 ) + ym * u ( 1 , 2 ) + zm * u ( 1 , 3 ) me % Xi ( 2 ) = xm * u ( 2 , 1 ) + ym * u ( 2 , 2 ) + zm * u ( 2 , 3 ) me % Xi ( 3 ) = xm * u ( 3 , 1 ) + zm * u ( 3 , 3 ) ! compute derivatives ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results ! are the same; dkb Feb 1998. ! JW : feb 2024 : xi, h now class variables. call me % feldi () q = me % H ( 1 ) / rq dx = me % H ( 3 ) + me % H ( 3 ) + q * me % Xi ( 1 ) dy = me % H ( 4 ) + me % H ( 4 ) + q * me % Xi ( 2 ) dz = me % H ( 2 ) + me % H ( 2 ) + q * me % Xi ( 3 ) ! transform back to geomagnetic co-ordinate system dxm = u ( 1 , 1 ) * dx + u ( 2 , 1 ) * dy + u ( 3 , 1 ) * dz dym = u ( 1 , 2 ) * dx + u ( 2 , 2 ) * dy dzm = u ( 1 , 3 ) * dx + u ( 2 , 3 ) * dy + u ( 3 , 3 ) * dz dr = ( xm * dxm + ym * dym + zm * dzm ) / R ! form slowly varying expressions P ( 4 ) = ( wr * dxm - 0.5_wp * P ( 1 ) * dr ) / ( R * dzm ) P ( 5 ) = ( wr * dym - 0.5_wp * P ( 2 ) * dr ) / ( R * dzm ) dsq = rq * ( dxm * dxm + dym * dym + dzm * dzm ) Bq = dsq * rq * rq P ( 6 ) = sqrt ( dsq / ( rq + 3.0_wp * zm * zm )) P ( 7 ) = P ( 6 ) * ( rq + zm * zm ) / ( rq * dzm ) end subroutine stoer","tags":"","loc":"proc/stoer.html"},{"title":"feldg – radbelt","text":"private subroutine feldg(me, glat, glon, alt, bnorth, beast, bdown, Babs) Calculates earth magnetic field from spherical harmonics model Reference ref: g. kluge, european space operations centre, internal note 61,\n 1970. History changes (d. bilitza, nov 87): field coefficients in binary data files instead of block data calculates dipol moment Note In the original code, [[feldc] and feldi were\n ENTRY points to this routine Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(out) :: bnorth components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: beast components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: bdown components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: Babs magnetic field strength in gauss Called by proc~~feldg~~CalledByGraph proc~feldg shellig_module::shellig_type%feldg proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldg proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldg ( me , glat , glon , alt , bnorth , beast , bdown , babs ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( out ) :: bnorth , beast , bdown !! components of the field with respect !! to the local geodetic coordinate system, with axis !! pointing in the tangential plane to the north, east !! and downward. real ( wp ), intent ( out ) :: Babs !! magnetic field strength in gauss real ( wp ) :: brho , bxxx , byyy , bzzz , cp , ct , d , f , rho , & rlat , rlon , rq , s , sp , st , t , & x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m ! same calculation as geo_to_cart, but not used here ! because the intermediate variables are also used below. rlat = glat * umr ct = sin ( rlat ) st = cos ( rlat ) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rlon = glon * umr cp = cos ( rlon ) sp = sin ( rlon ) zzz = ( alt + bquad / d ) * ct / era rho = ( alt + aquad / d ) * st / era xxx = rho * cp yyy = rho * sp rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) bxxx = t * ( me % h ( 3 ) - s * xxx ) byyy = t * ( me % h ( 4 ) - s * yyy ) bzzz = t * ( me % h ( 2 ) - s * zzz ) babs = sqrt ( bxxx * bxxx + byyy * byyy + bzzz * bzzz ) beast = byyy * cp - bxxx * sp brho = byyy * sp + bxxx * cp bnorth = bzzz * st - brho * ct bdown =- bzzz * ct - brho * st end subroutine feldg","tags":"","loc":"proc/feldg.html"},{"title":"feldc – radbelt","text":"private subroutine feldc(me, v, b) Alternate version of feldg to be used with cartesian coordinates Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(out) :: b (3) field components Called by proc~~feldc~~CalledByGraph proc~feldc shellig_module::shellig_type%feldc proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldc proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldc ( me , v , b ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( out ) :: b ( 3 ) !! field components real ( wp ) :: f , rq , s , t , x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m xxx = v ( 1 ) yyy = v ( 2 ) zzz = v ( 3 ) rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) b ( 1 ) = t * ( me % h ( 3 ) - s * xxx ) b ( 2 ) = t * ( me % h ( 4 ) - s * yyy ) b ( 3 ) = t * ( me % h ( 2 ) - s * zzz ) end subroutine feldc","tags":"","loc":"proc/feldc.html"},{"title":"feldi – radbelt","text":"private subroutine feldi(me) Used for l computation. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me Called by proc~~feldi~~CalledByGraph proc~feldi shellig_module::shellig_type%feldi proc~stoer shellig_module::shellig_type%stoer proc~stoer->proc~feldi proc~findb0 shellig_module::shellig_type%findb0 proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellg->proc~stoer proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~findb0 proc~igrf->proc~shellg proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~shellc->proc~shellg proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldi ( me ) class ( shellig_type ), intent ( inout ) :: me real ( wp ) :: f , x , y , z integer :: i , ih , ihmax , il , imax , k , last , m ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do end subroutine feldi","tags":"","loc":"proc/feldi.html"},{"title":"feldcof – radbelt","text":"private subroutine feldcof(me, year, dimo) Determines coefficients and dipol moment from IGRF models Author D. BILITZA, NSSDC, GSFC, CODE 633, GREENBELT, MD 20771,\n (301) 286-9536 NOV 1987. History corrected for 2000 update - dkb- 5/31/2000 updated to IGRF-2000 version -dkb- 5/31/2000 updated to IGRF-2005 version -dkb- 3/24/2000 Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: dimo geomagnetic dipol moment in gauss (normalized\nto earth's radius) at the time (year) Calls proc~~feldcof~~CallsGraph proc~feldcof shellig_module::shellig_type%feldcof proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~feldcof~~CalledByGraph proc~feldcof shellig_module::shellig_type%feldcof proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldcof ( me , year , dimo ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: dimo !! geomagnetic dipol moment in gauss (normalized !! to earth's radius) at the time (year) real ( wp ) :: dte1 , dte2 , erad , gha ( 144 ) , sqrt2 integer :: i , ier , j , l , m , n , iyea character ( len = :), allocatable :: fil2 real ( wp ) :: x , f0 , f !! these were double precision in original !! code while everything else was single precision ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1 character ( len = filename_len ), dimension ( 17 ), parameter :: filmod = [& 'dgrf1945.dat ' , 'dgrf1950.dat ' , 'dgrf1955.dat ' , 'dgrf1960.dat ' , & 'dgrf1965.dat ' , 'dgrf1970.dat ' , 'dgrf1975.dat ' , 'dgrf1980.dat ' , & 'dgrf1985.dat ' , 'dgrf1990.dat ' , 'dgrf1995.dat ' , 'dgrf2000.dat ' , & 'dgrf2005.dat ' , 'dgrf2010.dat ' , 'dgrf2015.dat ' , 'igrf2020.dat ' , & 'igrf2020s.dat' ] real ( wp ), dimension ( 17 ), parameter :: dtemod = [ 194 5.0_wp , 195 0.0_wp , 195 5.0_wp , & 196 0.0_wp , 196 5.0_wp , 197 0.0_wp , & 197 5.0_wp , 198 0.0_wp , 198 5.0_wp , & 199 0.0_wp , 199 5.0_wp , 200 0.0_wp , & 200 5.0_wp , 201 0.0_wp , 201 5.0_wp , & 202 0.0_wp , 202 5.0_wp ] integer , parameter :: numye = size ( dtemod ) - 1 ! number of 5-year priods represented by IGRF integer , parameter :: is = 0 !! * is=0 for schmidt normalization !! * is=1 gauss normalization logical :: read_file !-- determine igrf-years for input-year me % time = year iyea = int ( year / 5.0_wp ) * 5 read_file = iyea /= me % iyea ! if we have to read the file me % iyea = iyea l = ( me % iyea - 1945 ) / 5 + 1 if ( l < 1 ) l = 1 if ( l > numye ) l = numye dte1 = dtemod ( l ) me % name = me % get_data_file_dir () // trim ( filmod ( l )) dte2 = dtemod ( l + 1 ) fil2 = me % get_data_file_dir () // trim ( filmod ( l + 1 )) if ( read_file ) then ! get igrf coefficients for the boundary years ! [if they have not ready been loaded] call getshc ( me % name , me % nmax1 , erad , me % g , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( me % name ) me % g_cache = me % g ! because it is modified below, we have to cache the original values from the file call getshc ( fil2 , me % nmax2 , erad , me % gh2 , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( fil2 ) else me % g = me % g_cache end if !-- determine igrf coefficients for year if ( l <= numye - 1 ) then call intershc ( year , dte1 , me % nmax1 , me % g , dte2 , me % nmax2 , me % gh2 , me % nmax , gha ) else call extrashc ( year , dte1 , me % nmax1 , me % g , me % nmax2 , me % gh2 , me % nmax , gha ) endif !-- determine magnetic dipol moment and coeffiecients g f0 = 0.0_wp do j = 1 , 3 f = gha ( j ) * 1.0e-5_wp f0 = f0 + f * f enddo dimo = sqrt ( f0 ) me % g ( 1 ) = 0.0_wp i = 2 f0 = 1.0e-5_wp if ( is == 0 ) f0 = - f0 sqrt2 = sqrt ( 2.0_wp ) do n = 1 , me % nmax x = n f0 = f0 * x * x / ( 4.0_wp * x - 2.0_wp ) if ( is == 0 ) f0 = f0 * ( 2.0_wp * x - 1.0_wp ) / x f = f0 * 0.5_wp if ( is == 0 ) f = f * sqrt2 me % g ( i ) = gha ( i - 1 ) * f0 i = i + 1 do m = 1 , n f = f * ( x + m ) / ( x - m + 1.0_wp ) if ( is == 0 ) f = f * sqrt (( x - m + 1.0_wp ) / ( x + m )) me % g ( i ) = gha ( i - 1 ) * f me % g ( i + 1 ) = gha ( i ) * f i = i + 2 enddo enddo end subroutine feldcof","tags":"","loc":"proc/feldcof.html"},{"title":"getshc – radbelt","text":"private subroutine getshc(Fspec, Nmax, Erad, Gh, Ier) Reads spherical harmonic coefficients from the specified\n file into an array. Author Version 1.01, A. Zunde, USGS, MS 964,\n Box 25046 Federal Center, Denver, CO 80225 Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: Fspec File specification integer, intent(out) :: Nmax Maximum degree and order of model real(kind=wp), intent(out) :: Erad Earth's radius associated with the spherical\nharmonic coefficients, in the same units as\nelevation real(kind=wp), intent(out), dimension(*) :: Gh Schmidt quasi-normal internal spherical\nharmonic coefficients integer, intent(out) :: Ier Error number: 0, no error -2, records out of order FORTRAN run-time error number Called by proc~~getshc~~CalledByGraph proc~getshc shellig_module::getshc proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~getshc proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine getshc ( Fspec , Nmax , Erad , Gh , Ier ) character ( len =* ), intent ( in ) :: Fspec !! File specification integer , intent ( out ) :: Nmax !! Maximum degree and order of model real ( wp ), intent ( out ) :: Erad !! Earth's radius associated with the spherical !! harmonic coefficients, in the same units as !! elevation real ( wp ), dimension ( * ), intent ( out ) :: Gh !! Schmidt quasi-normal internal spherical !! harmonic coefficients integer , intent ( out ) :: Ier !! Error number: !! !! * 0, no error !! * -2, records out of order !! * FORTRAN run-time error number integer :: iu !! logical unit number real ( wp ) :: g , h integer :: i , m , mm , n , nn read_file : block ! --------------------------------------------------------------- ! Open coefficient file. Read past first header record. ! Read degree and order of model and Earth's radius. ! --------------------------------------------------------------- OPEN ( newunit = Iu , FILE = Fspec , STATUS = 'OLD' , IOSTAT = Ier ) if ( Ier /= 0 ) then write ( * , * ) 'Error opening file: ' // trim ( fspec ) exit read_file end if READ ( Iu , * , IOSTAT = Ier ) if ( Ier /= 0 ) exit read_file READ ( Iu , * , IOSTAT = Ier ) Nmax , Erad if ( Ier /= 0 ) exit read_file ! --------------------------------------------------------------- ! Read the coefficient file, arranged as follows: ! ! N M G H ! ---------------------- ! / 1 0 GH(1) - ! / 1 1 GH(2) GH(3) ! / 2 0 GH(4) - ! / 2 1 GH(5) GH(6) ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8) ! records \\ 3 0 GH(9) - ! \\ . . . . ! \\ . . . . ! NMAX*(NMAX+2) \\ . . . . ! elements in GH \\ NMAX NMAX . . ! ! N and M are, respectively, the degree and order of the ! coefficient. ! --------------------------------------------------------------- i = 0 main : DO nn = 1 , Nmax DO mm = 0 , nn READ ( Iu , * , IOSTAT = Ier ) n , m , g , h if ( Ier /= 0 ) exit main IF ( nn /= n . OR . mm /= m ) THEN Ier = - 2 EXIT main ENDIF i = i + 1 Gh ( i ) = g IF ( m /= 0 ) THEN i = i + 1 Gh ( i ) = h ENDIF ENDDO ENDDO main end block read_file CLOSE ( Iu ) END subroutine getshc","tags":"","loc":"proc/getshc.html"},{"title":"intershc – radbelt","text":"private subroutine intershc(date, dte1, nmax1, gh1, dte2, nmax2, gh2, nmax, gh) Interpolates linearly, in time, between two spherical\n harmonic models. The coefficients (GH) of the resulting model, at date\n DATE, are computed by linearly interpolating between the\n coefficients of the earlier model (GH1), at date DTE1,\n and those of the later model (GH2), at date DTE2. If one\n model is smaller than the other, the interpolation is\n performed with the missing coefficients assumed to be 0. Author Version 1.01, A. Zunde\n USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of earlier model integer, intent(in) :: nmax1 Maximum degree and order of earlier model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real(kind=wp), intent(in) :: dte2 Date of later model integer, intent(in) :: nmax2 Maximum degree and order of later model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of later model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model Called by proc~~intershc~~CalledByGraph proc~intershc shellig_module::intershc proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~intershc proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine intershc ( date , dte1 , nmax1 , gh1 , dte2 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of earlier model integer , intent ( in ) :: nmax1 !! Maximum degree and order of earlier model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real ( wp ), intent ( in ) :: dte2 !! Date of later model integer , intent ( in ) :: nmax2 !! Maximum degree and order of later model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) / ( dte2 - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) + factor * ( - gh1 ( i )) enddo nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) enddo nmax = nmax2 endif do i = 1 , k gh ( i ) = gh1 ( i ) + factor * ( gh2 ( i ) - gh1 ( i )) enddo end subroutine intershc","tags":"","loc":"proc/intershc.html"},{"title":"extrashc – radbelt","text":"private subroutine extrashc(date, dte1, nmax1, gh1, nmax2, gh2, nmax, gh) Extrapolates linearly a spherical harmonic model with a\n rate-of-change model. The coefficients (GH) of the resulting model, at date\n DATE, are computed by linearly extrapolating the coef-\n ficients of the base model (GH1), at date DTE1, using\n those of the rate-of-change model (GH2), at date DTE2. If\n one model is smaller than the other, the extrapolation is\n performed with the missing coefficients assumed to be 0. Author Version 1.01, A. Zunde\n USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of base model integer, intent(in) :: nmax1 Maximum degree and order of base model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of base model integer, intent(in) :: nmax2 Maximum degree and order of rate-of-change model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model Called by proc~~extrashc~~CalledByGraph proc~extrashc shellig_module::extrashc proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~extrashc proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine extrashc ( date , dte1 , nmax1 , gh1 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of base model integer , intent ( in ) :: nmax1 !! Maximum degree and order of base model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model integer , intent ( in ) :: nmax2 !! Maximum degree and order of rate-of-change model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) enddo nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) enddo nmax = nmax2 endif do i = 1 , k gh ( i ) = gh1 ( i ) + factor * gh2 ( i ) enddo end subroutine extrashc","tags":"","loc":"proc/extrashc.html"},{"title":"radbelt_c_module – radbelt","text":"Experimental C interface to the radbelt module. Uses radbelt_module iso_c_binding module~~radbelt_c_module~~UsesGraph module~radbelt_c_module radbelt_c_module iso_c_binding iso_c_binding module~radbelt_c_module->iso_c_binding module~radbelt_module radbelt_module module~radbelt_c_module->module~radbelt_module module~radbelt_kinds_module radbelt_kinds_module module~radbelt_module->module~radbelt_kinds_module module~shellig_module shellig_module module~radbelt_module->module~shellig_module module~trmfun_module trmfun_module module~radbelt_module->module~trmfun_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env module~shellig_module->module~radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Functions public function c2f_str (cstr) result(fstr) Convert C string to Fortran Arguments Type Intent Optional Attributes Name character(kind=c_char, len=1), intent(in), dimension(:) :: cstr string from C Return Value character(len=:), allocatable fortran string Subroutines public subroutine int_pointer_to_f_pointer (ipointer, p) Convert an integer pointer to a radbelt_type pointer. Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer integer pointer from C type( radbelt_type ), pointer :: p fortran pointer public subroutine initialize_c (ipointer) bind(C, name=\"initialize_c\") create a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(out) :: ipointer public subroutine destroy_c (ipointer) bind(C, name=\"destroy_c\") destroy a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer public subroutine set_trm_file_path_c (ipointer, aep8_dir, n) bind(C, name=\"set_trm_file_path_c\") C interface for setting the trm data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir integer(kind=c_int), intent(in) :: n size of aep8_dir public subroutine set_igrf_file_path_c (ipointer, igrf_dir, n) bind(C, name=\"set_igrf_file_path\") C interface for setting the igrf data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: igrf_dir integer(kind=c_int), intent(in) :: n size of igrf_dir public subroutine set_data_files_paths_c (ipointer, aep8_dir, igrf_dir, n, m) bind(C, name=\"set_data_files_paths_c\") C interface for setting the data file paths Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir character(kind=c_char, len=1), intent(in), dimension(m) :: igrf_dir integer(kind=c_int), intent(in) :: n size of aep8_dir integer(kind=c_int), intent(in) :: m size of igrf_dir public subroutine get_flux_g_c (ipointer, lon, lat, height, year, e, imname, flux) bind(C, name=\"get_flux_g_c\") C interface to get_flux_g . Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer real(kind=c_double), intent(in) :: lon geodetic longitude in degrees (east) real(kind=c_double), intent(in) :: lat geodetic latitude in degrees (north) real(kind=c_double), intent(in) :: height altitude in km above sea level real(kind=c_double), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=c_double), intent(in) :: e minimum energy integer(kind=c_int), intent(in) :: imname which method to use: Read more… real(kind=c_double), intent(out) :: flux The flux of particles above the given energy, in units of cm^-2 s^-1.","tags":"","loc":"module/radbelt_c_module.html"},{"title":"radbelt_module – radbelt","text":"Main module. See also https://ccmc.gsfc.nasa.gov/pub/modelweb/geomagnetic/igrf/fortran_code/bilcal.for https://ccmc.gsfc.nasa.gov/pub/modelweb/radiation_belt/radbelt/fortran_code/radbelt.for Uses trmfun_module radbelt_kinds_module shellig_module module~~radbelt_module~~UsesGraph module~radbelt_module radbelt_module module~radbelt_kinds_module radbelt_kinds_module module~radbelt_module->module~radbelt_kinds_module module~shellig_module shellig_module module~radbelt_module->module~shellig_module module~trmfun_module trmfun_module module~radbelt_module->module~trmfun_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env module~shellig_module->module~radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~radbelt_module~~UsedByGraph module~radbelt_module radbelt_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Interfaces public interface get_flux simple function versions for testing public function get_flux_g (lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c (v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Derived Types type, public :: radbelt_type the main class that can be used to get the flux. Components Type Visibility Attributes Name Initial type( trm_type ), private :: trm type( shellig_type ), private :: igrf Type-Bound Procedures generic, public :: get_flux => get_flux_g_ , get_flux_c_ procedure, private :: get_flux_c_ procedure, private :: get_flux_g_ procedure, public :: set_data_files_paths procedure, public :: set_igrf_file_path procedure, public :: set_trm_file_path Functions public function get_flux_g_ (me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_g (lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c_ (me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c (v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Subroutines public subroutine set_trm_file_path (me, dir) Set the trm path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir public subroutine set_igrf_file_path (me, dir) Set the igrf path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir public subroutine set_data_files_paths (me, aep8_dir, igrf_dir) Set the paths to the data files.\nIf not used or blank, the folder data/aep8 and data/igrf in the\ncurrent working directory is assumed Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: aep8_dir character(len=*), intent(in) :: igrf_dir","tags":"","loc":"module/radbelt_module.html"},{"title":"radbelt_kinds_module – radbelt","text":"Numeric kind definitions for radbelt. Uses iso_fortran_env module~~radbelt_kinds_module~~UsesGraph module~radbelt_kinds_module radbelt_kinds_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~radbelt_kinds_module~~UsedByGraph module~radbelt_kinds_module radbelt_kinds_module module~radbelt_module radbelt_module module~radbelt_module->module~radbelt_kinds_module module~shellig_module shellig_module module~radbelt_module->module~shellig_module module~trmfun_module trmfun_module module~radbelt_module->module~trmfun_module module~shellig_module->module~radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, public, parameter :: wp = real64 Real working precision if not specified [8 bytes] integer, public, parameter :: ip = int32 Integer working precision if not specified [4 bytes]","tags":"","loc":"module/radbelt_kinds_module.html"},{"title":"trmfun_module – radbelt","text":"Trapped radiation model. History Based on: trmfun.for 1987 Uses radbelt_kinds_module module~~trmfun_module~~UsesGraph module~trmfun_module trmfun_module module~radbelt_kinds_module radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~trmfun_module~~UsedByGraph module~trmfun_module trmfun_module module~radbelt_module radbelt_module module~radbelt_module->module~trmfun_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial character(len=10), private, parameter, dimension(4) :: mname = ['ae8min.asc', 'ae8max.asc', 'ap8min.asc', 'ap8max.asc'] data files available Derived Types type, public :: trm_type main class for the aep8 model Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: aep8_dir directory containing the data files character(len=:), private, allocatable :: file_loaded the file that has been loaded integer, private, dimension(8) :: ihead = 0 integer, private, dimension(:), allocatable :: map real(kind=wp), private :: fistep = 0.0_wp the stepsize for the parameterization of the logarithm of flux.\nformerly stored in common block tra2 real(kind=wp), private :: f1 = 1.001_wp real(kind=wp), private :: f2 = 1.002_wp Type-Bound Procedures procedure, public :: aep8 ../../ main routine procedure, public :: trara2 ../../ low-level routine procedure, public :: trara1 procedure, public :: get_data_file_dir procedure, public :: set_data_file_dir Functions private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(in) :: me Return Value character(len=:), allocatable private function trara2 (me, map, il, ib) trara2 interpolates linearly in l-b/b0-map to obtain\n the logarithm of integral flux at given l and b/b0. Read more… Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: map (*) is sub-map (for specific energy) of\ntrapped radiation model map integer, intent(in) :: il scaled l-value integer, intent(in) :: ib scaled b/b0-1 Return Value real(kind=wp) scaled logarithm of particle flux Subroutines private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me character(len=*), intent(in) :: dir private subroutine aep8 (me, e, l, bb0, imname, flux) Main wrapper for the radiation model.\nReads the coefficient file and calls the low-level routine. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me real(kind=wp), intent(in) :: e real(kind=wp), intent(in) :: l real(kind=wp), intent(in) :: bb0 integer, intent(in) :: imname which model to load (index in mname array) real(kind=wp), intent(out) :: flux private subroutine trara1 (me, descr, map, fl, bb0, e, f, n) trara1 finds particle fluxes for given energies, magnetic field\nstrength and l-value. function trara2 is used to interpolate in\nb-l-space. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: descr (8) header of specified trapped radition model integer, intent(in) :: map (*) map of trapped radition model\n(descr and map are explained at the begin\nof the main program model) real(kind=wp), intent(in) :: fl l-value real(kind=wp), intent(in) :: bb0 =b/b0 magnetic field strength normalized\nto field strength at magnetic equator real(kind=wp), intent(in) :: e (n) array of energies in mev real(kind=wp), intent(out) :: f (n) decadic logarithm of integral fluxes in\nparticles/(cm cm sec) integer, intent(in) :: n number of energies","tags":"","loc":"module/trmfun_module.html"},{"title":"shellig_module – radbelt","text":"IGRF model History SHELLIG.FOR, Version 2.0, January 1992 11/01/91-DKB- SHELLG: lowest starting point for B0 search is 2 1/27/92-DKB- Adopted to IGRF-91 coefficients model 2/05/92-DKB- Reduce variable-names: INTER(P)SHC,EXTRA(P)SHC,INITI(ALI)ZE 8/08/95-DKB- Updated to IGRF-45-95; new coeff. DGRF90, IGRF95, IGRF95S 5/31/00-DKB- Updated to IGRF-45-00; new coeff.: IGRF00, IGRF00s 3/24/05-DKB- Updated to IGRF-45-10; new coeff.: IGRF05, IGRF05s Uses radbelt_kinds_module module~~shellig_module~~UsesGraph module~shellig_module shellig_module module~radbelt_kinds_module radbelt_kinds_module module~shellig_module->module~radbelt_kinds_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~shellig_module~~UsedByGraph module~shellig_module shellig_module module~radbelt_module radbelt_module module~radbelt_module->module~shellig_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, private, parameter :: filename_len = 14 length of the model data file names real(kind=wp), private, parameter :: Era = 6371.2_wp earth radius for normalization of cartesian coordinates (6371.2 km) real(kind=wp), private, parameter :: erequ = 6378.16_wp real(kind=wp), private, parameter :: erpol = 6356.775_wp real(kind=wp), private, parameter :: Aquad = erequ*erequ square of major half axis for\nearth ellipsoid as recommended by international\nastronomical union real(kind=wp), private, parameter :: Bquad = erpol*erpol square of minor half axis for\nearth ellipsoid as recommended by international\nastronomical union real(kind=wp), private, parameter :: Umr = atan(1.0_wp)*4.0_wp/180.0_wp atan(1.0) 4./180. umr= real(kind=wp), private, parameter, dimension(3,3) :: u = reshape([+0.3511737_wp, -0.9148385_wp, -0.1993679_wp, +0.9335804_wp, +0.3583680_wp, +0.0000000_wp, +0.0714471_wp, -0.1861260_wp, +0.9799247_wp], [3, 3]) integer, private, parameter :: max_loop_index = 3333 used in shellg for the field line integration loop Derived Types type, public :: shellig_type Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: igrf_dir directory containing the data files real(kind=wp), private, dimension(3) :: sp = 0.0_wp real(kind=wp), private, dimension(3) :: xi = 0.0_wp real(kind=wp), private, dimension(144) :: h = 0.0_wp Field model coefficients adjusted for shellg integer, private :: iyea = 0 the int year corresponding to the file name that has been read character(len=:), private, allocatable :: name file name integer, private :: nmax = 0 maximum order of spherical harmonics real(kind=wp), private :: Time = 0.0_wp year (decimal: 1973.5) for which magnetic field is to be calculated real(kind=wp), private, dimension(144) :: g = 0.0_wp g(m) -- normalized field coefficients (see feldcof ) m=nmax*(nmax+2) integer, private :: nmax1 = 0 saved variables from the file integer, private :: nmax2 = 0 saved variables from the file real(kind=wp), private, dimension(144) :: g_cache = 0.0_wp saved g from the file real(kind=wp), private :: step = 0.20_wp step size for field line tracing real(kind=wp), private :: steq = 0.03_wp step size for integration real(kind=wp), private, dimension(120) :: gh2 = 0.0_wp real(kind=wp), private, dimension(:,:), allocatable :: p this was p(8,100) in the original code.\nused for the field line integration loop.\nchanged it to be allocatable since it was\nchanged to be p(8,3334). Type-Bound Procedures procedure, public :: igrfc procedure, public :: igrf procedure, public :: feldcof procedure, public :: feldc procedure, public :: feldg procedure, public :: shellc procedure, public :: shellg procedure, public :: findb0 procedure, private :: feldi procedure, private :: stoer procedure, public :: get_data_file_dir procedure, public :: set_data_file_dir procedure, public :: destroy => destroy_shellig_type Functions private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(in) :: me Return Value character(len=:), allocatable private pure function geo_to_cart (glat, glon, alt) result(x) geodetic to scaled cartesian coordinates Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level Return Value real(kind=wp), dimension(3) cartesian coordinates in earth radii (6371.2 km) x-axis pointing to equator at 0 longitude y-axis pointing to equator at 90 long. z-axis pointing to north pole Subroutines private subroutine destroy_shellig_type (me) Destroy a shellig_type . Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(out) :: me private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me character(len=*), intent(in) :: dir private subroutine igrf (me, lon, lat, height, year, xl, bbx) Wrapper for IGRF functions. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio private subroutine igrfc (me, v, year, xl, bbx) Alternate version of igrf for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio private subroutine findb0 (me, stps, bdel, value, bequ, rr0) Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: stps real(kind=wp), intent(inout) :: bdel logical, intent(out) :: value real(kind=wp), intent(out) :: bequ real(kind=wp), intent(out) :: rr0 private subroutine shellc (me, v, dimo, fl, icode, b0) Wrapper to shellg to be used with cartesian coordinates. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\n* x-axis pointing to equator at 0 longitude\n* y-axis pointing to equator at 90 long.\n* z-axis pointing to north pole real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss private subroutine shellg (me, glat, glon, alt, dimo, fl, icode, b0, v) calculates l-value for specified geodaetic coordinates, altitude\n and gemagnetic field model. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss real(kind=wp), intent(in), optional, dimension(3) :: v cartesian coordinates in earth radii (6371.2 km) Read more… private subroutine stoer (me, p, bq, r) subroutine used for field line tracing in shellg .\ncalls entry point feldi in geomagnetic field subroutine feldg Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(inout), dimension(7) :: p real(kind=wp), intent(out) :: bq real(kind=wp), intent(out) :: r private subroutine feldg (me, glat, glon, alt, bnorth, beast, bdown, Babs) Calculates earth magnetic field from spherical harmonics model Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(out) :: bnorth components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: beast components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: bdown components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: Babs magnetic field strength in gauss private subroutine feldc (me, v, b) Alternate version of feldg to be used with cartesian coordinates Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(out) :: b (3) field components private subroutine feldi (me) Used for l computation. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me private subroutine feldcof (me, year, dimo) Determines coefficients and dipol moment from IGRF models Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: dimo geomagnetic dipol moment in gauss (normalized\nto earth's radius) at the time (year) private subroutine getshc (Fspec, Nmax, Erad, Gh, Ier) Reads spherical harmonic coefficients from the specified\n file into an array. Read more… Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: Fspec File specification integer, intent(out) :: Nmax Maximum degree and order of model real(kind=wp), intent(out) :: Erad Earth's radius associated with the spherical\nharmonic coefficients, in the same units as\nelevation real(kind=wp), intent(out), dimension(*) :: Gh Schmidt quasi-normal internal spherical\nharmonic coefficients integer, intent(out) :: Ier Error number: Read more… private subroutine intershc (date, dte1, nmax1, gh1, dte2, nmax2, gh2, nmax, gh) Interpolates linearly, in time, between two spherical\n harmonic models. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of earlier model integer, intent(in) :: nmax1 Maximum degree and order of earlier model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real(kind=wp), intent(in) :: dte2 Date of later model integer, intent(in) :: nmax2 Maximum degree and order of later model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of later model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model private subroutine extrashc (date, dte1, nmax1, gh1, nmax2, gh2, nmax, gh) Extrapolates linearly a spherical harmonic model with a\n rate-of-change model. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of base model integer, intent(in) :: nmax1 Maximum degree and order of base model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of base model integer, intent(in) :: nmax2 Maximum degree and order of rate-of-change model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model","tags":"","loc":"module/shellig_module.html"},{"title":"radbelt_c_module.f90 – radbelt","text":"This file depends on sourcefile~~radbelt_c_module.f90~~EfferentGraph sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~radbelt_module.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Experimental C interface to the radbelt module. module radbelt_c_module use iso_c_binding , only : c_double , c_int , c_char , c_null_char , & c_intptr_t , c_ptr , c_loc , c_f_pointer , & c_null_ptr , c_associated use radbelt_module , only : radbelt_type implicit none contains !***************************************************************************************** !***************************************************************************************** !> ! Convert C string to Fortran function c2f_str ( cstr ) result ( fstr ) character ( kind = c_char , len = 1 ), dimension (:), intent ( in ) :: cstr !! string from C character ( len = :), allocatable :: fstr !! fortran string integer :: i !! counter fstr = '' do i = 1 , size ( cstr ) fstr = fstr // cstr ( i ) end do fstr = trim ( fstr ) end function c2f_str !***************************************************************************************** !> ! Convert an integer pointer to a [[radbelt_type]] pointer. subroutine int_pointer_to_f_pointer ( ipointer , p ) integer ( c_intptr_t ), intent ( in ) :: ipointer !! integer pointer from C type ( radbelt_type ), pointer :: p !! fortran pointer type ( c_ptr ) :: cp cp = transfer ( ipointer , c_null_ptr ) if ( c_associated ( cp )) then call c_f_pointer ( cp , p ) else p => null () end if end subroutine int_pointer_to_f_pointer !***************************************************************************************** !> ! create a [[radbelt_type]] from C subroutine initialize_c ( ipointer ) bind ( C , name = \"initialize_c\" ) integer ( c_intptr_t ), intent ( out ) :: ipointer type ( radbelt_type ), pointer :: p type ( c_ptr ) :: cp allocate ( p ) cp = c_loc ( p ) ipointer = transfer ( cp , 0_c_intptr_t ) end subroutine initialize_c !***************************************************************************************** !> ! destroy a [[radbelt_type]] from C subroutine destroy_c ( ipointer ) bind ( C , name = \"destroy_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) deallocate ( p ) end subroutine destroy_c !***************************************************************************************** !> ! C interface for setting the `trm` data file path subroutine set_trm_file_path_c ( ipointer , aep8_dir , n ) bind ( C , name = \"set_trm_file_path_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir character ( len = :), allocatable :: aep8_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) call p % set_trm_file_path ( aep8_dir_ ) else error stop 'error in set_trm_file_path_c: class is not associated' end if end subroutine set_trm_file_path_c !***************************************************************************************** !***************************************************************************************** !> ! C interface for setting the `igrf` data file path subroutine set_igrf_file_path_c ( ipointer , igrf_dir , n ) bind ( C , name = \"set_igrf_file_path\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then igrf_dir_ = c2f_str ( igrf_dir ) call p % set_igrf_file_path ( igrf_dir_ ) else error stop 'error in set_igrf_file_path: class is not associated' end if end subroutine set_igrf_file_path_c !***************************************************************************************** !***************************************************************************************** !> ! C interface for setting the data file paths subroutine set_data_files_paths_c ( ipointer , aep8_dir , igrf_dir , n , m ) bind ( C , name = \"set_data_files_paths_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir integer ( c_int ), intent ( in ) :: m !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( m ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: aep8_dir_ , igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) igrf_dir_ = c2f_str ( igrf_dir ) call p % set_data_files_paths ( aep8_dir_ , igrf_dir_ ) else error stop 'error in set_data_files_paths_c: class is not associated' end if end subroutine set_data_files_paths_c !***************************************************************************************** !***************************************************************************************** !> ! C interface to [[get_flux_g]]. subroutine get_flux_g_c ( ipointer , lon , lat , height , year , e , imname , flux ) bind ( C , name = \"get_flux_g_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer real ( c_double ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( c_double ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( c_double ), intent ( in ) :: height !! altitude in km above sea level real ( c_double ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( c_double ), intent ( in ) :: e !! minimum energy integer ( c_int ), intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( c_double ), intent ( out ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then flux = p % get_flux ( lon , lat , height , year , e , imname ) else error stop 'error in get_flux_g_c: class is not associated' end if end subroutine get_flux_g_c !***************************************************************************************** end module radbelt_c_module !*****************************************************************************************","tags":"","loc":"sourcefile/radbelt_c_module.f90.html"},{"title":"radbelt_module.f90 – radbelt","text":"This file depends on sourcefile~~radbelt_module.f90~~EfferentGraph sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~radbelt_module.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~radbelt_module.f90~~AfferentGraph sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Main module. ! !### See also ! * https://ccmc.gsfc.nasa.gov/pub/modelweb/geomagnetic/igrf/fortran_code/bilcal.for ! * https://ccmc.gsfc.nasa.gov/pub/modelweb/radiation_belt/radbelt/fortran_code/radbelt.for module radbelt_module use radbelt_kinds_module use trmfun_module use shellig_module implicit none type , public :: radbelt_type !! the main class that can be used to get the flux. private type ( trm_type ) :: trm type ( shellig_type ) :: igrf contains private generic , public :: get_flux => get_flux_g_ , get_flux_c_ procedure :: get_flux_g_ , get_flux_c_ procedure , public :: set_trm_file_path , & set_igrf_file_path , & set_data_files_paths end type radbelt_type interface get_flux !! simple function versions for testing procedure :: get_flux_g procedure :: get_flux_c end interface public :: get_flux contains !***************************************************************************************** !> ! Set the `trm` path. subroutine set_trm_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % trm % set_data_file_dir ( trim ( dir )) end subroutine set_trm_file_path !***************************************************************************************** !***************************************************************************************** !> ! Set the `igrf` path. subroutine set_igrf_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % igrf % set_data_file_dir ( trim ( dir )) end subroutine set_igrf_file_path !***************************************************************************************** !***************************************************************************************** !> ! Set the paths to the data files. ! If not used or blank, the folder `data/aep8` and `data/igrf` in the ! current working directory is assumed subroutine set_data_files_paths ( me , aep8_dir , igrf_dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: aep8_dir character ( len =* ), intent ( in ) :: igrf_dir call me % set_trm_file_path ( trim ( aep8_dir )) call me % set_igrf_file_path ( trim ( igrf_dir )) end subroutine set_data_files_paths !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. function get_flux_g_ ( me , lon , lat , height , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrf ( lon , lat , height , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_g_ !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. ! This is just a function version of the class method from [[radbelt_type]]. ! !@note This routine is not efficient at all since it will reload all the ! files every time it is called. function get_flux_g ( lon , lat , height , year , e , imname ) result ( flux ) real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( lon , lat , height , year , e , imname ) end function get_flux_g !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. ! This is an alternate version of [[get_flux_g_]] for cartesian coordinates. function get_flux_c_ ( me , v , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrfc ( v , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_c_ !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. ! This is just a function version of the class method from [[radbelt_type]]. ! !@note This routine is not efficient at all since it will reload all the ! files every time it is called. function get_flux_c ( v , year , e , imname ) result ( flux ) real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( v , year , e , imname ) end function get_flux_c end module radbelt_module","tags":"","loc":"sourcefile/radbelt_module.f90.html"},{"title":"radbelt_kinds_module.F90 – radbelt","text":"Files dependent on this one sourcefile~~radbelt_kinds_module.f90~~AfferentGraph sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_module.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Numeric kind definitions for radbelt. module radbelt_kinds_module use , intrinsic :: iso_fortran_env implicit none private #ifdef REAL32 integer , parameter , public :: wp = real32 !! Real working precision [4 bytes] #elif REAL64 integer , parameter , public :: wp = real64 !! Real working precision [8 bytes] #elif REAL128 integer , parameter , public :: wp = real128 !! Real working precision [16 bytes] #else integer , parameter , public :: wp = real64 !! Real working precision if not specified [8 bytes] #endif #ifdef INT8 integer , parameter , public :: ip = int8 !! Integer working precision [1 byte] #elif INT16 integer , parameter , public :: ip = int16 !! Integer working precision [2 bytes] #elif INT32 integer , parameter , public :: ip = int32 !! Integer working precision [4 bytes] #elif INT64 integer , parameter , public :: ip = int64 !! Integer working precision [8 bytes] #else integer , parameter , public :: ip = int32 !! Integer working precision if not specified [4 bytes] #endif !***************************************************************************************** end module radbelt_kinds_module !*****************************************************************************************","tags":"","loc":"sourcefile/radbelt_kinds_module.f90.html"},{"title":"trmfun.f90 – radbelt","text":"This file depends on sourcefile~~trmfun.f90~~EfferentGraph sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~trmfun.f90~~AfferentGraph sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Trapped radiation model. ! !### History ! * Based on: `trmfun.for` 1987 module trmfun_module use radbelt_kinds_module implicit none private character ( len = 10 ), dimension ( 4 ), parameter :: mname = [ 'ae8min.asc' , & 'ae8max.asc' , & 'ap8min.asc' , & 'ap8max.asc' ] !! data files available type , public :: trm_type !! main class for the `aep8` model private character ( len = :), allocatable :: aep8_dir !! directory containing the data files ! data read from the files: character ( len = :), allocatable :: file_loaded !! the file that has been loaded integer , dimension ( 8 ) :: ihead = 0 integer , dimension (:), allocatable :: map real ( wp ) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux. !! formerly stored in common block `tra2` ! formerly saved variables in trara1: real ( wp ) :: f1 = 1.001_wp real ( wp ) :: f2 = 1.002_wp contains private procedure , public :: aep8 !! main routine procedure , public :: trara1 , trara2 !! low-level routine procedure , public :: set_data_file_dir , get_data_file_dir end type trm_type contains !***************************************************************************************** !> ! Set the directory containing the data files. subroutine set_data_file_dir ( me , dir ) class ( trm_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % aep8_dir = trim ( dir ) end subroutine set_data_file_dir !***************************************************************************************** !> ! Get the directory containing the data files. function get_data_file_dir ( me ) result ( dir ) class ( trm_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % aep8_dir )) then dir = trim ( me % aep8_dir ) // '/' else dir = 'data/aep8/' ! default end if end function get_data_file_dir !***************************************************************************************** !> ! Main wrapper for the radiation model. ! Reads the coefficient file and calls the low-level routine. subroutine aep8 ( me , e , l , bb0 , imname , flux ) class ( trm_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: e real ( wp ), intent ( in ) :: l real ( wp ), intent ( in ) :: bb0 integer , intent ( in ) :: imname !! which model to load (index in `mname` array) real ( wp ), intent ( out ) :: flux real ( wp ) :: ee ( 1 ), f ( 1 ) !! temp variables integer :: i , ierr , iuaeap , nmap character ( len = :), allocatable :: name logical :: load_file name = me % get_data_file_dir () // trim ( mname ( Imname )) ! the file to load ! JW : do we need to reset some or all of these ? me % fistep = 0.0_wp me % f1 = 1.001_wp me % f2 = 1.002_wp ! check to see if this file has already been loaded ! [the class can store one file at a time] load_file = . true . if ( allocated ( me % file_loaded )) then if ( name == me % file_loaded ) load_file = . false . end if if ( load_file ) then open ( newunit = iuaeap , file = name , status = 'OLD' , iostat = ierr , form = 'FORMATTED' ) if ( ierr /= 0 ) then error stop 'error reading ' // trim ( name ) end if read ( iuaeap , '(1X,12I6)' ) me % ihead nmap = me % ihead ( 8 ) allocate ( me % map ( nmap )) read ( iuaeap , '(1X,12I6)' ) ( me % map ( i ), i = 1 , nmap ) close ( iuaeap ) me % file_loaded = trim ( name ) end if ee ( 1 ) = e call me % trara1 ( me % ihead , me % map , L , Bb0 , ee , f , 1 ) flux = f ( 1 ) IF ( Flux > 0.0_wp ) Flux = 1 0.0_wp ** Flux end subroutine aep8 !***************************************************************************************** !***************************************************************************************** !> ! [[trara1]] finds particle fluxes for given energies, magnetic field ! strength and l-value. function [[trara2]] is used to interpolate in ! b-l-space. subroutine trara1 ( me , descr , map , fl , bb0 , e , f , n ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: n !! number of energies integer , intent ( in ) :: descr ( 8 ) !! header of specified trapped radition model real ( wp ), intent ( in ) :: e ( n ) !! array of energies in mev real ( wp ), intent ( in ) :: fl !! l-value real ( wp ), intent ( in ) :: bb0 !! =b/b0 magnetic field strength normalized !! to field strength at magnetic equator integer , intent ( in ) :: map ( * ) !! map of trapped radition model !! (descr and map are explained at the begin !! of the main program model) real ( wp ), intent ( out ) :: f ( n ) !! decadic logarithm of integral fluxes in !! particles/(cm*cm*sec) real ( wp ) :: e0 , e1 , e2 , escale , f0 , fscale , xnl real ( wp ) :: bb0_ !! local copy of `bb0`. in the original code !! this was modified by this routine. !! added this so `bb0` could be `intent(in)` integer :: i0 , i1 , i2 , i3 , ie , l3 , nb , nl logical :: s0 , s1 , s2 e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings i0 = 0 ! to avoid -Wmaybe-uninitialized warnings s0 = . false . ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW bb0_ = bb0 me % fistep = descr ( 7 ) / descr ( 2 ) escale = descr ( 4 ) fscale = descr ( 7 ) xnl = min ( 1 5.6_wp , abs ( fl )) nl = int ( xnl * descr ( 5 )) if ( bb0_ < 1.0_wp ) bb0_ = 1.0_wp nb = int (( bb0_ - 1.0_wp ) * descr ( 6 )) ! i2 is the number of elements in the flux map for the first energy. ! i3 is the index of the last element of the second energy map. ! l3 is the length of the map for the third energy. ! e1 is the energy of the first energy map (unscaled) ! e2 is the energy of the second energy map (unscaled) i1 = 0 i2 = map ( 1 ) i3 = i2 + map ( i2 + 1 ) l3 = map ( i3 + 1 ) e1 = map ( i1 + 2 ) / escale e2 = map ( i2 + 2 ) / escale ! s0, s1, s2 are logical variables which indicate whether the flux for ! a particular e, b, l point has already been found in a previous call ! to function trara2. if not, s.. =.true. s1 = . true . s2 = . true . ! energy loop do ie = 1 , n ! for each energy e(i) find the successive energies e0,e1,e2 in ! model map, which obey e0 < e1 < e(i) < e2 . do while ( ( e ( ie ) > e2 ) . and . ( l3 /= 0 ) ) i0 = i1 i1 = i2 i2 = i3 i3 = i3 + l3 l3 = map ( i3 + 1 ) e0 = e1 e1 = e2 e2 = map ( i2 + 2 ) / escale s0 = s1 s1 = s2 s2 = . true . f0 = me % f1 me % f1 = me % f2 enddo ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0- ! space to find fluxes f1,f2 [if they have not already been ! calculated for a previous e(i)]. if ( s1 ) me % f1 = me % trara2 ( map ( i1 + 3 ), nl , nb ) / fscale if ( s2 ) me % f2 = me % trara2 ( map ( i2 + 3 ), nl , nb ) / fscale s1 = . false . s2 = . false . ! finally, interpolate in energy. f ( ie ) = me % f1 + ( me % f2 - me % f1 ) * ( e ( ie ) - e1 ) / ( e2 - e1 ) if ( me % f2 <= 0.0_wp ) then if ( i1 /= 0 ) then ! --------- special interpolation --------------------------------- ! if the flux for the second energy cannot be found (i.e. f2=0.0), ! and the zeroth energy map has been defined (i.e. i1 not equal 0), ! then interpolate using the flux maps for the zeroth and first ! energy and choose the minimum of this interpolations and the ! interpolation that was done with f2=0. if ( s0 ) f0 = me % trara2 ( map ( i0 + 3 ), nl , nb ) / fscale s0 = . false . f ( ie ) = min ( f ( ie ), f0 + ( me % f1 - f0 ) * ( e ( ie ) - e0 ) / ( e1 - e0 )) endif endif ! the logarithmic flux is always kept greater or equal zero. f ( ie ) = max ( f ( ie ), 0.0_wp ) enddo end subroutine trara1 !***************************************************************************************** !> ! [[trara2]] interpolates linearly in l-b/b0-map to obtain ! the logarithm of integral flux at given l and b/b0. ! !### Note ! see main program 'model' for explanation of map format ! scaling factors. function trara2 ( me , map , il , ib ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: map ( * ) !! is sub-map (for specific energy) of !! trapped radiation model map integer , intent ( in ) :: il !! scaled l-value integer , intent ( in ) :: ib !! scaled b/b0-1 real ( wp ) :: trara2 !! scaled logarithm of particle flux real ( wp ) :: dfl , fincr1 , fincr2 , fistep , fkb , fkb1 , fkb2 , fkbj1 , fkbj2 , & fkbm , fll1 , fll2 , flog , flog1 , flog2 , flogm , & fnb , fnl , sl1 , sl2 integer :: i1 , i2 , itime , j1 , j2 , kt , l1 , l2 logical :: dummy fistep = me % fistep !******** ! to avoid -Wmaybe-uninitialized warning dfl = 0.0_wp fincr1 = 0.0_wp fincr2 = 0.0_wp fkb = 0.0_wp fkb1 = 0.0_wp fkb2 = 0.0_wp fkbm = 0.0_wp flog = 0.0_wp flog1 = 0.0_wp flog2 = 0.0_wp flogm = 0.0_wp fnb = 0.0_wp fnl = 0.0_wp sl2 = 0.0_wp i1 = 0 i2 = 0 itime = 0 j2 = 0 l1 = 0 l2 = 0 !******** ! these are recursive functions that ! replace the gotos in the original code call task1 ( dummy ) contains recursive subroutine task1 ( done ) logical , intent ( out ) :: done done = . false . fnl = il fnb = ib itime = 0 i2 = 0 do ! find consecutive sub-sub-maps for scaled l-values ls1,ls2, ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps. ! i1,i2 are indeces of first elements minus 1. l2 = map ( i2 + 1 ) if ( map ( i2 + 2 ) <= il ) then i1 = i2 l1 = l2 i2 = i2 + l2 ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0 elseif ( ( l1 < 4 ) . and . ( l2 < 4 ) ) then trara2 = 0.0_wp done = . true . return else ! if flog2 less flog1, than ls2 first map and ls1 second map if ( map ( i2 + 3 ) <= map ( i1 + 3 ) ) exit call task3 ( done ) return endif enddo call task2 ( done ) end subroutine task1 recursive subroutine task2 ( done ) logical , intent ( out ) :: done done = . false . kt = i1 i1 = i2 i2 = kt kt = l1 l1 = l2 l2 = kt call task3 ( done ) end subroutine task2 recursive subroutine task3 ( done ) logical , intent ( out ) :: done logical :: check done = . false . ! determine interpolate in scaled l-value fll1 = map ( i1 + 2 ) fll2 = map ( i2 + 2 ) dfl = ( fnl - fll1 ) / ( fll2 - fll1 ) flog1 = map ( i1 + 3 ) flog2 = map ( i2 + 3 ) fkb1 = 0.0_wp fkb2 = 0.0_wp if ( l1 >= 4 ) then ! b/b0 loop check = . true . do j2 = 4 , l2 fincr2 = map ( i2 + j2 ) if ( fkb2 + fincr2 > fnb ) then check = . false . exit end if fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep enddo if ( check ) then itime = itime + 1 if ( itime == 1 ) then call task2 ( done ) return endif trara2 = 0.0_wp done = . true . return end if if ( itime /= 1 ) then if ( j2 == 4 ) then call task4 ( done ) return endif sl2 = flog2 / fkb2 check = . true . do j1 = 4 , l1 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) if ( fkbj1 <= fkb1 ) then check = . false . exit end if enddo if ( check ) then if ( fkbj1 <= fkb2 ) then trara2 = 0.0_wp done = . true . return endif end if if ( fkbj1 <= fkb2 ) then fkbm = fkbj1 + ( fkb2 - fkbj1 ) * dfl flogm = fkbm * sl2 flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl1 = flog1 / fkb1 sl2 = flog2 / fkb2 call task5 ( done ) return else fkb1 = 0.0_wp endif endif fkb2 = 0.0_wp endif j2 = 4 fincr2 = map ( i2 + j2 ) flog2 = map ( i2 + 3 ) flog1 = map ( i1 + 3 ) call task4 ( done ) end subroutine task3 recursive subroutine task4 ( done ) logical , intent ( out ) :: done done = . false . flogm = flog1 + ( flog2 - flog1 ) * dfl fkbm = 0.0_wp fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep sl2 = flog2 / fkb2 if ( l1 < 4 ) then fincr1 = 0.0_wp sl1 = - 90000 0.0_wp call task6 ( done ) return else j1 = 4 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep sl1 = flog1 / fkb1 endif call task5 ( done ) end subroutine task4 recursive subroutine task5 ( done ) logical , intent ( out ) :: done done = . false . do while ( sl1 >= sl2 ) fkbj2 = (( flog2 / fistep ) * fincr2 + fkb2 ) / (( fincr2 / fistep ) * sl1 + 1.0_wp ) fkb = fkb1 + ( fkbj2 - fkb1 ) * dfl flog = fkb * sl1 if ( fkb >= fnb ) then call task7 ( done ) return endif fkbm = fkb flogm = flog if ( j1 >= l1 ) then trara2 = 0.0_wp done = . true . return else j1 = j1 + 1 fincr1 = map ( i1 + j1 ) flog1 = flog1 - fistep fkb1 = fkb1 + fincr1 sl1 = flog1 / fkb1 endif enddo call task6 ( done ) end subroutine task5 recursive subroutine task6 ( done ) logical , intent ( out ) :: done done = . false . fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) fkb = fkbj1 + ( fkb2 - fkbj1 ) * dfl flog = fkb * sl2 if ( fkb < fnb ) then fkbm = fkb flogm = flog if ( j2 >= l2 ) then trara2 = 0.0_wp done = . true . return else j2 = j2 + 1 fincr2 = map ( i2 + j2 ) flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl2 = flog2 / fkb2 call task5 ( done ) return endif endif call task7 ( done ) end subroutine task6 recursive subroutine task7 ( done ) logical , intent ( out ) :: done if ( fkb < fkbm + 1.0e-10_wp ) then trara2 = 0.0_wp else trara2 = flogm + ( flog - flogm ) * (( fnb - fkbm ) / ( fkb - fkbm )) trara2 = max ( trara2 , 0.0_wp ) endif done = . true . end subroutine task7 end function trara2 end module trmfun_module","tags":"","loc":"sourcefile/trmfun.f90.html"},{"title":"shellig.f90 – radbelt","text":"This file depends on sourcefile~~shellig.f90~~EfferentGraph sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~shellig.f90~~AfferentGraph sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! IGRF model ! !### History ! * SHELLIG.FOR, Version 2.0, January 1992 ! * 11/01/91-DKB- SHELLG: lowest starting point for B0 search is 2 ! * 1/27/92-DKB- Adopted to IGRF-91 coefficients model ! * 2/05/92-DKB- Reduce variable-names: INTER(P)SHC,EXTRA(P)SHC,INITI(ALI)ZE ! * 8/08/95-DKB- Updated to IGRF-45-95; new coeff. DGRF90, IGRF95, IGRF95S ! * 5/31/00-DKB- Updated to IGRF-45-00; new coeff.: IGRF00, IGRF00s ! * 3/24/05-DKB- Updated to IGRF-45-10; new coeff.: IGRF05, IGRF05s module shellig_module use radbelt_kinds_module implicit none private integer , parameter :: filename_len = 14 !! length of the model data file names ! parameters formerly in `gener` common block real ( wp ), parameter :: Era = 637 1.2_wp !! earth radius for normalization of cartesian coordinates (6371.2 km) real ( wp ), parameter :: erequ = 637 8.16_wp real ( wp ), parameter :: erpol = 635 6.775_wp real ( wp ), parameter :: Aquad = erequ * erequ !! square of major half axis for !! earth ellipsoid as recommended by international !! astronomical union real ( wp ), parameter :: Bquad = erpol * erpol !! square of minor half axis for !! earth ellipsoid as recommended by international !! astronomical union real ( wp ), parameter :: Umr = atan ( 1.0_wp ) * 4.0_wp / 18 0.0_wp !! atan(1.0)*4./180. *umr= real ( wp ), dimension ( 3 , 3 ), parameter :: u = reshape ([ + 0.3511737_wp , - 0.9148385_wp , - 0.1993679_wp , & + 0.9335804_wp , + 0.3583680_wp , + 0.0000000_wp , & + 0.0714471_wp , - 0.1861260_wp , + 0.9799247_wp ], [ 3 , 3 ]) integer , parameter :: max_loop_index = 3333 !! used in [[shellg]] for the field line integration loop type , public :: shellig_type private character ( len = :), allocatable :: igrf_dir !! directory containing the data files ! formerly in the `fidb0` common block real ( wp ), dimension ( 3 ) :: sp = 0.0_wp ! formerly in blank common real ( wp ), dimension ( 3 ) :: xi = 0.0_wp real ( wp ), dimension ( 144 ) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]] ! formerly in `model` common block integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read character ( len = :), allocatable :: name !! file name integer :: nmax = 0 !! maximum order of spherical harmonics real ( wp ) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated real ( wp ), dimension ( 144 ) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2) integer :: nmax1 = 0 !! saved variables from the file integer :: nmax2 = 0 !! saved variables from the file real ( wp ), dimension ( 144 ) :: g_cache = 0.0_wp !! saved `g` from the file ! formerly saved vars in shellg: real ( wp ) :: step = 0.20_wp !! step size for field line tracing real ( wp ) :: steq = 0.03_wp !! step size for integration ! from feldcof, so we can cache the coefficients real ( wp ), dimension ( 120 ) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ??? real ( wp ), dimension (:,:), allocatable :: p !! this was `p(8,100)` in the original code. !! used for the field line integration loop. !! changed it to be allocatable since it was !! changed to be p(8,3334). contains private procedure , public :: igrf , igrfc procedure , public :: feldcof procedure , public :: feldg , feldc procedure , public :: shellg , shellc procedure , public :: findb0 procedure :: stoer , feldi procedure , public :: set_data_file_dir , get_data_file_dir procedure , public :: destroy => destroy_shellig_type end type shellig_type contains !***************************************************************************************** !***************************************************************************************** !> ! Destroy a [[shellig_type]]. subroutine destroy_shellig_type ( me ) class ( shellig_type ), intent ( out ) :: me end subroutine destroy_shellig_type !***************************************************************************************** !> ! Set the directory containing the data files. subroutine set_data_file_dir ( me , dir ) class ( shellig_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % igrf_dir = trim ( dir ) end subroutine set_data_file_dir !***************************************************************************************** !> ! Get the directory containing the data files. function get_data_file_dir ( me ) result ( dir ) class ( shellig_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % igrf_dir )) then dir = trim ( me % igrf_dir ) // '/' else dir = 'data/igrf/' ! default end if end function get_data_file_dir !***************************************************************************************** !> ! Wrapper for IGRF functions. subroutine igrf ( me , lon , lat , height , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , babs , bdel , bdown , beast , & beq , bequ , bnorth , dimo , rr0 integer :: icode logical :: val real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldg ( lat , lon , height , bnorth , beast , bdown , babs ) call me % shellg ( lat , lon , height , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq endif bbx = babs / bequ end subroutine igrf !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[igrf]] for cartesian coordinates. subroutine igrfc ( me , v , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , bdel , beq , bequ , dimo , rr0 integer :: icode logical :: val real ( wp ), dimension ( 3 ) :: b real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldc ( v , b ) call me % shellc ( v , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq endif bbx = norm2 ( b ) / bequ end subroutine igrfc !***************************************************************************************** !***************************************************************************************** !> subroutine findb0 ( me , stps , bdel , value , bequ , rr0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: stps real ( wp ), intent ( inout ) :: bdel real ( wp ), intent ( out ) :: bequ logical , intent ( out ) :: value real ( wp ), intent ( out ) :: rr0 real ( wp ) :: b , bdelta , bmin , bold , bq1 , & bq2 , bq3 , p ( 8 , 4 ) , r1 , r2 , r3 , & rold , step , step12 , zz integer :: i , irun , j , n step = stps irun = 0 rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings main : do irun = irun + 1 if ( irun > 5 ) then value = . false . exit main endif ! first three points p ( 1 , 2 ) = me % sp ( 1 ) p ( 2 , 2 ) = me % sp ( 2 ) p ( 3 , 2 ) = me % sp ( 3 ) step =- sign ( step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then step =- step r3 = r1 bq3 = bq1 do i = 1 , 5 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz end do end if ! initialization step12 = step / 1 2.0_wp value = . true . bmin = 1.0e4_wp bold = 1.0e4_wp ! corrector (field line tracing) n = 0 corrector : do p ( 1 , 3 ) = p ( 1 , 2 ) + step12 * ( 5.0_wp * p ( 4 , 3 ) + 8.0_wp * p ( 4 , 2 ) - p ( 4 , 1 )) n = n + 1 p ( 2 , 3 ) = p ( 2 , 2 ) + step12 * ( 5.0_wp * p ( 5 , 3 ) + 8.0_wp * p ( 5 , 2 ) - p ( 5 , 1 )) ! predictor (field line tracing) p ( 1 , 4 ) = p ( 1 , 3 ) + step12 * ( 2 3.0_wp * p ( 4 , 3 ) - 1 6.0_wp * p ( 4 , 2 ) + 5.0_wp * p ( 4 , 1 )) p ( 2 , 4 ) = p ( 2 , 3 ) + step12 * ( 2 3.0_wp * p ( 5 , 3 ) - 1 6.0_wp * p ( 5 , 2 ) + 5.0_wp * p ( 5 , 1 )) p ( 3 , 4 ) = p ( 3 , 3 ) + step call me % stoer ( p ( 1 , 4 ), bq3 , r3 ) do j = 1 , 3 do i = 1 , 8 p ( i , j ) = p ( i , j + 1 ) end do end do b = sqrt ( bq3 ) if ( b < bmin ) bmin = b if ( b > bold ) exit corrector bold = b rold = 1.0_wp / r3 me % sp ( 1 ) = p ( 1 , 4 ) me % sp ( 2 ) = p ( 2 , 4 ) me % sp ( 3 ) = p ( 3 , 4 ) end do corrector if ( bold /= bmin ) value = . false . bdelta = ( b - bold ) / bold if ( bdelta <= bdel ) exit main step = step / 1 0.0_wp end do main rr0 = rold bequ = bold bdel = bdelta end subroutine findb0 !***************************************************************************************** !> ! Wrapper to [[shellg]] to be used with cartesian coordinates. ! !@note In the original code, this was an ENTRY point in [[shellg]] and didn't ! include all the outputs. subroutine shellc ( me , v , dimo , fl , icode , b0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ) :: glat , glon , alt !! not used call me % shellg ( glat , glon , alt , dimo , fl , icode , b0 , v ) end subroutine shellc !***************************************************************************************** !> ! calculates l-value for specified geodaetic coordinates, altitude ! and gemagnetic field model. ! !### Reference ! * G. KLUGE, EUROPEAN SPACE OPERATIONS CENTER, INTERNAL NOTE ! NO. 67, 1970. ! * G. KLUGE, COMPUTER PHYSICS COMMUNICATIONS 3, 31-35, 1972 ! !### History ! * CHANGES (D. BILITZA, NOV 87): ! - USING CORRECT DIPOL MOMENT I.E.,DIFFERENT COMMON/MODEL/ ! - USING IGRF EARTH MAGNETIC FIELD MODELS FROM 1945 TO 1990 subroutine shellg ( me , glat , glon , alt , dimo , fl , icode , b0 , v ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ), dimension ( 3 ), intent ( in ), optional :: v !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole !! !! If this argument is present, it is used !! instead of glat,glon,alt. See [[shellc]]. real ( wp ) :: arg1 , arg2 , bequ , bq1 , bq2 , bq3 , c0 , c1 , c2 , c3 , & d0 , d1 , d2 , dimob0 , e0 , e1 , e2 , ff , fi , gg , & hli , oradik , oterm , r , r1 , r2 , r3 , r3h , radik , & rq , step12 , step2 , stp , t , term , xx , z , zq , zz integer :: i , iequ , n real ( wp ), parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3` real ( wp ), parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3` if (. not . allocated ( me % p )) allocate ( me % p ( 8 , max_loop_index + 1 )) ! because `p(:,n+1)` in the loop bequ = 1.0e10_wp if ( present ( v )) then me % xi ( 1 ) = v ( 1 ) me % xi ( 2 ) = v ( 2 ) me % xi ( 3 ) = v ( 3 ) else me % xi = geo_to_cart ( glat , glon , alt ) end if associate ( p => me % p ) ! convert to dipol-oriented co-ordinates rq = 1.0_wp / ( me % xi ( 1 ) * me % xi ( 1 ) + me % xi ( 2 ) * me % xi ( 2 ) + me % xi ( 3 ) * me % xi ( 3 )) r3h = sqrt ( rq * sqrt ( rq )) p ( 1 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 1 ) + me % xi ( 2 ) * u ( 2 , 1 ) + me % xi ( 3 ) * u ( 3 , 1 )) * r3h p ( 2 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 2 ) + me % xi ( 2 ) * u ( 2 , 2 )) * r3h p ( 3 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 3 ) + me % xi ( 2 ) * u ( 2 , 3 ) + me % xi ( 3 ) * u ( 3 , 3 )) * rq ! first three points of field line me % step = - sign ( me % step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) b0 = sqrt ( bq2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * me % step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * me % step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - me % step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - me % step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - me % step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + me % step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + me % step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then me % step = - me % step r3 = r1 bq3 = bq1 do i = 1 , 7 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz enddo endif ! search for lowest magnetic field strength if ( bq1 < bequ ) then bequ = bq1 iequ = 1 endif if ( bq2 < bequ ) then bequ = bq2 iequ = 2 endif if ( bq3 < bequ ) then bequ = bq3 iequ = 3 endif ! initialization of integration loops step12 = me % step / 1 2.0_wp step2 = me % step + me % step me % steq = sign ( me % steq , me % step ) fi = 0.0_wp icode = 1 oradik = 0.0_wp oterm = 0.0_wp stp = r2 * me % steq z = p ( 3 , 2 ) + stp stp = stp / 0.75_wp p ( 8 , 1 ) = step2 * ( p ( 1 , 1 ) * p ( 4 , 1 ) + p ( 2 , 1 ) * p ( 5 , 1 )) p ( 8 , 2 ) = step2 * ( p ( 1 , 2 ) * p ( 4 , 2 ) + p ( 2 , 2 ) * p ( 5 , 2 )) ! main loop (field line tracing) main : do n = 3 , max_loop_index ! corrector (field line tracing) p ( 1 , n ) = p ( 1 , n - 1 ) + step12 * ( 5.0_wp * p ( 4 , n ) + 8.0_wp * p ( 4 , n - 1 ) - p ( 4 , n - 2 )) p ( 2 , n ) = p ( 2 , n - 1 ) + step12 * ( 5.0_wp * p ( 5 , n ) + 8.0_wp * p ( 5 , n - 1 ) - p ( 5 , n - 2 )) ! prepare expansion coefficients for interpolation ! of slowly varying quantities p ( 8 , n ) = step2 * ( p ( 1 , n ) * p ( 4 , n ) + p ( 2 , n ) * p ( 5 , n )) c0 = p ( 1 , n - 1 ) ** 2 + p ( 2 , n - 1 ) ** 2 c1 = p ( 8 , n - 1 ) c2 = ( p ( 8 , n ) - p ( 8 , n - 2 )) * 0.25_wp c3 = ( p ( 8 , n ) + p ( 8 , n - 2 ) - c1 - c1 ) / 6.0_wp d0 = p ( 6 , n - 1 ) d1 = ( p ( 6 , n ) - p ( 6 , n - 2 )) * 0.5_wp d2 = ( p ( 6 , n ) + p ( 6 , n - 2 ) - d0 - d0 ) * 0.5_wp e0 = p ( 7 , n - 1 ) e1 = ( p ( 7 , n ) - p ( 7 , n - 2 )) * 0.5_wp e2 = ( p ( 7 , n ) + p ( 7 , n - 2 ) - e0 - e0 ) * 0.5_wp inner : do ! inner loop (for quadrature) t = ( z - p ( 3 , n - 1 )) / me % step if ( t > 1.0_wp ) then ! predictor (field line tracing) p ( 1 , n + 1 ) = p ( 1 , n ) + step12 * ( 2 3.0_wp * p ( 4 , n ) - 1 6.0_wp * p ( 4 , n - 1 ) + 5.0_wp * p ( 4 , n - 2 )) p ( 2 , n + 1 ) = p ( 2 , n ) + step12 * ( 2 3.0_wp * p ( 5 , n ) - 1 6.0_wp * p ( 5 , n - 1 ) + 5.0_wp * p ( 5 , n - 2 )) p ( 3 , n + 1 ) = p ( 3 , n ) + me % step call me % stoer ( p ( 1 , n + 1 ), bq3 , r3 ) ! search for lowest magnetic field strength if ( bq3 < bequ ) then iequ = n + 1 bequ = bq3 endif exit inner else hli = 0.5_wp * ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) zq = z * z r = hli + sqrt ( hli * hli + zq ) if ( r <= rmin ) then ! approximation for high values of l. icode = 3 t = - p ( 3 , n - 1 ) / me % step fl = 1.0_wp / ( abs ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) + 1.0e-15_wp ) return endif rq = r * r ff = sqrt ( 1.0_wp + 3.0_wp * zq / rq ) radik = b0 - (( d2 * t + d1 ) * t + d0 ) * r * rq * ff if ( r > rmax ) then icode = 2 radik = radik - 1 2.0_wp * ( r - rmax ) ** 2 endif if ( radik + radik <= oradik ) exit main term = sqrt ( radik ) * ff * (( e2 * t + e1 ) * t + e0 ) / ( rq + zq ) fi = fi + stp * ( oterm + term ) oradik = radik oterm = term stp = r * me % steq z = z + stp endif enddo inner enddo main if ( iequ < 2 ) iequ = 2 me % sp ( 1 ) = p ( 1 , iequ - 1 ) me % sp ( 2 ) = p ( 2 , iequ - 1 ) me % sp ( 3 ) = p ( 3 , iequ - 1 ) if ( oradik >= 1.0e-15_wp ) fi = fi + stp / 0.75_wp * oterm * oradik / ( oradik - radik ) ! the minimal allowable value of fi was changed from 1e-15 to 1e-12, ! because 1e-38 is the minimal allowable arg. for alog in our envir. ! d. bilitza, nov 87. fi = 0.5_wp * abs ( fi ) / sqrt ( b0 ) + 1.0e-12_wp ! compute l from b and i. same as carmel in invar. ! correct dipole moment is used here. d. bilitza, nov 87. dimob0 = dimo / b0 arg1 = log ( fi ) arg2 = log ( dimob0 ) ! arg = fi*fi*fi/dimob0 ! if(abs(arg)>88.0_wp) arg=88.0_wp xx = 3 * arg1 - arg2 if ( xx > 2 3.0_wp ) then gg = xx - 3.0460681_wp elseif ( xx > 1 1.7_wp ) then gg = ((((( 2.8212095e-8_wp * xx - 3.8049276e-6_wp ) * xx + & 2.170224e-4_wp ) * xx - 6.7310339e-3_wp ) * xx + & 1.2038224e-1_wp ) * xx - 1.8461796e-1_wp ) * xx + 2.0007187_wp elseif ( xx >+ 3.0_wp ) then gg = (((((((( 6.3271665e-10_wp * xx - 3.958306e-8_wp ) * xx + & 9.9766148e-07_wp ) * xx - 1.2531932e-5_wp ) * xx + & 7.9451313e-5_wp ) * xx - 3.2077032e-4_wp ) * xx + & 2.1680398e-3_wp ) * xx + 1.2817956e-2_wp ) * xx + & 4.3510529e-1_wp ) * xx + 6.222355e-1_wp elseif ( xx >- 3.0_wp ) then gg = (((((((( 2.6047023e-10_wp * xx + 2.3028767e-9_wp ) * xx - & 2.1997983e-8_wp ) * xx - 5.3977642e-7_wp ) * xx - & 3.3408822e-6_wp ) * xx + 3.8379917e-5_wp ) * xx + & 1.1784234e-3_wp ) * xx + 1.4492441e-2_wp ) * xx + & 4.3352788e-1_wp ) * xx + 6.228644e-1_wp elseif ( xx >- 2 2.0_wp ) then gg = (((((((( - 8.1537735e-14_wp * xx + 8.3232531e-13_wp ) * xx + & 1.0066362e-9_wp ) * xx + 8.1048663e-8_wp ) * xx + & 3.2916354e-6_wp ) * xx + 8.2711096e-5_wp ) * xx + & 1.3714667e-3_wp ) * xx + 1.5017245e-2_wp ) * xx + & 4.3432642e-1_wp ) * xx + 6.2337691e-1_wp else gg = 3.33338e-1_wp * xx + 3.0062102e-1_wp endif fl = exp ( log (( 1.0_wp + exp ( gg )) * dimob0 ) / 3.0_wp ) end associate end subroutine shellg !***************************************************************************************** !> ! subroutine used for field line tracing in [[shellg]]. ! calls entry point [[feldi]] in geomagnetic field subroutine [[feldg]] subroutine stoer ( me , p , bq , r ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 7 ), intent ( inout ) :: p real ( wp ), intent ( out ) :: bq real ( wp ), intent ( out ) :: r real ( wp ) :: dr , dsq , dx , dxm , dy , dym , dz , & dzm , fli , q , rq , wr , xm , ym , zm ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates zm = P ( 3 ) fli = P ( 1 ) * P ( 1 ) + P ( 2 ) * P ( 2 ) + 1.0e-15_wp R = 0.5_wp * ( fli + sqrt ( fli * fli + ( zm + zm ) ** 2 )) rq = R * R wr = sqrt ( R ) xm = P ( 1 ) * wr ym = P ( 2 ) * wr ! transform to geographic co-ordinate system me % Xi ( 1 ) = xm * u ( 1 , 1 ) + ym * u ( 1 , 2 ) + zm * u ( 1 , 3 ) me % Xi ( 2 ) = xm * u ( 2 , 1 ) + ym * u ( 2 , 2 ) + zm * u ( 2 , 3 ) me % Xi ( 3 ) = xm * u ( 3 , 1 ) + zm * u ( 3 , 3 ) ! compute derivatives ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results ! are the same; dkb Feb 1998. ! JW : feb 2024 : xi, h now class variables. call me % feldi () q = me % H ( 1 ) / rq dx = me % H ( 3 ) + me % H ( 3 ) + q * me % Xi ( 1 ) dy = me % H ( 4 ) + me % H ( 4 ) + q * me % Xi ( 2 ) dz = me % H ( 2 ) + me % H ( 2 ) + q * me % Xi ( 3 ) ! transform back to geomagnetic co-ordinate system dxm = u ( 1 , 1 ) * dx + u ( 2 , 1 ) * dy + u ( 3 , 1 ) * dz dym = u ( 1 , 2 ) * dx + u ( 2 , 2 ) * dy dzm = u ( 1 , 3 ) * dx + u ( 2 , 3 ) * dy + u ( 3 , 3 ) * dz dr = ( xm * dxm + ym * dym + zm * dzm ) / R ! form slowly varying expressions P ( 4 ) = ( wr * dxm - 0.5_wp * P ( 1 ) * dr ) / ( R * dzm ) P ( 5 ) = ( wr * dym - 0.5_wp * P ( 2 ) * dr ) / ( R * dzm ) dsq = rq * ( dxm * dxm + dym * dym + dzm * dzm ) Bq = dsq * rq * rq P ( 6 ) = sqrt ( dsq / ( rq + 3.0_wp * zm * zm )) P ( 7 ) = P ( 6 ) * ( rq + zm * zm ) / ( rq * dzm ) end subroutine stoer !***************************************************************************************** !> ! Calculates earth magnetic field from spherical harmonics model ! !### Reference ! ref: g. kluge, european space operations centre, internal note 61, ! 1970. ! !### History ! * changes (d. bilitza, nov 87): ! - field coefficients in binary data files instead of block data ! - calculates dipol moment ! !@note In the original code, [[feldc] and [[feldi]] were ! ENTRY points to this routine subroutine feldg ( me , glat , glon , alt , bnorth , beast , bdown , babs ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( out ) :: bnorth , beast , bdown !! components of the field with respect !! to the local geodetic coordinate system, with axis !! pointing in the tangential plane to the north, east !! and downward. real ( wp ), intent ( out ) :: Babs !! magnetic field strength in gauss real ( wp ) :: brho , bxxx , byyy , bzzz , cp , ct , d , f , rho , & rlat , rlon , rq , s , sp , st , t , & x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m ! same calculation as geo_to_cart, but not used here ! because the intermediate variables are also used below. rlat = glat * umr ct = sin ( rlat ) st = cos ( rlat ) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rlon = glon * umr cp = cos ( rlon ) sp = sin ( rlon ) zzz = ( alt + bquad / d ) * ct / era rho = ( alt + aquad / d ) * st / era xxx = rho * cp yyy = rho * sp rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) bxxx = t * ( me % h ( 3 ) - s * xxx ) byyy = t * ( me % h ( 4 ) - s * yyy ) bzzz = t * ( me % h ( 2 ) - s * zzz ) babs = sqrt ( bxxx * bxxx + byyy * byyy + bzzz * bzzz ) beast = byyy * cp - bxxx * sp brho = byyy * sp + bxxx * cp bnorth = bzzz * st - brho * ct bdown =- bzzz * ct - brho * st end subroutine feldg !***************************************************************************************** !> ! Alternate version of [[feldg]] to be used with cartesian coordinates subroutine feldc ( me , v , b ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( out ) :: b ( 3 ) !! field components real ( wp ) :: f , rq , s , t , x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m xxx = v ( 1 ) yyy = v ( 2 ) zzz = v ( 3 ) rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) b ( 1 ) = t * ( me % h ( 3 ) - s * xxx ) b ( 2 ) = t * ( me % h ( 4 ) - s * yyy ) b ( 3 ) = t * ( me % h ( 2 ) - s * zzz ) end subroutine feldc !***************************************************************************************** !> ! Used for `l` computation. subroutine feldi ( me ) class ( shellig_type ), intent ( inout ) :: me real ( wp ) :: f , x , y , z integer :: i , ih , ihmax , il , imax , k , last , m ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do end subroutine feldi !***************************************************************************************** !> ! Determines coefficients and dipol moment from IGRF models ! !### Author ! * D. BILITZA, NSSDC, GSFC, CODE 633, GREENBELT, MD 20771, ! (301) 286-9536 NOV 1987. ! !### History ! * corrected for 2000 update - dkb- 5/31/2000 ! * updated to IGRF-2000 version -dkb- 5/31/2000 ! * updated to IGRF-2005 version -dkb- 3/24/2000 subroutine feldcof ( me , year , dimo ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: dimo !! geomagnetic dipol moment in gauss (normalized !! to earth's radius) at the time (year) real ( wp ) :: dte1 , dte2 , erad , gha ( 144 ) , sqrt2 integer :: i , ier , j , l , m , n , iyea character ( len = :), allocatable :: fil2 real ( wp ) :: x , f0 , f !! these were double precision in original !! code while everything else was single precision ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1 character ( len = filename_len ), dimension ( 17 ), parameter :: filmod = [& 'dgrf1945.dat ' , 'dgrf1950.dat ' , 'dgrf1955.dat ' , 'dgrf1960.dat ' , & 'dgrf1965.dat ' , 'dgrf1970.dat ' , 'dgrf1975.dat ' , 'dgrf1980.dat ' , & 'dgrf1985.dat ' , 'dgrf1990.dat ' , 'dgrf1995.dat ' , 'dgrf2000.dat ' , & 'dgrf2005.dat ' , 'dgrf2010.dat ' , 'dgrf2015.dat ' , 'igrf2020.dat ' , & 'igrf2020s.dat' ] real ( wp ), dimension ( 17 ), parameter :: dtemod = [ 194 5.0_wp , 195 0.0_wp , 195 5.0_wp , & 196 0.0_wp , 196 5.0_wp , 197 0.0_wp , & 197 5.0_wp , 198 0.0_wp , 198 5.0_wp , & 199 0.0_wp , 199 5.0_wp , 200 0.0_wp , & 200 5.0_wp , 201 0.0_wp , 201 5.0_wp , & 202 0.0_wp , 202 5.0_wp ] integer , parameter :: numye = size ( dtemod ) - 1 ! number of 5-year priods represented by IGRF integer , parameter :: is = 0 !! * is=0 for schmidt normalization !! * is=1 gauss normalization logical :: read_file !-- determine igrf-years for input-year me % time = year iyea = int ( year / 5.0_wp ) * 5 read_file = iyea /= me % iyea ! if we have to read the file me % iyea = iyea l = ( me % iyea - 1945 ) / 5 + 1 if ( l < 1 ) l = 1 if ( l > numye ) l = numye dte1 = dtemod ( l ) me % name = me % get_data_file_dir () // trim ( filmod ( l )) dte2 = dtemod ( l + 1 ) fil2 = me % get_data_file_dir () // trim ( filmod ( l + 1 )) if ( read_file ) then ! get igrf coefficients for the boundary years ! [if they have not ready been loaded] call getshc ( me % name , me % nmax1 , erad , me % g , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( me % name ) me % g_cache = me % g ! because it is modified below, we have to cache the original values from the file call getshc ( fil2 , me % nmax2 , erad , me % gh2 , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( fil2 ) else me % g = me % g_cache end if !-- determine igrf coefficients for year if ( l <= numye - 1 ) then call intershc ( year , dte1 , me % nmax1 , me % g , dte2 , me % nmax2 , me % gh2 , me % nmax , gha ) else call extrashc ( year , dte1 , me % nmax1 , me % g , me % nmax2 , me % gh2 , me % nmax , gha ) endif !-- determine magnetic dipol moment and coeffiecients g f0 = 0.0_wp do j = 1 , 3 f = gha ( j ) * 1.0e-5_wp f0 = f0 + f * f enddo dimo = sqrt ( f0 ) me % g ( 1 ) = 0.0_wp i = 2 f0 = 1.0e-5_wp if ( is == 0 ) f0 = - f0 sqrt2 = sqrt ( 2.0_wp ) do n = 1 , me % nmax x = n f0 = f0 * x * x / ( 4.0_wp * x - 2.0_wp ) if ( is == 0 ) f0 = f0 * ( 2.0_wp * x - 1.0_wp ) / x f = f0 * 0.5_wp if ( is == 0 ) f = f * sqrt2 me % g ( i ) = gha ( i - 1 ) * f0 i = i + 1 do m = 1 , n f = f * ( x + m ) / ( x - m + 1.0_wp ) if ( is == 0 ) f = f * sqrt (( x - m + 1.0_wp ) / ( x + m )) me % g ( i ) = gha ( i - 1 ) * f me % g ( i + 1 ) = gha ( i ) * f i = i + 2 enddo enddo end subroutine feldcof !***************************************************************************************** !> ! Reads spherical harmonic coefficients from the specified ! file into an array. ! !### Author ! * Version 1.01, A. Zunde, USGS, MS 964, ! Box 25046 Federal Center, Denver, CO 80225 subroutine getshc ( Fspec , Nmax , Erad , Gh , Ier ) character ( len =* ), intent ( in ) :: Fspec !! File specification integer , intent ( out ) :: Nmax !! Maximum degree and order of model real ( wp ), intent ( out ) :: Erad !! Earth's radius associated with the spherical !! harmonic coefficients, in the same units as !! elevation real ( wp ), dimension ( * ), intent ( out ) :: Gh !! Schmidt quasi-normal internal spherical !! harmonic coefficients integer , intent ( out ) :: Ier !! Error number: !! !! * 0, no error !! * -2, records out of order !! * FORTRAN run-time error number integer :: iu !! logical unit number real ( wp ) :: g , h integer :: i , m , mm , n , nn read_file : block ! --------------------------------------------------------------- ! Open coefficient file. Read past first header record. ! Read degree and order of model and Earth's radius. ! --------------------------------------------------------------- OPEN ( newunit = Iu , FILE = Fspec , STATUS = 'OLD' , IOSTAT = Ier ) if ( Ier /= 0 ) then write ( * , * ) 'Error opening file: ' // trim ( fspec ) exit read_file end if READ ( Iu , * , IOSTAT = Ier ) if ( Ier /= 0 ) exit read_file READ ( Iu , * , IOSTAT = Ier ) Nmax , Erad if ( Ier /= 0 ) exit read_file ! --------------------------------------------------------------- ! Read the coefficient file, arranged as follows: ! ! N M G H ! ---------------------- ! / 1 0 GH(1) - ! / 1 1 GH(2) GH(3) ! / 2 0 GH(4) - ! / 2 1 GH(5) GH(6) ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8) ! records \\ 3 0 GH(9) - ! \\ . . . . ! \\ . . . . ! NMAX*(NMAX+2) \\ . . . . ! elements in GH \\ NMAX NMAX . . ! ! N and M are, respectively, the degree and order of the ! coefficient. ! --------------------------------------------------------------- i = 0 main : DO nn = 1 , Nmax DO mm = 0 , nn READ ( Iu , * , IOSTAT = Ier ) n , m , g , h if ( Ier /= 0 ) exit main IF ( nn /= n . OR . mm /= m ) THEN Ier = - 2 EXIT main ENDIF i = i + 1 Gh ( i ) = g IF ( m /= 0 ) THEN i = i + 1 Gh ( i ) = h ENDIF ENDDO ENDDO main end block read_file CLOSE ( Iu ) END subroutine getshc !***************************************************************************************** !> ! Interpolates linearly, in time, between two spherical ! harmonic models. ! ! The coefficients (GH) of the resulting model, at date ! DATE, are computed by linearly interpolating between the ! coefficients of the earlier model (GH1), at date DTE1, ! and those of the later model (GH2), at date DTE2. If one ! model is smaller than the other, the interpolation is ! performed with the missing coefficients assumed to be 0. ! !### Author ! * Version 1.01, A. Zunde ! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 subroutine intershc ( date , dte1 , nmax1 , gh1 , dte2 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of earlier model integer , intent ( in ) :: nmax1 !! Maximum degree and order of earlier model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real ( wp ), intent ( in ) :: dte2 !! Date of later model integer , intent ( in ) :: nmax2 !! Maximum degree and order of later model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) / ( dte2 - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) + factor * ( - gh1 ( i )) enddo nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) enddo nmax = nmax2 endif do i = 1 , k gh ( i ) = gh1 ( i ) + factor * ( gh2 ( i ) - gh1 ( i )) enddo end subroutine intershc !***************************************************************************************** !> ! Extrapolates linearly a spherical harmonic model with a ! rate-of-change model. ! ! The coefficients (GH) of the resulting model, at date ! DATE, are computed by linearly extrapolating the coef- ! ficients of the base model (GH1), at date DTE1, using ! those of the rate-of-change model (GH2), at date DTE2. If ! one model is smaller than the other, the extrapolation is ! performed with the missing coefficients assumed to be 0. ! !### Author ! * Version 1.01, A. Zunde ! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 subroutine extrashc ( date , dte1 , nmax1 , gh1 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of base model integer , intent ( in ) :: nmax1 !! Maximum degree and order of base model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model integer , intent ( in ) :: nmax2 !! Maximum degree and order of rate-of-change model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) enddo nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) enddo nmax = nmax2 endif do i = 1 , k gh ( i ) = gh1 ( i ) + factor * gh2 ( i ) enddo end subroutine extrashc !***************************************************************************************** !> ! geodetic to scaled cartesian coordinates pure function geo_to_cart ( glat , glon , alt ) result ( x ) real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), dimension ( 3 ) :: x !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ) :: rlat !! latitude in radians real ( wp ) :: rlon !! longitude in radians real ( wp ) :: d , rho ! deg to radians: rlat = glat * umr rlon = glon * umr ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code associate ( ct => sin ( rlat ), st => cos ( rlat ), cp => cos ( rlon ), sp => sin ( rlon )) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rho = ( alt + aquad / d ) * st / era x = [ rho * cp , rho * sp , ( alt + bquad / d ) * ct / era ] end associate end function geo_to_cart end module SHELLIG_module","tags":"","loc":"sourcefile/shellig.f90.html"}]}
\ No newline at end of file
+var tipuesearch = {"pages":[{"title":" radbelt ","text":"radbelt Radbelt: Work in progress to refactor the AE-8/AP-8 Van Allen belt model. Status Compiling A Fortran Package Manager manifest file is included, so that the library and test cases can be compiled with FPM. For example: fpm build --profile release\nfpm test --profile release To use radbelt within your fpm project, add the following to your fpm.toml file: [dependencies] radbelt = { git = \"https://github.com/jacobwilliams/radbelt.git\" } Documentation The latest API documentation can be found here . This was generated from the source code using FORD . Original source The original sourcecode was hosted at GSFC \"Modelweb\", an archive of which can be found here . It is presumed to be in the public domain. Reference: National Space Science Data Center, Data set PT-11B, Mar 1996. Dieter Bilitza, GSFC/NSSDC code 633, Greenbelt, MD 20771. See also NASA ModelWebArchive Archive (IGRF) NASA ModelWebArchive Archive (RADBELT) International Geomagnetic Reference Field An Astropy-friendly wrapper for the AE-8/AP-8 Van Allen belt model pyIGRF https://github.com/lanl/RAM-SCB/blob/master/srcExternal/igrf.f https://github.com/space-physics/igrf/blob/main/src/igrf/fortran/igrf13.f Test case See the radbelt_test.f90 and test.py files: Code Runtime (sec) Cases per second Python version 3.514 409 Fortran Function version ( get_flux() ) 1.622 1198 Fortran Class version ( radbelt_type%get_flux() ) 0.017 112259 The main difference in speed from using the class method is that the data files are only read once, rather than each time the function is called (which is done in the other two versions). Brief description These empirical models describe the differential or\nintegral, omnidirectional fluxes of electrons (AE-8) and protons\n(AP-8) in the inner and outer radiation belts (electrons: L=1.1\nto 11, protons: L=1.1 to 7) for two epochs representing solar\nmaximum (1970) and minimum (1964) conditions. The energy spectrum\nranges from 0.1 to 400 MeV for the protons and from 0.04 to 7 MeV\nfor the electrons. AE-8 and AP-8 are the most recent ones in a\nseries of models established by J. Vette and his colleges at NSSDC\nstarting in the early sixties. The models are based on almost all\navailable satellite data. It is IMPORTANT that the models maps for\nsolar maximum are used with a magnetic field model for epoch=1970\nand for solar minimum for epoch=1964. For each epoch and particle the model consists of a three-\ndimensional table of (logarithm of) particle fluxes in energy, L-value,\nand B/B0 (magnetic field strength normalized to the equator). The program\nMODEL finds the particle fluxes for given energy, L-value and B/B0 by\ninterpolating in energy (subroutine TRARA1) and in L * B/B0 space (TRARA2).\nThe program RADBELT produces tables of integral or differential fluxes\nfor different energies varying with L or B/B0. The coefficient files are provided in ASCII (*.asc) format: Description Filename Size (KB) AE-8, epoch 1970, solar maximum ae8max.asc 84 AE-8, epoch 1964, solar minimum ae8min.asc 81 AP-8, epoch 1970, solar maximum ap8max.asc 101 AP-8, epoch 1964, solar minimum ap8min.asc 102 In March 1995 the earlier used compressed model maps AP8MIC and AP8MAC\nwere replaced with the full maps AP8MIN/MAX with the help of D. Heynderickx\n(BIRA, Brussel, Belgium) and A. Beliaev (INP/MSU, Moscow, Russia). Heynderickx\nand Beliaev (1995) had found and corrected a small error in the AP8MIN map;\ntwo lines had been exchanged. References G.W. Singley, and J.I. Vette, The AE-4 Model of the Outer Radiation Zone Electron Environment , NSSDC/WDC-A-R&S 72-06, 1972. M.J. Teague, and J.I. Vette, A Model of the Trapped Electron Population for Solar Minimum (AE-5) , NSSDC/WDC-A-R&S 74-03, 1974. M.J. Teague, K.W. Chan, and J.I. Vette, AE-6: A Model Environment of Trapped Electrons for Solar Maximum , NSSDC/WDC-A-R&S 76-04, 1976 D.W. Sawyer, and J.I. Vette, AP-8 Trapped Proton Environment for Solar Maximum and Minimum, NSSDC/WDC-A-R&S 76-06, 1976. J.I. Vette, K.W. Chan, and M.J. Teague, Problems in Modeling the Earth's Trapped Radiation Environment , AFGL-TR-78-0130, 1978. K.W. Chan, M.J. Teague, N.J. Schofield, and J.I. Vette, Modeling of Electron Time Variation in the Radiation Belts, p. 121-149, in: Quantitative Modeling of Magnetospheric Processes, W.P. Olson (ed.), geophysical monograph 21, American Geophysical Union, 1979. M.T. Teague, N.J. Schofield, K.W. Chan, and J.I. Vette, A Study of Inner Zone Electron Data and their Comparison with Trapped Radiation Models , NSSDC/WDC-A-R&S 79-06, 1979. J.I. Vette, The AE-8 Trapped Electron Model Environment , NSSDC/WDC-A-R&S 91-24, 1991. J.I. Vette, The NASA/National Space Science Data Center Trapped Radiation Environment Model Program (1964-1991) , NSSDC/WDC-A-R&S 91-29, 1991. D. Heynderickx and A. Beliaev, Identification of an error in the distribution of the NASA model AP-8 MIN , J. Spacecraft and Rockets 32, 190-192, 1995. Developer Info Jacob Williams","tags":"home","loc":"index.html"},{"title":"radbelt_type – radbelt ","text":"type, public :: radbelt_type the main class that can be used to get the flux. Inherits type~~radbelt_type~~InheritsGraph type~radbelt_type radbelt_type type~shellig_type shellig_type type~radbelt_type->type~shellig_type igrf type~trm_type trm_type type~radbelt_type->type~trm_type trm Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial type( trm_type ), private :: trm type( shellig_type ), private :: igrf Type-Bound Procedures generic, public :: get_flux => get_flux_g_ , get_flux_c_ public function get_flux_g_ (me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c_ (me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. procedure, private :: get_flux_c_ public function get_flux_c_ (me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. procedure, private :: get_flux_g_ public function get_flux_g_ (me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. procedure, public :: set_data_files_paths public subroutine set_data_files_paths (me, aep8_dir, igrf_dir) Set the paths to the data files.\nIf not used or blank, the folder data/aep8 and data/igrf in the\ncurrent working directory is assumed Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: aep8_dir character(len=*), intent(in) :: igrf_dir procedure, public :: set_igrf_file_path public subroutine set_igrf_file_path (me, dir) Set the igrf path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir procedure, public :: set_trm_file_path public subroutine set_trm_file_path (me, dir) Set the trm path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir Source Code type , public :: radbelt_type !! the main class that can be used to get the flux. private type ( trm_type ) :: trm type ( shellig_type ) :: igrf contains private generic , public :: get_flux => get_flux_g_ , get_flux_c_ procedure :: get_flux_g_ , get_flux_c_ procedure , public :: set_trm_file_path , & set_igrf_file_path , & set_data_files_paths end type radbelt_type","tags":"","loc":"type/radbelt_type.html"},{"title":"trm_type – radbelt ","text":"type, public :: trm_type main class for the aep8 model Inherited by type~~trm_type~~InheritedByGraph type~trm_type trm_type type~radbelt_type radbelt_type type~radbelt_type->type~trm_type trm Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: aep8_dir directory containing the data files character(len=:), private, allocatable :: file_loaded the file that has been loaded integer, private, dimension(8) :: ihead = 0 integer, private, dimension(:), allocatable :: map real(kind=wp), private :: fistep = 0.0_wp the stepsize for the parameterization of the logarithm of flux.\nformerly stored in common block tra2 real(kind=wp), private :: f1 = 1.001_wp real(kind=wp), private :: f2 = 1.002_wp Type-Bound Procedures procedure, public :: aep8 main routine private subroutine aep8 (me, e, l, bb0, imname, flux) Main wrapper for the radiation model.\nReads the coefficient file and calls the low-level routine. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me real(kind=wp), intent(in) :: e real(kind=wp), intent(in) :: l real(kind=wp), intent(in) :: bb0 integer, intent(in) :: imname which model to load (index in mname array) real(kind=wp), intent(out) :: flux procedure, public :: trara2 low-level routine private function trara2 (me, map, il, ib) trara2 interpolates linearly in l-b/b0-map to obtain\n the logarithm of integral flux at given l and b/b0. Read more… Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: map (*) is sub-map (for specific energy) of\ntrapped radiation model map integer, intent(in) :: il scaled l-value integer, intent(in) :: ib scaled b/b0-1 Return Value real(kind=wp) scaled logarithm of particle flux procedure, public :: trara1 private subroutine trara1 (me, descr, map, fl, bb0, e, f, n) trara1 finds particle fluxes for given energies, magnetic field\nstrength and l-value. function trara2 is used to interpolate in\nb-l-space. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: descr (8) header of specified trapped radition model integer, intent(in) :: map (*) map of trapped radition model\n(descr and map are explained at the begin\nof the main program model) real(kind=wp), intent(in) :: fl l-value real(kind=wp), intent(in) :: bb0 =b/b0 magnetic field strength normalized\nto field strength at magnetic equator real(kind=wp), intent(in) :: e (n) array of energies in mev real(kind=wp), intent(out) :: f (n) decadic logarithm of integral fluxes in\nparticles/(cm cm sec) integer, intent(in) :: n number of energies procedure, public :: get_data_file_dir private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(in) :: me Return Value character(len=:), allocatable procedure, public :: set_data_file_dir private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me character(len=*), intent(in) :: dir Source Code type , public :: trm_type !! main class for the `aep8` model private character ( len = :), allocatable :: aep8_dir !! directory containing the data files ! data read from the files: character ( len = :), allocatable :: file_loaded !! the file that has been loaded integer , dimension ( 8 ) :: ihead = 0 integer , dimension (:), allocatable :: map real ( wp ) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux. !! formerly stored in common block `tra2` ! formerly saved variables in trara1: real ( wp ) :: f1 = 1.001_wp real ( wp ) :: f2 = 1.002_wp contains private procedure , public :: aep8 !! main routine procedure , public :: trara1 , trara2 !! low-level routine procedure , public :: set_data_file_dir , get_data_file_dir end type trm_type","tags":"","loc":"type/trm_type.html"},{"title":"shellig_type – radbelt ","text":"type, public :: shellig_type Inherited by type~~shellig_type~~InheritedByGraph type~shellig_type shellig_type type~radbelt_type radbelt_type type~radbelt_type->type~shellig_type igrf Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: igrf_dir directory containing the data files real(kind=wp), private, dimension(3) :: sp = 0.0_wp real(kind=wp), private, dimension(3) :: xi = 0.0_wp real(kind=wp), private, dimension(144) :: h = 0.0_wp Field model coefficients adjusted for shellg integer, private :: iyea = 0 the int year corresponding to the file name that has been read character(len=:), private, allocatable :: name file name integer, private :: nmax = 0 maximum order of spherical harmonics real(kind=wp), private :: Time = 0.0_wp year (decimal: 1973.5) for which magnetic field is to be calculated real(kind=wp), private, dimension(144) :: g = 0.0_wp g(m) -- normalized field coefficients (see feldcof ) m=nmax*(nmax+2) integer, private :: nmax1 = 0 saved variables from the file integer, private :: nmax2 = 0 saved variables from the file real(kind=wp), private, dimension(144) :: g_cache = 0.0_wp saved g from the file real(kind=wp), private :: step = 0.20_wp step size for field line tracing real(kind=wp), private :: steq = 0.03_wp step size for integration real(kind=wp), private, dimension(120) :: gh2 = 0.0_wp real(kind=wp), private, dimension(:, :), allocatable :: p this was p(8,100) in the original code.\nused for the field line integration loop.\nchanged it to be allocatable since it was\nchanged to be p(8,3334). Type-Bound Procedures procedure, public :: igrfc private subroutine igrfc (me, v, year, xl, bbx) Alternate version of igrf for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio procedure, public :: igrf private subroutine igrf (me, lon, lat, height, year, xl, bbx) Wrapper for IGRF functions. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio procedure, public :: feldcof private subroutine feldcof (me, year, dimo) Determines coefficients and dipol moment from IGRF models Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: dimo geomagnetic dipol moment in gauss (normalized\nto earth's radius) at the time (year) procedure, public :: feldc private subroutine feldc (me, v, b) Alternate version of feldg to be used with cartesian coordinates Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(out) :: b (3) field components procedure, public :: feldg private subroutine feldg (me, glat, glon, alt, bnorth, beast, bdown, Babs) Calculates earth magnetic field from spherical harmonics model Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(out) :: bnorth components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: beast components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: bdown components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: Babs magnetic field strength in gauss procedure, public :: shellc private subroutine shellc (me, v, dimo, fl, icode, b0) Wrapper to shellg to be used with cartesian coordinates. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\n* x-axis pointing to equator at 0 longitude\n* y-axis pointing to equator at 90 long.\n* z-axis pointing to north pole real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss procedure, public :: shellg private subroutine shellg (me, glat, glon, alt, dimo, fl, icode, b0, v) calculates l-value for specified geodaetic coordinates, altitude\n and gemagnetic field model. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss real(kind=wp), intent(in), optional, dimension(3) :: v cartesian coordinates in earth radii (6371.2 km) Read more… procedure, public :: findb0 private subroutine findb0 (me, stps, bdel, value, bequ, rr0) Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: stps real(kind=wp), intent(inout) :: bdel logical, intent(out) :: value real(kind=wp), intent(out) :: bequ real(kind=wp), intent(out) :: rr0 procedure, private :: feldi private subroutine feldi (me) Used for l computation. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me procedure, private :: stoer private subroutine stoer (me, p, bq, r) subroutine used for field line tracing in shellg .\ncalls entry point feldi in geomagnetic field subroutine feldg Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(inout), dimension(7) :: p real(kind=wp), intent(out) :: bq real(kind=wp), intent(out) :: r procedure, public :: get_data_file_dir private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(in) :: me Return Value character(len=:), allocatable procedure, public :: set_data_file_dir private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me character(len=*), intent(in) :: dir procedure, public :: destroy => destroy_shellig_type private subroutine destroy_shellig_type (me) Destroy a shellig_type . Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(out) :: me Source Code type , public :: shellig_type private character ( len = :), allocatable :: igrf_dir !! directory containing the data files ! formerly in the `fidb0` common block real ( wp ), dimension ( 3 ) :: sp = 0.0_wp ! formerly in blank common real ( wp ), dimension ( 3 ) :: xi = 0.0_wp real ( wp ), dimension ( 144 ) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]] ! formerly in `model` common block integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read character ( len = :), allocatable :: name !! file name integer :: nmax = 0 !! maximum order of spherical harmonics real ( wp ) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated real ( wp ), dimension ( 144 ) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2) integer :: nmax1 = 0 !! saved variables from the file integer :: nmax2 = 0 !! saved variables from the file real ( wp ), dimension ( 144 ) :: g_cache = 0.0_wp !! saved `g` from the file ! formerly saved vars in shellg: real ( wp ) :: step = 0.20_wp !! step size for field line tracing real ( wp ) :: steq = 0.03_wp !! step size for integration ! from feldcof, so we can cache the coefficients real ( wp ), dimension ( 120 ) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ??? real ( wp ), dimension (:, :), allocatable :: p !! this was `p(8,100)` in the original code. !! used for the field line integration loop. !! changed it to be allocatable since it was !! changed to be p(8,3334). contains private procedure , public :: igrf , igrfc procedure , public :: feldcof procedure , public :: feldg , feldc procedure , public :: shellg , shellc procedure , public :: findb0 procedure :: stoer , feldi procedure , public :: set_data_file_dir , get_data_file_dir procedure , public :: destroy => destroy_shellig_type end type shellig_type","tags":"","loc":"type/shellig_type.html"},{"title":"get_flux_g_ – radbelt","text":"public function get_flux_g_(me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_g_~~CallsGraph proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_g_~~CalledByGraph proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_g_ ( me , lon , lat , height , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrf ( lon , lat , height , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_g_","tags":"","loc":"proc/get_flux_g_.html"},{"title":"get_flux_g – radbelt","text":"public function get_flux_g(lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_g~~CallsGraph proc~get_flux_g radbelt_module::get_flux_g none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_g->none~get_flux proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_g~~CalledByGraph proc~get_flux_g radbelt_module::get_flux_g interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_g ( lon , lat , height , year , e , imname ) result ( flux ) real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( lon , lat , height , year , e , imname ) end function get_flux_g","tags":"","loc":"proc/get_flux_g.html"},{"title":"get_flux_c_ – radbelt","text":"public function get_flux_c_(me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_c_~~CallsGraph proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~feldcof shellig_module::shellig_type%feldcof proc~igrfc->proc~feldcof proc~findb0 shellig_module::shellig_type%findb0 proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellc->proc~shellg proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~shellg->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_c_~~CalledByGraph proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_c_ ( me , v , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrfc ( v , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_c_","tags":"","loc":"proc/get_flux_c_.html"},{"title":"get_flux_c – radbelt","text":"public function get_flux_c(v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_c~~CallsGraph proc~get_flux_c radbelt_module::get_flux_c none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_c->none~get_flux proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~get_flux_c~~CalledByGraph proc~get_flux_c radbelt_module::get_flux_c interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_flux_c ( v , year , e , imname ) result ( flux ) real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( v , year , e , imname ) end function get_flux_c","tags":"","loc":"proc/get_flux_c.html"},{"title":"set_trm_file_path – radbelt","text":"public subroutine set_trm_file_path(me, dir) Set the trm path. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir Calls proc~~set_trm_file_path~~CallsGraph proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_trm_file_path~~CalledByGraph proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_trm_file_path proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~set_trm_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_trm_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % trm % set_data_file_dir ( trim ( dir )) end subroutine set_trm_file_path","tags":"","loc":"proc/set_trm_file_path.html"},{"title":"set_igrf_file_path – radbelt","text":"public subroutine set_igrf_file_path(me, dir) Set the igrf path. Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir Calls proc~~set_igrf_file_path~~CallsGraph proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_igrf_file_path~~CalledByGraph proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_igrf_file_path proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~set_igrf_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_igrf_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % igrf % set_data_file_dir ( trim ( dir )) end subroutine set_igrf_file_path","tags":"","loc":"proc/set_igrf_file_path.html"},{"title":"set_data_files_paths – radbelt","text":"public subroutine set_data_files_paths(me, aep8_dir, igrf_dir) Set the paths to the data files.\nIf not used or blank, the folder data/aep8 and data/igrf in the\ncurrent working directory is assumed Type Bound radbelt_type Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: aep8_dir character(len=*), intent(in) :: igrf_dir Calls proc~~set_data_files_paths~~CallsGraph proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_files_paths->proc~set_igrf_file_path proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_files_paths->proc~set_trm_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_data_files_paths~~CalledByGraph proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_files_paths ( me , aep8_dir , igrf_dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: aep8_dir character ( len =* ), intent ( in ) :: igrf_dir call me % set_trm_file_path ( trim ( aep8_dir )) call me % set_igrf_file_path ( trim ( igrf_dir )) end subroutine set_data_files_paths","tags":"","loc":"proc/set_data_files_paths.html"},{"title":"get_flux – radbelt","text":"public interface get_flux simple function versions for testing Calls interface~~get_flux~~CallsGraph interface~get_flux radbelt_module::get_flux proc~get_flux_c radbelt_module::get_flux_c interface~get_flux->proc~get_flux_c proc~get_flux_g radbelt_module::get_flux_g interface~get_flux->proc~get_flux_g none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_c->none~get_flux proc~get_flux_g->none~get_flux proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures public function get_flux_g (lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c (v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1.","tags":"","loc":"interface/get_flux.html"},{"title":"get_data_file_dir – radbelt","text":"private function get_data_file_dir(me) result(dir) Get the directory containing the data files. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(in) :: me Return Value character(len=:), allocatable Called by proc~~get_data_file_dir~~CalledByGraph proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8 trmfun_module::trm_type%aep8 proc~aep8->proc~get_data_file_dir proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_data_file_dir ( me ) result ( dir ) class ( trm_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % aep8_dir )) then dir = trim ( me % aep8_dir ) // '/' else dir = 'data/aep8/' ! default end if end function get_data_file_dir","tags":"","loc":"proc/get_data_file_dir.html"},{"title":"trara2 – radbelt","text":"private function trara2(me, map, il, ib) trara2 interpolates linearly in l-b/b0-map to obtain\n the logarithm of integral flux at given l and b/b0. Note see main program 'model' for explanation of map format\n scaling factors. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: map (*) is sub-map (for specific energy) of\ntrapped radiation model map integer, intent(in) :: il scaled l-value integer, intent(in) :: ib scaled b/b0-1 Return Value real(kind=wp) scaled logarithm of particle flux Called by proc~~trara2~~CalledByGraph proc~trara2 trmfun_module::trm_type%trara2 proc~trara1 trmfun_module::trm_type%trara1 proc~trara1->proc~trara2 proc~aep8 trmfun_module::trm_type%aep8 proc~aep8->proc~trara1 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function trara2 ( me , map , il , ib ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: map ( * ) !! is sub-map (for specific energy) of !! trapped radiation model map integer , intent ( in ) :: il !! scaled l-value integer , intent ( in ) :: ib !! scaled b/b0-1 real ( wp ) :: trara2 !! scaled logarithm of particle flux real ( wp ) :: dfl , fincr1 , fincr2 , fistep , fkb , fkb1 , fkb2 , fkbj1 , fkbj2 , & fkbm , fll1 , fll2 , flog , flog1 , flog2 , flogm , & fnb , fnl , sl1 , sl2 integer :: i1 , i2 , itime , j1 , j2 , kt , l1 , l2 logical :: dummy fistep = me % fistep !******** ! to avoid -Wmaybe-uninitialized warning dfl = 0.0_wp fincr1 = 0.0_wp fincr2 = 0.0_wp fkb = 0.0_wp fkb1 = 0.0_wp fkb2 = 0.0_wp fkbm = 0.0_wp flog = 0.0_wp flog1 = 0.0_wp flog2 = 0.0_wp flogm = 0.0_wp fnb = 0.0_wp fnl = 0.0_wp sl2 = 0.0_wp i1 = 0 i2 = 0 itime = 0 j2 = 0 l1 = 0 l2 = 0 !******** ! these are recursive functions that ! replace the gotos in the original code call task1 ( dummy ) contains recursive subroutine task1 ( done ) logical , intent ( out ) :: done done = . false . fnl = il fnb = ib itime = 0 i2 = 0 do ! find consecutive sub-sub-maps for scaled l-values ls1,ls2, ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps. ! i1,i2 are indeces of first elements minus 1. l2 = map ( i2 + 1 ) if ( map ( i2 + 2 ) <= il ) then i1 = i2 l1 = l2 i2 = i2 + l2 ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0 elseif (( l1 < 4 ) . and . ( l2 < 4 )) then trara2 = 0.0_wp done = . true . return else ! if flog2 less flog1, than ls2 first map and ls1 second map if ( map ( i2 + 3 ) <= map ( i1 + 3 )) exit call task3 ( done ) return end if end do call task2 ( done ) end subroutine task1 recursive subroutine task2 ( done ) logical , intent ( out ) :: done done = . false . kt = i1 i1 = i2 i2 = kt kt = l1 l1 = l2 l2 = kt call task3 ( done ) end subroutine task2 recursive subroutine task3 ( done ) logical , intent ( out ) :: done logical :: check done = . false . ! determine interpolate in scaled l-value fll1 = map ( i1 + 2 ) fll2 = map ( i2 + 2 ) dfl = ( fnl - fll1 ) / ( fll2 - fll1 ) flog1 = map ( i1 + 3 ) flog2 = map ( i2 + 3 ) fkb1 = 0.0_wp fkb2 = 0.0_wp if ( l1 >= 4 ) then ! b/b0 loop check = . true . do j2 = 4 , l2 fincr2 = map ( i2 + j2 ) if ( fkb2 + fincr2 > fnb ) then check = . false . exit end if fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep end do if ( check ) then itime = itime + 1 if ( itime == 1 ) then call task2 ( done ) return end if trara2 = 0.0_wp done = . true . return end if if ( itime /= 1 ) then if ( j2 == 4 ) then call task4 ( done ) return end if sl2 = flog2 / fkb2 check = . true . do j1 = 4 , l1 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) if ( fkbj1 <= fkb1 ) then check = . false . exit end if end do if ( check ) then if ( fkbj1 <= fkb2 ) then trara2 = 0.0_wp done = . true . return end if end if if ( fkbj1 <= fkb2 ) then fkbm = fkbj1 + ( fkb2 - fkbj1 ) * dfl flogm = fkbm * sl2 flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl1 = flog1 / fkb1 sl2 = flog2 / fkb2 call task5 ( done ) return else fkb1 = 0.0_wp end if end if fkb2 = 0.0_wp end if j2 = 4 fincr2 = map ( i2 + j2 ) flog2 = map ( i2 + 3 ) flog1 = map ( i1 + 3 ) call task4 ( done ) end subroutine task3 recursive subroutine task4 ( done ) logical , intent ( out ) :: done done = . false . flogm = flog1 + ( flog2 - flog1 ) * dfl fkbm = 0.0_wp fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep sl2 = flog2 / fkb2 if ( l1 < 4 ) then fincr1 = 0.0_wp sl1 = - 90000 0.0_wp call task6 ( done ) return else j1 = 4 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep sl1 = flog1 / fkb1 end if call task5 ( done ) end subroutine task4 recursive subroutine task5 ( done ) logical , intent ( out ) :: done done = . false . do while ( sl1 >= sl2 ) fkbj2 = (( flog2 / fistep ) * fincr2 + fkb2 ) / (( fincr2 / fistep ) * sl1 + 1.0_wp ) fkb = fkb1 + ( fkbj2 - fkb1 ) * dfl flog = fkb * sl1 if ( fkb >= fnb ) then call task7 ( done ) return end if fkbm = fkb flogm = flog if ( j1 >= l1 ) then trara2 = 0.0_wp done = . true . return else j1 = j1 + 1 fincr1 = map ( i1 + j1 ) flog1 = flog1 - fistep fkb1 = fkb1 + fincr1 sl1 = flog1 / fkb1 end if end do call task6 ( done ) end subroutine task5 recursive subroutine task6 ( done ) logical , intent ( out ) :: done done = . false . fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) fkb = fkbj1 + ( fkb2 - fkbj1 ) * dfl flog = fkb * sl2 if ( fkb < fnb ) then fkbm = fkb flogm = flog if ( j2 >= l2 ) then trara2 = 0.0_wp done = . true . return else j2 = j2 + 1 fincr2 = map ( i2 + j2 ) flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl2 = flog2 / fkb2 call task5 ( done ) return end if end if call task7 ( done ) end subroutine task6 recursive subroutine task7 ( done ) logical , intent ( out ) :: done if ( fkb < fkbm + 1.0e-10_wp ) then trara2 = 0.0_wp else trara2 = flogm + ( flog - flogm ) * (( fnb - fkbm ) / ( fkb - fkbm )) trara2 = max ( trara2 , 0.0_wp ) end if done = . true . end subroutine task7 end function trara2","tags":"","loc":"proc/trara2.html"},{"title":"set_data_file_dir – radbelt","text":"private subroutine set_data_file_dir(me, dir) Set the directory containing the data files. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me character(len=*), intent(in) :: dir Called by proc~~set_data_file_dir~~CalledByGraph proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_trm_file_path->proc~set_data_file_dir proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_trm_file_path proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~set_trm_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_file_dir ( me , dir ) class ( trm_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % aep8_dir = trim ( dir ) end subroutine set_data_file_dir","tags":"","loc":"proc/set_data_file_dir.html"},{"title":"aep8 – radbelt","text":"private subroutine aep8(me, e, l, bb0, imname, flux) Main wrapper for the radiation model.\nReads the coefficient file and calls the low-level routine. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me real(kind=wp), intent(in) :: e real(kind=wp), intent(in) :: l real(kind=wp), intent(in) :: bb0 integer, intent(in) :: imname which model to load (index in mname array) real(kind=wp), intent(out) :: flux Calls proc~~aep8~~CallsGraph proc~aep8 trmfun_module::trm_type%aep8 proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~aep8~~CalledByGraph proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine aep8 ( me , e , l , bb0 , imname , flux ) class ( trm_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: e real ( wp ), intent ( in ) :: l real ( wp ), intent ( in ) :: bb0 integer , intent ( in ) :: imname !! which model to load (index in `mname` array) real ( wp ), intent ( out ) :: flux real ( wp ) :: ee ( 1 ), f ( 1 ) !! temp variables integer :: i , ierr , iuaeap , nmap character ( len = :), allocatable :: name logical :: load_file name = me % get_data_file_dir () // trim ( mname ( Imname )) ! the file to load ! JW : do we need to reset some or all of these ? me % fistep = 0.0_wp me % f1 = 1.001_wp me % f2 = 1.002_wp ! check to see if this file has already been loaded ! [the class can store one file at a time] load_file = . true . if ( allocated ( me % file_loaded )) then if ( name == me % file_loaded ) load_file = . false . end if if ( load_file ) then open ( newunit = iuaeap , file = name , status = 'OLD' , iostat = ierr , form = 'FORMATTED' ) if ( ierr /= 0 ) then error stop 'error reading ' // trim ( name ) end if read ( iuaeap , '(1X,12I6)' ) me % ihead nmap = me % ihead ( 8 ) allocate ( me % map ( nmap )) read ( iuaeap , '(1X,12I6)' ) ( me % map ( i ), i = 1 , nmap ) close ( iuaeap ) me % file_loaded = trim ( name ) end if ee ( 1 ) = e call me % trara1 ( me % ihead , me % map , L , Bb0 , ee , f , 1 ) flux = f ( 1 ) if ( Flux > 0.0_wp ) Flux = 1 0.0_wp ** Flux end subroutine aep8","tags":"","loc":"proc/aep8.html"},{"title":"trara1 – radbelt","text":"private subroutine trara1(me, descr, map, fl, bb0, e, f, n) trara1 finds particle fluxes for given energies, magnetic field\nstrength and l-value. function trara2 is used to interpolate in\nb-l-space. Type Bound trm_type Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: descr (8) header of specified trapped radition model integer, intent(in) :: map (*) map of trapped radition model\n(descr and map are explained at the begin\nof the main program model) real(kind=wp), intent(in) :: fl l-value real(kind=wp), intent(in) :: bb0 =b/b0 magnetic field strength normalized\nto field strength at magnetic equator real(kind=wp), intent(in) :: e (n) array of energies in mev real(kind=wp), intent(out) :: f (n) decadic logarithm of integral fluxes in\nparticles/(cm cm sec) integer, intent(in) :: n number of energies Calls proc~~trara1~~CallsGraph proc~trara1 trmfun_module::trm_type%trara1 proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~trara1~~CalledByGraph proc~trara1 trmfun_module::trm_type%trara1 proc~aep8 trmfun_module::trm_type%aep8 proc~aep8->proc~trara1 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~aep8 proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~aep8 none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine trara1 ( me , descr , map , fl , bb0 , e , f , n ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: n !! number of energies integer , intent ( in ) :: descr ( 8 ) !! header of specified trapped radition model real ( wp ), intent ( in ) :: e ( n ) !! array of energies in mev real ( wp ), intent ( in ) :: fl !! l-value real ( wp ), intent ( in ) :: bb0 !! =b/b0 magnetic field strength normalized !! to field strength at magnetic equator integer , intent ( in ) :: map ( * ) !! map of trapped radition model !! (descr and map are explained at the begin !! of the main program model) real ( wp ), intent ( out ) :: f ( n ) !! decadic logarithm of integral fluxes in !! particles/(cm*cm*sec) real ( wp ) :: e0 , e1 , e2 , escale , f0 , fscale , xnl real ( wp ) :: bb0_ !! local copy of `bb0`. in the original code !! this was modified by this routine. !! added this so `bb0` could be `intent(in)` integer :: i0 , i1 , i2 , i3 , ie , l3 , nb , nl logical :: s0 , s1 , s2 e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings i0 = 0 ! to avoid -Wmaybe-uninitialized warnings s0 = . false . ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW bb0_ = bb0 me % fistep = descr ( 7 ) / descr ( 2 ) escale = descr ( 4 ) fscale = descr ( 7 ) xnl = min ( 1 5.6_wp , abs ( fl )) nl = int ( xnl * descr ( 5 )) if ( bb0_ < 1.0_wp ) bb0_ = 1.0_wp nb = int (( bb0_ - 1.0_wp ) * descr ( 6 )) ! i2 is the number of elements in the flux map for the first energy. ! i3 is the index of the last element of the second energy map. ! l3 is the length of the map for the third energy. ! e1 is the energy of the first energy map (unscaled) ! e2 is the energy of the second energy map (unscaled) i1 = 0 i2 = map ( 1 ) i3 = i2 + map ( i2 + 1 ) l3 = map ( i3 + 1 ) e1 = map ( i1 + 2 ) / escale e2 = map ( i2 + 2 ) / escale ! s0, s1, s2 are logical variables which indicate whether the flux for ! a particular e, b, l point has already been found in a previous call ! to function trara2. if not, s.. =.true. s1 = . true . s2 = . true . ! energy loop do ie = 1 , n ! for each energy e(i) find the successive energies e0,e1,e2 in ! model map, which obey e0 < e1 < e(i) < e2 . do while (( e ( ie ) > e2 ) . and . ( l3 /= 0 )) i0 = i1 i1 = i2 i2 = i3 i3 = i3 + l3 l3 = map ( i3 + 1 ) e0 = e1 e1 = e2 e2 = map ( i2 + 2 ) / escale s0 = s1 s1 = s2 s2 = . true . f0 = me % f1 me % f1 = me % f2 end do ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0- ! space to find fluxes f1,f2 [if they have not already been ! calculated for a previous e(i)]. if ( s1 ) me % f1 = me % trara2 ( map ( i1 + 3 ), nl , nb ) / fscale if ( s2 ) me % f2 = me % trara2 ( map ( i2 + 3 ), nl , nb ) / fscale s1 = . false . s2 = . false . ! finally, interpolate in energy. f ( ie ) = me % f1 + ( me % f2 - me % f1 ) * ( e ( ie ) - e1 ) / ( e2 - e1 ) if ( me % f2 <= 0.0_wp ) then if ( i1 /= 0 ) then ! --------- special interpolation --------------------------------- ! if the flux for the second energy cannot be found (i.e. f2=0.0), ! and the zeroth energy map has been defined (i.e. i1 not equal 0), ! then interpolate using the flux maps for the zeroth and first ! energy and choose the minimum of this interpolations and the ! interpolation that was done with f2=0. if ( s0 ) f0 = me % trara2 ( map ( i0 + 3 ), nl , nb ) / fscale s0 = . false . f ( ie ) = min ( f ( ie ), f0 + ( me % f1 - f0 ) * ( e ( ie ) - e0 ) / ( e1 - e0 )) end if end if ! the logarithmic flux is always kept greater or equal zero. f ( ie ) = max ( f ( ie ), 0.0_wp ) end do end subroutine trara1","tags":"","loc":"proc/trara1.html"},{"title":"get_data_file_dir – radbelt","text":"private function get_data_file_dir(me) result(dir) Get the directory containing the data files. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(in) :: me Return Value character(len=:), allocatable Called by proc~~get_data_file_dir~2~~CalledByGraph proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~get_data_file_dir~2 proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function get_data_file_dir ( me ) result ( dir ) class ( shellig_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % igrf_dir )) then dir = trim ( me % igrf_dir ) // '/' else dir = 'data/igrf/' ! default end if end function get_data_file_dir","tags":"","loc":"proc/get_data_file_dir~2.html"},{"title":"geo_to_cart – radbelt","text":"private pure function geo_to_cart(glat, glon, alt) result(x) geodetic to scaled cartesian coordinates Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level Return Value real(kind=wp), dimension(3) cartesian coordinates in earth radii (6371.2 km) x-axis pointing to equator at 0 longitude y-axis pointing to equator at 90 long. z-axis pointing to north pole Called by proc~~geo_to_cart~~CalledByGraph proc~geo_to_cart shellig_module::geo_to_cart proc~shellg shellig_module::shellig_type%shellg proc~shellg->proc~geo_to_cart proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~shellg proc~shellc shellig_module::shellig_type%shellc proc~shellc->proc~shellg proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~shellc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function geo_to_cart ( glat , glon , alt ) result ( x ) real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), dimension ( 3 ) :: x !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ) :: rlat !! latitude in radians real ( wp ) :: rlon !! longitude in radians real ( wp ) :: d , rho ! deg to radians: rlat = glat * umr rlon = glon * umr ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code associate ( ct => sin ( rlat ), st => cos ( rlat ), cp => cos ( rlon ), sp => sin ( rlon )) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rho = ( alt + aquad / d ) * st / era x = [ rho * cp , rho * sp , ( alt + bquad / d ) * ct / era ] end associate end function geo_to_cart","tags":"","loc":"proc/geo_to_cart.html"},{"title":"destroy_shellig_type – radbelt","text":"private subroutine destroy_shellig_type(me) Destroy a shellig_type . Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(out) :: me Source Code subroutine destroy_shellig_type ( me ) class ( shellig_type ), intent ( out ) :: me end subroutine destroy_shellig_type","tags":"","loc":"proc/destroy_shellig_type.html"},{"title":"set_data_file_dir – radbelt","text":"private subroutine set_data_file_dir(me, dir) Set the directory containing the data files. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me character(len=*), intent(in) :: dir Called by proc~~set_data_file_dir~2~~CalledByGraph proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_igrf_file_path->proc~set_data_file_dir~2 proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths->proc~set_igrf_file_path proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~set_igrf_file_path proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~set_data_files_paths Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_file_dir ( me , dir ) class ( shellig_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % igrf_dir = trim ( dir ) end subroutine set_data_file_dir","tags":"","loc":"proc/set_data_file_dir~2.html"},{"title":"igrf – radbelt","text":"private subroutine igrf(me, lon, lat, height, year, xl, bbx) Wrapper for IGRF functions. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio Calls proc~~igrf~~CallsGraph proc~igrf shellig_module::shellig_type%igrf proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~igrf~~CalledByGraph proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine igrf ( me , lon , lat , height , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , babs , bdel , bdown , beast , & beq , bequ , bnorth , dimo , rr0 integer :: icode logical :: val real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldg ( lat , lon , height , bnorth , beast , bdown , babs ) call me % shellg ( lat , lon , height , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq end if bbx = babs / bequ end subroutine igrf","tags":"","loc":"proc/igrf.html"},{"title":"igrfc – radbelt","text":"private subroutine igrfc(me, v, year, xl, bbx) Alternate version of igrf for cartesian coordinates. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio Calls proc~~igrfc~~CallsGraph proc~igrfc shellig_module::shellig_type%igrfc proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~feldcof shellig_module::shellig_type%feldcof proc~igrfc->proc~feldcof proc~findb0 shellig_module::shellig_type%findb0 proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellc->proc~shellg proc~shellg->proc~stoer proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~igrfc~~CalledByGraph proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine igrfc ( me , v , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , bdel , beq , bequ , dimo , rr0 integer :: icode logical :: val real ( wp ), dimension ( 3 ) :: b real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldc ( v , b ) call me % shellc ( v , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq end if bbx = norm2 ( b ) / bequ end subroutine igrfc","tags":"","loc":"proc/igrfc.html"},{"title":"findb0 – radbelt","text":"private subroutine findb0(me, stps, bdel, value, bequ, rr0) Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: stps real(kind=wp), intent(inout) :: bdel logical, intent(out) :: value real(kind=wp), intent(out) :: bequ real(kind=wp), intent(out) :: rr0 Calls proc~~findb0~~CallsGraph proc~findb0 shellig_module::shellig_type%findb0 proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~findb0~~CalledByGraph proc~findb0 shellig_module::shellig_type%findb0 proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~findb0 proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~findb0 proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine findb0 ( me , stps , bdel , value , bequ , rr0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: stps real ( wp ), intent ( inout ) :: bdel real ( wp ), intent ( out ) :: bequ logical , intent ( out ) :: value real ( wp ), intent ( out ) :: rr0 real ( wp ) :: b , bdelta , bmin , bold , bq1 , & bq2 , bq3 , p ( 8 , 4 ), r1 , r2 , r3 , & rold , step , step12 , zz integer :: i , irun , j , n step = stps irun = 0 rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings main : do irun = irun + 1 if ( irun > 5 ) then value = . false . exit main end if ! first three points p ( 1 , 2 ) = me % sp ( 1 ) p ( 2 , 2 ) = me % sp ( 2 ) p ( 3 , 2 ) = me % sp ( 3 ) step = - sign ( step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then step = - step r3 = r1 bq3 = bq1 do i = 1 , 5 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz end do end if ! initialization step12 = step / 1 2.0_wp value = . true . bmin = 1.0e4_wp bold = 1.0e4_wp ! corrector (field line tracing) n = 0 corrector : do p ( 1 , 3 ) = p ( 1 , 2 ) + step12 * ( 5.0_wp * p ( 4 , 3 ) + 8.0_wp * p ( 4 , 2 ) - p ( 4 , 1 )) n = n + 1 p ( 2 , 3 ) = p ( 2 , 2 ) + step12 * ( 5.0_wp * p ( 5 , 3 ) + 8.0_wp * p ( 5 , 2 ) - p ( 5 , 1 )) ! predictor (field line tracing) p ( 1 , 4 ) = p ( 1 , 3 ) + step12 * ( 2 3.0_wp * p ( 4 , 3 ) - 1 6.0_wp * p ( 4 , 2 ) + 5.0_wp * p ( 4 , 1 )) p ( 2 , 4 ) = p ( 2 , 3 ) + step12 * ( 2 3.0_wp * p ( 5 , 3 ) - 1 6.0_wp * p ( 5 , 2 ) + 5.0_wp * p ( 5 , 1 )) p ( 3 , 4 ) = p ( 3 , 3 ) + step call me % stoer ( p ( 1 , 4 ), bq3 , r3 ) do j = 1 , 3 do i = 1 , 8 p ( i , j ) = p ( i , j + 1 ) end do end do b = sqrt ( bq3 ) if ( b < bmin ) bmin = b if ( b > bold ) exit corrector bold = b rold = 1.0_wp / r3 me % sp ( 1 ) = p ( 1 , 4 ) me % sp ( 2 ) = p ( 2 , 4 ) me % sp ( 3 ) = p ( 3 , 4 ) end do corrector if ( bold /= bmin ) value = . false . bdelta = ( b - bold ) / bold if ( bdelta <= bdel ) exit main step = step / 1 0.0_wp end do main rr0 = rold bequ = bold bdel = bdelta end subroutine findb0","tags":"","loc":"proc/findb0.html"},{"title":"shellc – radbelt","text":"private subroutine shellc(me, v, dimo, fl, icode, b0) Wrapper to shellg to be used with cartesian coordinates. Note In the original code, this was an ENTRY point in shellg and didn't\n include all the outputs. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\n* x-axis pointing to equator at 0 longitude\n* y-axis pointing to equator at 90 long.\n* z-axis pointing to north pole real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode =1 normal completion =2 unphysical conjugate point (fl meaningless) =3 shell parameter greater than limit up to\n which accurate calculation is required;\n approximation is used. real(kind=wp), intent(out) :: b0 magnetic field strength in gauss Calls proc~~shellc~~CallsGraph proc~shellc shellig_module::shellig_type%shellc proc~shellg shellig_module::shellig_type%shellg proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~stoer shellig_module::shellig_type%stoer proc~shellg->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~shellc~~CalledByGraph proc~shellc shellig_module::shellig_type%shellc proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~shellc proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine shellc ( me , v , dimo , fl , icode , b0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ) :: glat , glon , alt !! not used call me % shellg ( glat , glon , alt , dimo , fl , icode , b0 , v ) end subroutine shellc","tags":"","loc":"proc/shellc.html"},{"title":"shellg – radbelt","text":"private subroutine shellg(me, glat, glon, alt, dimo, fl, icode, b0, v) calculates l-value for specified geodaetic coordinates, altitude\n and gemagnetic field model. Reference G. KLUGE, EUROPEAN SPACE OPERATIONS CENTER, INTERNAL NOTE\n NO. 67, 1970. G. KLUGE, COMPUTER PHYSICS COMMUNICATIONS 3, 31-35, 1972 History CHANGES (D. BILITZA, NOV 87): USING CORRECT DIPOL MOMENT I.E.,DIFFERENT COMMON/MODEL/ USING IGRF EARTH MAGNETIC FIELD MODELS FROM 1945 TO 1990 Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode =1 normal completion =2 unphysical conjugate point (fl meaningless) =3 shell parameter greater than limit up to\n which accurate calculation is required;\n approximation is used. real(kind=wp), intent(out) :: b0 magnetic field strength in gauss real(kind=wp), intent(in), optional, dimension(3) :: v cartesian coordinates in earth radii (6371.2 km) x-axis pointing to equator at 0 longitude y-axis pointing to equator at 90 long. z-axis pointing to north pole If this argument is present, it is used\ninstead of glat,glon,alt. See shellc . Calls proc~~shellg~~CallsGraph proc~shellg shellig_module::shellig_type%shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~stoer shellig_module::shellig_type%stoer proc~shellg->proc~stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~shellg~~CalledByGraph proc~shellg shellig_module::shellig_type%shellg proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~shellg proc~shellc shellig_module::shellig_type%shellc proc~shellc->proc~shellg proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~shellc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine shellg ( me , glat , glon , alt , dimo , fl , icode , b0 , v ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ), dimension ( 3 ), intent ( in ), optional :: v !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole !! !! If this argument is present, it is used !! instead of glat,glon,alt. See [[shellc]]. real ( wp ) :: arg1 , arg2 , bequ , bq1 , bq2 , bq3 , c0 , c1 , c2 , c3 , & d0 , d1 , d2 , dimob0 , e0 , e1 , e2 , ff , fi , gg , & hli , oradik , oterm , r , r1 , r2 , r3 , r3h , radik , & rq , step12 , step2 , stp , t , term , xx , z , zq , zz integer :: i , iequ , n real ( wp ), parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3` real ( wp ), parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3` if (. not . allocated ( me % p )) allocate ( me % p ( 8 , max_loop_index + 1 )) ! because `p(:,n+1)` in the loop bequ = 1.0e10_wp if ( present ( v )) then me % xi ( 1 ) = v ( 1 ) me % xi ( 2 ) = v ( 2 ) me % xi ( 3 ) = v ( 3 ) else me % xi = geo_to_cart ( glat , glon , alt ) end if associate ( p => me % p ) ! convert to dipol-oriented co-ordinates rq = 1.0_wp / ( me % xi ( 1 ) * me % xi ( 1 ) + me % xi ( 2 ) * me % xi ( 2 ) + me % xi ( 3 ) * me % xi ( 3 )) r3h = sqrt ( rq * sqrt ( rq )) p ( 1 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 1 ) + me % xi ( 2 ) * u ( 2 , 1 ) + me % xi ( 3 ) * u ( 3 , 1 )) * r3h p ( 2 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 2 ) + me % xi ( 2 ) * u ( 2 , 2 )) * r3h p ( 3 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 3 ) + me % xi ( 2 ) * u ( 2 , 3 ) + me % xi ( 3 ) * u ( 3 , 3 )) * rq ! first three points of field line me % step = - sign ( me % step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) b0 = sqrt ( bq2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * me % step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * me % step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - me % step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - me % step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - me % step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + me % step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + me % step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then me % step = - me % step r3 = r1 bq3 = bq1 do i = 1 , 7 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz end do end if ! search for lowest magnetic field strength if ( bq1 < bequ ) then bequ = bq1 iequ = 1 end if if ( bq2 < bequ ) then bequ = bq2 iequ = 2 end if if ( bq3 < bequ ) then bequ = bq3 iequ = 3 end if ! initialization of integration loops step12 = me % step / 1 2.0_wp step2 = me % step + me % step me % steq = sign ( me % steq , me % step ) fi = 0.0_wp icode = 1 oradik = 0.0_wp oterm = 0.0_wp stp = r2 * me % steq z = p ( 3 , 2 ) + stp stp = stp / 0.75_wp p ( 8 , 1 ) = step2 * ( p ( 1 , 1 ) * p ( 4 , 1 ) + p ( 2 , 1 ) * p ( 5 , 1 )) p ( 8 , 2 ) = step2 * ( p ( 1 , 2 ) * p ( 4 , 2 ) + p ( 2 , 2 ) * p ( 5 , 2 )) ! main loop (field line tracing) main : do n = 3 , max_loop_index ! corrector (field line tracing) p ( 1 , n ) = p ( 1 , n - 1 ) + step12 * ( 5.0_wp * p ( 4 , n ) + 8.0_wp * p ( 4 , n - 1 ) - p ( 4 , n - 2 )) p ( 2 , n ) = p ( 2 , n - 1 ) + step12 * ( 5.0_wp * p ( 5 , n ) + 8.0_wp * p ( 5 , n - 1 ) - p ( 5 , n - 2 )) ! prepare expansion coefficients for interpolation ! of slowly varying quantities p ( 8 , n ) = step2 * ( p ( 1 , n ) * p ( 4 , n ) + p ( 2 , n ) * p ( 5 , n )) c0 = p ( 1 , n - 1 ) ** 2 + p ( 2 , n - 1 ) ** 2 c1 = p ( 8 , n - 1 ) c2 = ( p ( 8 , n ) - p ( 8 , n - 2 )) * 0.25_wp c3 = ( p ( 8 , n ) + p ( 8 , n - 2 ) - c1 - c1 ) / 6.0_wp d0 = p ( 6 , n - 1 ) d1 = ( p ( 6 , n ) - p ( 6 , n - 2 )) * 0.5_wp d2 = ( p ( 6 , n ) + p ( 6 , n - 2 ) - d0 - d0 ) * 0.5_wp e0 = p ( 7 , n - 1 ) e1 = ( p ( 7 , n ) - p ( 7 , n - 2 )) * 0.5_wp e2 = ( p ( 7 , n ) + p ( 7 , n - 2 ) - e0 - e0 ) * 0.5_wp inner : do ! inner loop (for quadrature) t = ( z - p ( 3 , n - 1 )) / me % step if ( t > 1.0_wp ) then ! predictor (field line tracing) p ( 1 , n + 1 ) = p ( 1 , n ) + step12 * ( 2 3.0_wp * p ( 4 , n ) - 1 6.0_wp * p ( 4 , n - 1 ) + 5.0_wp * p ( 4 , n - 2 )) p ( 2 , n + 1 ) = p ( 2 , n ) + step12 * ( 2 3.0_wp * p ( 5 , n ) - 1 6.0_wp * p ( 5 , n - 1 ) + 5.0_wp * p ( 5 , n - 2 )) p ( 3 , n + 1 ) = p ( 3 , n ) + me % step call me % stoer ( p ( 1 , n + 1 ), bq3 , r3 ) ! search for lowest magnetic field strength if ( bq3 < bequ ) then iequ = n + 1 bequ = bq3 end if exit inner else hli = 0.5_wp * ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) zq = z * z r = hli + sqrt ( hli * hli + zq ) if ( r <= rmin ) then ! approximation for high values of l. icode = 3 t = - p ( 3 , n - 1 ) / me % step fl = 1.0_wp / ( abs ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) + 1.0e-15_wp ) return end if rq = r * r ff = sqrt ( 1.0_wp + 3.0_wp * zq / rq ) radik = b0 - (( d2 * t + d1 ) * t + d0 ) * r * rq * ff if ( r > rmax ) then icode = 2 radik = radik - 1 2.0_wp * ( r - rmax ) ** 2 end if if ( radik + radik <= oradik ) exit main term = sqrt ( radik ) * ff * (( e2 * t + e1 ) * t + e0 ) / ( rq + zq ) fi = fi + stp * ( oterm + term ) oradik = radik oterm = term stp = r * me % steq z = z + stp end if end do inner end do main if ( iequ < 2 ) iequ = 2 me % sp ( 1 ) = p ( 1 , iequ - 1 ) me % sp ( 2 ) = p ( 2 , iequ - 1 ) me % sp ( 3 ) = p ( 3 , iequ - 1 ) if ( oradik >= 1.0e-15_wp ) fi = fi + stp / 0.75_wp * oterm * oradik / ( oradik - radik ) ! the minimal allowable value of fi was changed from 1e-15 to 1e-12, ! because 1e-38 is the minimal allowable arg. for alog in our envir. ! d. bilitza, nov 87. fi = 0.5_wp * abs ( fi ) / sqrt ( b0 ) + 1.0e-12_wp ! compute l from b and i. same as carmel in invar. ! correct dipole moment is used here. d. bilitza, nov 87. dimob0 = dimo / b0 arg1 = log ( fi ) arg2 = log ( dimob0 ) ! arg = fi*fi*fi/dimob0 ! if(abs(arg)>88.0_wp) arg=88.0_wp xx = 3 * arg1 - arg2 if ( xx > 2 3.0_wp ) then gg = xx - 3.0460681_wp elseif ( xx > 1 1.7_wp ) then gg = ((((( 2.8212095e-8_wp * xx - 3.8049276e-6_wp ) * xx + & 2.170224e-4_wp ) * xx - 6.7310339e-3_wp ) * xx + & 1.2038224e-1_wp ) * xx - 1.8461796e-1_wp ) * xx + 2.0007187_wp elseif ( xx > + 3.0_wp ) then gg = (((((((( 6.3271665e-10_wp * xx - 3.958306e-8_wp ) * xx + & 9.9766148e-07_wp ) * xx - 1.2531932e-5_wp ) * xx + & 7.9451313e-5_wp ) * xx - 3.2077032e-4_wp ) * xx + & 2.1680398e-3_wp ) * xx + 1.2817956e-2_wp ) * xx + & 4.3510529e-1_wp ) * xx + 6.222355e-1_wp elseif ( xx > - 3.0_wp ) then gg = (((((((( 2.6047023e-10_wp * xx + 2.3028767e-9_wp ) * xx - & 2.1997983e-8_wp ) * xx - 5.3977642e-7_wp ) * xx - & 3.3408822e-6_wp ) * xx + 3.8379917e-5_wp ) * xx + & 1.1784234e-3_wp ) * xx + 1.4492441e-2_wp ) * xx + & 4.3352788e-1_wp ) * xx + 6.228644e-1_wp elseif ( xx > - 2 2.0_wp ) then gg = (((((((( - 8.1537735e-14_wp * xx + 8.3232531e-13_wp ) * xx + & 1.0066362e-9_wp ) * xx + 8.1048663e-8_wp ) * xx + & 3.2916354e-6_wp ) * xx + 8.2711096e-5_wp ) * xx + & 1.3714667e-3_wp ) * xx + 1.5017245e-2_wp ) * xx + & 4.3432642e-1_wp ) * xx + 6.2337691e-1_wp else gg = 3.33338e-1_wp * xx + 3.0062102e-1_wp end if fl = exp ( log (( 1.0_wp + exp ( gg )) * dimob0 ) / 3.0_wp ) end associate end subroutine shellg","tags":"","loc":"proc/shellg.html"},{"title":"stoer – radbelt","text":"private subroutine stoer(me, p, bq, r) subroutine used for field line tracing in shellg .\ncalls entry point feldi in geomagnetic field subroutine feldg Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(inout), dimension(7) :: p real(kind=wp), intent(out) :: bq real(kind=wp), intent(out) :: r Calls proc~~stoer~~CallsGraph proc~stoer shellig_module::shellig_type%stoer proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~stoer~~CalledByGraph proc~stoer shellig_module::shellig_type%stoer proc~findb0 shellig_module::shellig_type%findb0 proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellg->proc~stoer proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~findb0 proc~igrf->proc~shellg proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~shellc->proc~shellg proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine stoer ( me , p , bq , r ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 7 ), intent ( inout ) :: p real ( wp ), intent ( out ) :: bq real ( wp ), intent ( out ) :: r real ( wp ) :: dr , dsq , dx , dxm , dy , dym , dz , & dzm , fli , q , rq , wr , xm , ym , zm ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates zm = P ( 3 ) fli = P ( 1 ) * P ( 1 ) + P ( 2 ) * P ( 2 ) + 1.0e-15_wp R = 0.5_wp * ( fli + sqrt ( fli * fli + ( zm + zm ) ** 2 )) rq = R * R wr = sqrt ( R ) xm = P ( 1 ) * wr ym = P ( 2 ) * wr ! transform to geographic co-ordinate system me % Xi ( 1 ) = xm * u ( 1 , 1 ) + ym * u ( 1 , 2 ) + zm * u ( 1 , 3 ) me % Xi ( 2 ) = xm * u ( 2 , 1 ) + ym * u ( 2 , 2 ) + zm * u ( 2 , 3 ) me % Xi ( 3 ) = xm * u ( 3 , 1 ) + zm * u ( 3 , 3 ) ! compute derivatives ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results ! are the same; dkb Feb 1998. ! JW : feb 2024 : xi, h now class variables. call me % feldi () q = me % H ( 1 ) / rq dx = me % H ( 3 ) + me % H ( 3 ) + q * me % Xi ( 1 ) dy = me % H ( 4 ) + me % H ( 4 ) + q * me % Xi ( 2 ) dz = me % H ( 2 ) + me % H ( 2 ) + q * me % Xi ( 3 ) ! transform back to geomagnetic co-ordinate system dxm = u ( 1 , 1 ) * dx + u ( 2 , 1 ) * dy + u ( 3 , 1 ) * dz dym = u ( 1 , 2 ) * dx + u ( 2 , 2 ) * dy dzm = u ( 1 , 3 ) * dx + u ( 2 , 3 ) * dy + u ( 3 , 3 ) * dz dr = ( xm * dxm + ym * dym + zm * dzm ) / R ! form slowly varying expressions P ( 4 ) = ( wr * dxm - 0.5_wp * P ( 1 ) * dr ) / ( R * dzm ) P ( 5 ) = ( wr * dym - 0.5_wp * P ( 2 ) * dr ) / ( R * dzm ) dsq = rq * ( dxm * dxm + dym * dym + dzm * dzm ) Bq = dsq * rq * rq P ( 6 ) = sqrt ( dsq / ( rq + 3.0_wp * zm * zm )) P ( 7 ) = P ( 6 ) * ( rq + zm * zm ) / ( rq * dzm ) end subroutine stoer","tags":"","loc":"proc/stoer.html"},{"title":"feldg – radbelt","text":"private subroutine feldg(me, glat, glon, alt, bnorth, beast, bdown, Babs) Calculates earth magnetic field from spherical harmonics model Reference ref: g. kluge, european space operations centre, internal note 61,\n 1970. History changes (d. bilitza, nov 87): field coefficients in binary data files instead of block data calculates dipol moment Note In the original code, [[feldc] and feldi were\n ENTRY points to this routine Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(out) :: bnorth components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: beast components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: bdown components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: Babs magnetic field strength in gauss Called by proc~~feldg~~CalledByGraph proc~feldg shellig_module::shellig_type%feldg proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldg proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldg ( me , glat , glon , alt , bnorth , beast , bdown , babs ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( out ) :: bnorth , beast , bdown !! components of the field with respect !! to the local geodetic coordinate system, with axis !! pointing in the tangential plane to the north, east !! and downward. real ( wp ), intent ( out ) :: Babs !! magnetic field strength in gauss real ( wp ) :: brho , bxxx , byyy , bzzz , cp , ct , d , f , rho , & rlat , rlon , rq , s , sp , st , t , & x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m ! same calculation as geo_to_cart, but not used here ! because the intermediate variables are also used below. rlat = glat * umr ct = sin ( rlat ) st = cos ( rlat ) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rlon = glon * umr cp = cos ( rlon ) sp = sin ( rlon ) zzz = ( alt + bquad / d ) * ct / era rho = ( alt + aquad / d ) * st / era xxx = rho * cp yyy = rho * sp rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) bxxx = t * ( me % h ( 3 ) - s * xxx ) byyy = t * ( me % h ( 4 ) - s * yyy ) bzzz = t * ( me % h ( 2 ) - s * zzz ) babs = sqrt ( bxxx * bxxx + byyy * byyy + bzzz * bzzz ) beast = byyy * cp - bxxx * sp brho = byyy * sp + bxxx * cp bnorth = bzzz * st - brho * ct bdown = - bzzz * ct - brho * st end subroutine feldg","tags":"","loc":"proc/feldg.html"},{"title":"feldc – radbelt","text":"private subroutine feldc(me, v, b) Alternate version of feldg to be used with cartesian coordinates Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(out) :: b (3) field components Called by proc~~feldc~~CalledByGraph proc~feldc shellig_module::shellig_type%feldc proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldc proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldc ( me , v , b ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( out ) :: b ( 3 ) !! field components real ( wp ) :: f , rq , s , t , x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m xxx = v ( 1 ) yyy = v ( 2 ) zzz = v ( 3 ) rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) b ( 1 ) = t * ( me % h ( 3 ) - s * xxx ) b ( 2 ) = t * ( me % h ( 4 ) - s * yyy ) b ( 3 ) = t * ( me % h ( 2 ) - s * zzz ) end subroutine feldc","tags":"","loc":"proc/feldc.html"},{"title":"feldi – radbelt","text":"private subroutine feldi(me) Used for l computation. Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me Called by proc~~feldi~~CalledByGraph proc~feldi shellig_module::shellig_type%feldi proc~stoer shellig_module::shellig_type%stoer proc~stoer->proc~feldi proc~findb0 shellig_module::shellig_type%findb0 proc~findb0->proc~stoer proc~shellg shellig_module::shellig_type%shellg proc~shellg->proc~stoer proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~findb0 proc~igrf->proc~shellg proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~shellc->proc~shellg proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldi ( me ) class ( shellig_type ), intent ( inout ) :: me real ( wp ) :: f , x , y , z integer :: i , ih , ihmax , il , imax , k , last , m ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do end subroutine feldi","tags":"","loc":"proc/feldi.html"},{"title":"feldcof – radbelt","text":"private subroutine feldcof(me, year, dimo) Determines coefficients and dipol moment from IGRF models Author D. BILITZA, NSSDC, GSFC, CODE 633, GREENBELT, MD 20771,\n (301) 286-9536 NOV 1987. History corrected for 2000 update - dkb- 5/31/2000 updated to IGRF-2000 version -dkb- 5/31/2000 updated to IGRF-2005 version -dkb- 3/24/2000 Type Bound shellig_type Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: dimo geomagnetic dipol moment in gauss (normalized\nto earth's radius) at the time (year) Calls proc~~feldcof~~CallsGraph proc~feldcof shellig_module::shellig_type%feldcof proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~feldcof~~CalledByGraph proc~feldcof shellig_module::shellig_type%feldcof proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine feldcof ( me , year , dimo ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: dimo !! geomagnetic dipol moment in gauss (normalized !! to earth's radius) at the time (year) real ( wp ) :: dte1 , dte2 , erad , gha ( 144 ), sqrt2 integer :: i , ier , j , l , m , n , iyea character ( len = :), allocatable :: fil2 real ( wp ) :: x , f0 , f !! these were double precision in original !! code while everything else was single precision ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1 character ( len = filename_len ), dimension ( 17 ), parameter :: filmod = [ & 'dgrf1945.dat ' , 'dgrf1950.dat ' , 'dgrf1955.dat ' , 'dgrf1960.dat ' , & 'dgrf1965.dat ' , 'dgrf1970.dat ' , 'dgrf1975.dat ' , 'dgrf1980.dat ' , & 'dgrf1985.dat ' , 'dgrf1990.dat ' , 'dgrf1995.dat ' , 'dgrf2000.dat ' , & 'dgrf2005.dat ' , 'dgrf2010.dat ' , 'dgrf2015.dat ' , 'igrf2020.dat ' , & 'igrf2020s.dat' ] real ( wp ), dimension ( 17 ), parameter :: dtemod = [ 194 5.0_wp , 195 0.0_wp , 195 5.0_wp , & 196 0.0_wp , 196 5.0_wp , 197 0.0_wp , & 197 5.0_wp , 198 0.0_wp , 198 5.0_wp , & 199 0.0_wp , 199 5.0_wp , 200 0.0_wp , & 200 5.0_wp , 201 0.0_wp , 201 5.0_wp , & 202 0.0_wp , 202 5.0_wp ] integer , parameter :: numye = size ( dtemod ) - 1 ! number of 5-year priods represented by IGRF integer , parameter :: is = 0 !! * is=0 for schmidt normalization !! * is=1 gauss normalization logical :: read_file !-- determine igrf-years for input-year me % time = year iyea = int ( year / 5.0_wp ) * 5 read_file = iyea /= me % iyea ! if we have to read the file me % iyea = iyea l = ( me % iyea - 1945 ) / 5 + 1 if ( l < 1 ) l = 1 if ( l > numye ) l = numye dte1 = dtemod ( l ) me % name = me % get_data_file_dir () // trim ( filmod ( l )) dte2 = dtemod ( l + 1 ) fil2 = me % get_data_file_dir () // trim ( filmod ( l + 1 )) if ( read_file ) then ! get igrf coefficients for the boundary years ! [if they have not ready been loaded] call getshc ( me % name , me % nmax1 , erad , me % g , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( me % name ) me % g_cache = me % g ! because it is modified below, we have to cache the original values from the file call getshc ( fil2 , me % nmax2 , erad , me % gh2 , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( fil2 ) else me % g = me % g_cache end if !-- determine igrf coefficients for year if ( l <= numye - 1 ) then call intershc ( year , dte1 , me % nmax1 , me % g , dte2 , me % nmax2 , me % gh2 , me % nmax , gha ) else call extrashc ( year , dte1 , me % nmax1 , me % g , me % nmax2 , me % gh2 , me % nmax , gha ) end if !-- determine magnetic dipol moment and coeffiecients g f0 = 0.0_wp do j = 1 , 3 f = gha ( j ) * 1.0e-5_wp f0 = f0 + f * f end do dimo = sqrt ( f0 ) me % g ( 1 ) = 0.0_wp i = 2 f0 = 1.0e-5_wp if ( is == 0 ) f0 = - f0 sqrt2 = sqrt ( 2.0_wp ) do n = 1 , me % nmax x = n f0 = f0 * x * x / ( 4.0_wp * x - 2.0_wp ) if ( is == 0 ) f0 = f0 * ( 2.0_wp * x - 1.0_wp ) / x f = f0 * 0.5_wp if ( is == 0 ) f = f * sqrt2 me % g ( i ) = gha ( i - 1 ) * f0 i = i + 1 do m = 1 , n f = f * ( x + m ) / ( x - m + 1.0_wp ) if ( is == 0 ) f = f * sqrt (( x - m + 1.0_wp ) / ( x + m )) me % g ( i ) = gha ( i - 1 ) * f me % g ( i + 1 ) = gha ( i ) * f i = i + 2 end do end do end subroutine feldcof","tags":"","loc":"proc/feldcof.html"},{"title":"getshc – radbelt","text":"private subroutine getshc(Fspec, Nmax, Erad, Gh, Ier) Reads spherical harmonic coefficients from the specified\n file into an array. Author Version 1.01, A. Zunde, USGS, MS 964,\n Box 25046 Federal Center, Denver, CO 80225 Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: Fspec File specification integer, intent(out) :: Nmax Maximum degree and order of model real(kind=wp), intent(out) :: Erad Earth's radius associated with the spherical\nharmonic coefficients, in the same units as\nelevation real(kind=wp), intent(out), dimension(*) :: Gh Schmidt quasi-normal internal spherical\nharmonic coefficients integer, intent(out) :: Ier Error number: 0, no error -2, records out of order FORTRAN run-time error number Called by proc~~getshc~~CalledByGraph proc~getshc shellig_module::getshc proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~getshc proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine getshc ( Fspec , Nmax , Erad , Gh , Ier ) character ( len =* ), intent ( in ) :: Fspec !! File specification integer , intent ( out ) :: Nmax !! Maximum degree and order of model real ( wp ), intent ( out ) :: Erad !! Earth's radius associated with the spherical !! harmonic coefficients, in the same units as !! elevation real ( wp ), dimension ( * ), intent ( out ) :: Gh !! Schmidt quasi-normal internal spherical !! harmonic coefficients integer , intent ( out ) :: Ier !! Error number: !! !! * 0, no error !! * -2, records out of order !! * FORTRAN run-time error number integer :: iu !! logical unit number real ( wp ) :: g , h integer :: i , m , mm , n , nn read_file : block ! --------------------------------------------------------------- ! Open coefficient file. Read past first header record. ! Read degree and order of model and Earth's radius. ! --------------------------------------------------------------- open ( newunit = Iu , FILE = Fspec , STATUS = 'OLD' , IOSTAT = Ier ) if ( Ier /= 0 ) then write ( * , * ) 'Error opening file: ' // trim ( fspec ) exit read_file end if read ( Iu , * , IOSTAT = Ier ) if ( Ier /= 0 ) exit read_file read ( Iu , * , IOSTAT = Ier ) Nmax , Erad if ( Ier /= 0 ) exit read_file ! --------------------------------------------------------------- ! Read the coefficient file, arranged as follows: ! ! N M G H ! ---------------------- ! / 1 0 GH(1) - ! / 1 1 GH(2) GH(3) ! / 2 0 GH(4) - ! / 2 1 GH(5) GH(6) ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8) ! records \\ 3 0 GH(9) - ! \\ . . . . ! \\ . . . . ! NMAX*(NMAX+2) \\ . . . . ! elements in GH \\ NMAX NMAX . . ! ! N and M are, respectively, the degree and order of the ! coefficient. ! --------------------------------------------------------------- i = 0 main : do nn = 1 , Nmax do mm = 0 , nn read ( Iu , * , IOSTAT = Ier ) n , m , g , h if ( Ier /= 0 ) exit main if ( nn /= n . or . mm /= m ) then Ier = - 2 exit main end if i = i + 1 Gh ( i ) = g if ( m /= 0 ) then i = i + 1 Gh ( i ) = h end if end do end do main end block read_file close ( Iu ) end subroutine getshc","tags":"","loc":"proc/getshc.html"},{"title":"intershc – radbelt","text":"private subroutine intershc(date, dte1, nmax1, gh1, dte2, nmax2, gh2, nmax, gh) Interpolates linearly, in time, between two spherical\n harmonic models. The coefficients (GH) of the resulting model, at date\n DATE, are computed by linearly interpolating between the\n coefficients of the earlier model (GH1), at date DTE1,\n and those of the later model (GH2), at date DTE2. If one\n model is smaller than the other, the interpolation is\n performed with the missing coefficients assumed to be 0. Author Version 1.01, A. Zunde\n USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of earlier model integer, intent(in) :: nmax1 Maximum degree and order of earlier model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real(kind=wp), intent(in) :: dte2 Date of later model integer, intent(in) :: nmax2 Maximum degree and order of later model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of later model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model Called by proc~~intershc~~CalledByGraph proc~intershc shellig_module::intershc proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~intershc proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine intershc ( date , dte1 , nmax1 , gh1 , dte2 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of earlier model integer , intent ( in ) :: nmax1 !! Maximum degree and order of earlier model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real ( wp ), intent ( in ) :: dte2 !! Date of later model integer , intent ( in ) :: nmax2 !! Maximum degree and order of later model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) / ( dte2 - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) + factor * ( - gh1 ( i )) end do nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) end do nmax = nmax2 end if do i = 1 , k gh ( i ) = gh1 ( i ) + factor * ( gh2 ( i ) - gh1 ( i )) end do end subroutine intershc","tags":"","loc":"proc/intershc.html"},{"title":"extrashc – radbelt","text":"private subroutine extrashc(date, dte1, nmax1, gh1, nmax2, gh2, nmax, gh) Extrapolates linearly a spherical harmonic model with a\n rate-of-change model. The coefficients (GH) of the resulting model, at date\n DATE, are computed by linearly extrapolating the coef-\n ficients of the base model (GH1), at date DTE1, using\n those of the rate-of-change model (GH2), at date DTE2. If\n one model is smaller than the other, the extrapolation is\n performed with the missing coefficients assumed to be 0. Author Version 1.01, A. Zunde\n USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of base model integer, intent(in) :: nmax1 Maximum degree and order of base model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of base model integer, intent(in) :: nmax2 Maximum degree and order of rate-of-change model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model Called by proc~~extrashc~~CalledByGraph proc~extrashc shellig_module::extrashc proc~feldcof shellig_module::shellig_type%feldcof proc~feldcof->proc~extrashc proc~igrf shellig_module::shellig_type%igrf proc~igrf->proc~feldcof proc~igrfc shellig_module::shellig_type%igrfc proc~igrfc->proc~feldcof proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ proc~get_flux_c_->proc~igrfc proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ proc~get_flux_g_->proc~igrf none~get_flux radbelt_module::radbelt_type%get_flux none~get_flux->proc~get_flux_c_ none~get_flux->proc~get_flux_g_ proc~get_flux_c radbelt_module::get_flux_c proc~get_flux_c->none~get_flux proc~get_flux_g radbelt_module::get_flux_g proc~get_flux_g->none~get_flux proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->none~get_flux interface~get_flux radbelt_module::get_flux interface~get_flux->proc~get_flux_c interface~get_flux->proc~get_flux_g Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine extrashc ( date , dte1 , nmax1 , gh1 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of base model integer , intent ( in ) :: nmax1 !! Maximum degree and order of base model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model integer , intent ( in ) :: nmax2 !! Maximum degree and order of rate-of-change model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) end do nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) end do nmax = nmax2 end if do i = 1 , k gh ( i ) = gh1 ( i ) + factor * gh2 ( i ) end do end subroutine extrashc","tags":"","loc":"proc/extrashc.html"},{"title":"c2f_str – radbelt","text":"public function c2f_str(cstr) result(fstr) Convert C string to Fortran Arguments Type Intent Optional Attributes Name character(kind=c_char, len=1), intent(in), dimension(:) :: cstr string from C Return Value character(len=:), allocatable fortran string Called by proc~~c2f_str~~CalledByGraph proc~c2f_str radbelt_c_module::c2f_str proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~c2f_str proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~c2f_str proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~c2f_str Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function c2f_str ( cstr ) result ( fstr ) character ( kind = c_char , len = 1 ), dimension (:), intent ( in ) :: cstr !! string from C character ( len = :), allocatable :: fstr !! fortran string integer :: i !! counter fstr = '' do i = 1 , size ( cstr ) fstr = fstr // cstr ( i ) end do fstr = trim ( fstr ) end function c2f_str","tags":"","loc":"proc/c2f_str.html"},{"title":"int_pointer_to_f_pointer – radbelt","text":"public subroutine int_pointer_to_f_pointer(ipointer, p) Convert an integer pointer to a radbelt_type pointer. Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer integer pointer from C type( radbelt_type ), pointer :: p fortran pointer Called by proc~~int_pointer_to_f_pointer~~CalledByGraph proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~destroy_c radbelt_c_module::destroy_c proc~destroy_c->proc~int_pointer_to_f_pointer proc~get_flux_g_c radbelt_c_module::get_flux_g_c proc~get_flux_g_c->proc~int_pointer_to_f_pointer proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~set_data_files_paths_c->proc~int_pointer_to_f_pointer proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~set_igrf_file_path_c->proc~int_pointer_to_f_pointer proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~set_trm_file_path_c->proc~int_pointer_to_f_pointer Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine int_pointer_to_f_pointer ( ipointer , p ) integer ( c_intptr_t ), intent ( in ) :: ipointer !! integer pointer from C type ( radbelt_type ), pointer :: p !! fortran pointer type ( c_ptr ) :: cp cp = transfer ( ipointer , c_null_ptr ) if ( c_associated ( cp )) then call c_f_pointer ( cp , p ) else p => null () end if end subroutine int_pointer_to_f_pointer","tags":"","loc":"proc/int_pointer_to_f_pointer.html"},{"title":"initialize_c – radbelt","text":"public subroutine initialize_c(ipointer) bind(C, name=\"initialize_c\") create a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(out) :: ipointer Source Code subroutine initialize_c ( ipointer ) bind ( C , name = \"initialize_c\" ) integer ( c_intptr_t ), intent ( out ) :: ipointer type ( radbelt_type ), pointer :: p type ( c_ptr ) :: cp allocate ( p ) cp = c_loc ( p ) ipointer = transfer ( cp , 0_c_intptr_t ) end subroutine initialize_c","tags":"","loc":"proc/initialize_c.html"},{"title":"destroy_c – radbelt","text":"public subroutine destroy_c(ipointer) bind(C, name=\"destroy_c\") destroy a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer Calls proc~~destroy_c~~CallsGraph proc~destroy_c radbelt_c_module::destroy_c proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~destroy_c->proc~int_pointer_to_f_pointer Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine destroy_c ( ipointer ) bind ( C , name = \"destroy_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) deallocate ( p ) end subroutine destroy_c","tags":"","loc":"proc/destroy_c.html"},{"title":"set_trm_file_path_c – radbelt","text":"public subroutine set_trm_file_path_c(ipointer, aep8_dir, n) bind(C, name=\"set_trm_file_path_c\") C interface for setting the trm data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir integer(kind=c_int), intent(in) :: n size of aep8_dir Calls proc~~set_trm_file_path_c~~CallsGraph proc~set_trm_file_path_c radbelt_c_module::set_trm_file_path_c proc~c2f_str radbelt_c_module::c2f_str proc~set_trm_file_path_c->proc~c2f_str proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~set_trm_file_path_c->proc~int_pointer_to_f_pointer proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_trm_file_path_c->proc~set_trm_file_path proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_trm_file_path_c ( ipointer , aep8_dir , n ) bind ( C , name = \"set_trm_file_path_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir character ( len = :), allocatable :: aep8_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) call p % set_trm_file_path ( aep8_dir_ ) else error stop 'error in set_trm_file_path_c: class is not associated' end if end subroutine set_trm_file_path_c","tags":"","loc":"proc/set_trm_file_path_c.html"},{"title":"set_igrf_file_path_c – radbelt","text":"public subroutine set_igrf_file_path_c(ipointer, igrf_dir, n) bind(C, name=\"set_igrf_file_path\") C interface for setting the igrf data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: igrf_dir integer(kind=c_int), intent(in) :: n size of igrf_dir Calls proc~~set_igrf_file_path_c~~CallsGraph proc~set_igrf_file_path_c radbelt_c_module::set_igrf_file_path_c proc~c2f_str radbelt_c_module::c2f_str proc~set_igrf_file_path_c->proc~c2f_str proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~set_igrf_file_path_c->proc~int_pointer_to_f_pointer proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_igrf_file_path_c->proc~set_igrf_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_igrf_file_path_c ( ipointer , igrf_dir , n ) bind ( C , name = \"set_igrf_file_path\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then igrf_dir_ = c2f_str ( igrf_dir ) call p % set_igrf_file_path ( igrf_dir_ ) else error stop 'error in set_igrf_file_path: class is not associated' end if end subroutine set_igrf_file_path_c","tags":"","loc":"proc/set_igrf_file_path_c.html"},{"title":"set_data_files_paths_c – radbelt","text":"public subroutine set_data_files_paths_c(ipointer, aep8_dir, igrf_dir, n, m) bind(C, name=\"set_data_files_paths_c\") C interface for setting the data file paths Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir character(kind=c_char, len=1), intent(in), dimension(m) :: igrf_dir integer(kind=c_int), intent(in) :: n size of aep8_dir integer(kind=c_int), intent(in) :: m size of igrf_dir Calls proc~~set_data_files_paths_c~~CallsGraph proc~set_data_files_paths_c radbelt_c_module::set_data_files_paths_c proc~c2f_str radbelt_c_module::c2f_str proc~set_data_files_paths_c->proc~c2f_str proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~set_data_files_paths_c->proc~int_pointer_to_f_pointer proc~set_data_files_paths radbelt_module::radbelt_type%set_data_files_paths proc~set_data_files_paths_c->proc~set_data_files_paths proc~set_igrf_file_path radbelt_module::radbelt_type%set_igrf_file_path proc~set_data_files_paths->proc~set_igrf_file_path proc~set_trm_file_path radbelt_module::radbelt_type%set_trm_file_path proc~set_data_files_paths->proc~set_trm_file_path proc~set_data_file_dir~2 shellig_module::shellig_type%set_data_file_dir proc~set_igrf_file_path->proc~set_data_file_dir~2 proc~set_data_file_dir trmfun_module::trm_type%set_data_file_dir proc~set_trm_file_path->proc~set_data_file_dir Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_data_files_paths_c ( ipointer , aep8_dir , igrf_dir , n , m ) bind ( C , name = \"set_data_files_paths_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir integer ( c_int ), intent ( in ) :: m !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( m ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: aep8_dir_ , igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) igrf_dir_ = c2f_str ( igrf_dir ) call p % set_data_files_paths ( aep8_dir_ , igrf_dir_ ) else error stop 'error in set_data_files_paths_c: class is not associated' end if end subroutine set_data_files_paths_c","tags":"","loc":"proc/set_data_files_paths_c.html"},{"title":"get_flux_g_c – radbelt","text":"public subroutine get_flux_g_c(ipointer, lon, lat, height, year, e, imname, flux) bind(C, name=\"get_flux_g_c\") C interface to get_flux_g . Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer real(kind=c_double), intent(in) :: lon geodetic longitude in degrees (east) real(kind=c_double), intent(in) :: lat geodetic latitude in degrees (north) real(kind=c_double), intent(in) :: height altitude in km above sea level real(kind=c_double), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=c_double), intent(in) :: e minimum energy integer(kind=c_int), intent(in) :: imname which method to use: 1 -- particle species: electrons, solar activity: min 2 -- particle species: electrons, solar activity: max 3 -- particle species: protons, solar activity: min 4 -- particle species: protons, solar activity: max real(kind=c_double), intent(out) :: flux The flux of particles above the given energy, in units of cm^-2 s^-1. Calls proc~~get_flux_g_c~~CallsGraph proc~get_flux_g_c radbelt_c_module::get_flux_g_c none~get_flux radbelt_module::radbelt_type%get_flux proc~get_flux_g_c->none~get_flux proc~int_pointer_to_f_pointer radbelt_c_module::int_pointer_to_f_pointer proc~get_flux_g_c->proc~int_pointer_to_f_pointer proc~get_flux_c_ radbelt_module::radbelt_type%get_flux_c_ none~get_flux->proc~get_flux_c_ proc~get_flux_g_ radbelt_module::radbelt_type%get_flux_g_ none~get_flux->proc~get_flux_g_ proc~aep8 trmfun_module::trm_type%aep8 proc~get_flux_c_->proc~aep8 proc~igrfc shellig_module::shellig_type%igrfc proc~get_flux_c_->proc~igrfc proc~get_flux_g_->proc~aep8 proc~igrf shellig_module::shellig_type%igrf proc~get_flux_g_->proc~igrf proc~get_data_file_dir trmfun_module::trm_type%get_data_file_dir proc~aep8->proc~get_data_file_dir proc~trara1 trmfun_module::trm_type%trara1 proc~aep8->proc~trara1 proc~feldcof shellig_module::shellig_type%feldcof proc~igrf->proc~feldcof proc~feldg shellig_module::shellig_type%feldg proc~igrf->proc~feldg proc~findb0 shellig_module::shellig_type%findb0 proc~igrf->proc~findb0 proc~shellg shellig_module::shellig_type%shellg proc~igrf->proc~shellg proc~feldc shellig_module::shellig_type%feldc proc~igrfc->proc~feldc proc~igrfc->proc~feldcof proc~igrfc->proc~findb0 proc~shellc shellig_module::shellig_type%shellc proc~igrfc->proc~shellc proc~extrashc shellig_module::extrashc proc~feldcof->proc~extrashc proc~get_data_file_dir~2 shellig_module::shellig_type%get_data_file_dir proc~feldcof->proc~get_data_file_dir~2 proc~getshc shellig_module::getshc proc~feldcof->proc~getshc proc~intershc shellig_module::intershc proc~feldcof->proc~intershc proc~stoer shellig_module::shellig_type%stoer proc~findb0->proc~stoer proc~shellc->proc~shellg proc~geo_to_cart shellig_module::geo_to_cart proc~shellg->proc~geo_to_cart proc~shellg->proc~stoer proc~trara2 trmfun_module::trm_type%trara2 proc~trara1->proc~trara2 proc~feldi shellig_module::shellig_type%feldi proc~stoer->proc~feldi Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine get_flux_g_c ( ipointer , lon , lat , height , year , e , imname , flux ) bind ( C , name = \"get_flux_g_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer real ( c_double ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( c_double ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( c_double ), intent ( in ) :: height !! altitude in km above sea level real ( c_double ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( c_double ), intent ( in ) :: e !! minimum energy integer ( c_int ), intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( c_double ), intent ( out ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then flux = p % get_flux ( lon , lat , height , year , e , imname ) else error stop 'error in get_flux_g_c: class is not associated' end if end subroutine get_flux_g_c","tags":"","loc":"proc/get_flux_g_c.html"},{"title":"radbelt_kinds_module – radbelt","text":"Numeric kind definitions for radbelt. Uses iso_fortran_env module~~radbelt_kinds_module~~UsesGraph module~radbelt_kinds_module radbelt_kinds_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~radbelt_kinds_module~~UsedByGraph module~radbelt_kinds_module radbelt_kinds_module module~radbelt_module radbelt_module module~radbelt_module->module~radbelt_kinds_module module~shellig_module shellig_module module~radbelt_module->module~shellig_module module~trmfun_module trmfun_module module~radbelt_module->module~trmfun_module module~shellig_module->module~radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, public, parameter :: wp = real64 Real working precision if not specified [8 bytes] integer, public, parameter :: ip = int32 Integer working precision if not specified [4 bytes]","tags":"","loc":"module/radbelt_kinds_module.html"},{"title":"radbelt_module – radbelt","text":"Main module. See also https://ccmc.gsfc.nasa.gov/pub/modelweb/geomagnetic/igrf/fortran_code/bilcal.for https://ccmc.gsfc.nasa.gov/pub/modelweb/radiation_belt/radbelt/fortran_code/radbelt.for Uses radbelt_kinds_module shellig_module trmfun_module module~~radbelt_module~~UsesGraph module~radbelt_module radbelt_module module~radbelt_kinds_module radbelt_kinds_module module~radbelt_module->module~radbelt_kinds_module module~shellig_module shellig_module module~radbelt_module->module~shellig_module module~trmfun_module trmfun_module module~radbelt_module->module~trmfun_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env module~shellig_module->module~radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~radbelt_module~~UsedByGraph module~radbelt_module radbelt_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Interfaces public interface get_flux simple function versions for testing public function get_flux_g (lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c (v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Note This routine is not efficient at all since it will reload all the\n files every time it is called. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Derived Types type, public :: radbelt_type the main class that can be used to get the flux. Components Type Visibility Attributes Name Initial type( trm_type ), private :: trm type( shellig_type ), private :: igrf Type-Bound Procedures generic, public :: get_flux => get_flux_g_ , get_flux_c_ procedure, private :: get_flux_c_ procedure, private :: get_flux_g_ procedure, public :: set_data_files_paths procedure, public :: set_igrf_file_path procedure, public :: set_trm_file_path Functions public function get_flux_g_ (me, lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_g (lon, lat, height, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c_ (me, v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\nThis is an alternate version of get_flux_g_ for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. public function get_flux_c (v, year, e, imname) result(flux) Calculate the flux of trapped particles at a specific location and time.\n This is just a function version of the class method from radbelt_type . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(3) :: v real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(in) :: e minimum energy integer, intent(in) :: imname which method to use: Read more… Return Value real(kind=wp) The flux of particles above the given energy, in units of cm^-2 s^-1. Subroutines public subroutine set_trm_file_path (me, dir) Set the trm path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir public subroutine set_igrf_file_path (me, dir) Set the igrf path. Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: dir public subroutine set_data_files_paths (me, aep8_dir, igrf_dir) Set the paths to the data files.\nIf not used or blank, the folder data/aep8 and data/igrf in the\ncurrent working directory is assumed Arguments Type Intent Optional Attributes Name class( radbelt_type ), intent(inout) :: me character(len=*), intent(in) :: aep8_dir character(len=*), intent(in) :: igrf_dir","tags":"","loc":"module/radbelt_module.html"},{"title":"trmfun_module – radbelt","text":"Trapped radiation model. History Based on: trmfun.for 1987 Uses radbelt_kinds_module module~~trmfun_module~~UsesGraph module~trmfun_module trmfun_module module~radbelt_kinds_module radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~trmfun_module~~UsedByGraph module~trmfun_module trmfun_module module~radbelt_module radbelt_module module~radbelt_module->module~trmfun_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial character(len=10), private, parameter, dimension(4) :: mname = ['ae8min.asc', 'ae8max.asc', 'ap8min.asc', 'ap8max.asc'] data files available Derived Types type, public :: trm_type main class for the aep8 model Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: aep8_dir directory containing the data files character(len=:), private, allocatable :: file_loaded the file that has been loaded integer, private, dimension(8) :: ihead = 0 integer, private, dimension(:), allocatable :: map real(kind=wp), private :: fistep = 0.0_wp the stepsize for the parameterization of the logarithm of flux.\nformerly stored in common block tra2 real(kind=wp), private :: f1 = 1.001_wp real(kind=wp), private :: f2 = 1.002_wp Type-Bound Procedures procedure, public :: aep8 ../../ main routine procedure, public :: trara2 ../../ low-level routine procedure, public :: trara1 procedure, public :: get_data_file_dir procedure, public :: set_data_file_dir Functions private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(in) :: me Return Value character(len=:), allocatable private function trara2 (me, map, il, ib) trara2 interpolates linearly in l-b/b0-map to obtain\n the logarithm of integral flux at given l and b/b0. Read more… Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: map (*) is sub-map (for specific energy) of\ntrapped radiation model map integer, intent(in) :: il scaled l-value integer, intent(in) :: ib scaled b/b0-1 Return Value real(kind=wp) scaled logarithm of particle flux Subroutines private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me character(len=*), intent(in) :: dir private subroutine aep8 (me, e, l, bb0, imname, flux) Main wrapper for the radiation model.\nReads the coefficient file and calls the low-level routine. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me real(kind=wp), intent(in) :: e real(kind=wp), intent(in) :: l real(kind=wp), intent(in) :: bb0 integer, intent(in) :: imname which model to load (index in mname array) real(kind=wp), intent(out) :: flux private subroutine trara1 (me, descr, map, fl, bb0, e, f, n) trara1 finds particle fluxes for given energies, magnetic field\nstrength and l-value. function trara2 is used to interpolate in\nb-l-space. Arguments Type Intent Optional Attributes Name class( trm_type ), intent(inout) :: me integer, intent(in) :: descr (8) header of specified trapped radition model integer, intent(in) :: map (*) map of trapped radition model\n(descr and map are explained at the begin\nof the main program model) real(kind=wp), intent(in) :: fl l-value real(kind=wp), intent(in) :: bb0 =b/b0 magnetic field strength normalized\nto field strength at magnetic equator real(kind=wp), intent(in) :: e (n) array of energies in mev real(kind=wp), intent(out) :: f (n) decadic logarithm of integral fluxes in\nparticles/(cm cm sec) integer, intent(in) :: n number of energies","tags":"","loc":"module/trmfun_module.html"},{"title":"shellig_module – radbelt","text":"IGRF model History SHELLIG.FOR, Version 2.0, January 1992 11/01/91-DKB- SHELLG: lowest starting point for B0 search is 2 1/27/92-DKB- Adopted to IGRF-91 coefficients model 2/05/92-DKB- Reduce variable-names: INTER(P)SHC,EXTRA(P)SHC,INITI(ALI)ZE 8/08/95-DKB- Updated to IGRF-45-95; new coeff. DGRF90, IGRF95, IGRF95S 5/31/00-DKB- Updated to IGRF-45-00; new coeff.: IGRF00, IGRF00s 3/24/05-DKB- Updated to IGRF-45-10; new coeff.: IGRF05, IGRF05s Uses radbelt_kinds_module module~~shellig_module~~UsesGraph module~shellig_module shellig_module module~radbelt_kinds_module radbelt_kinds_module module~shellig_module->module~radbelt_kinds_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~shellig_module~~UsedByGraph module~shellig_module shellig_module module~radbelt_module radbelt_module module~radbelt_module->module~shellig_module module~radbelt_c_module radbelt_c_module module~radbelt_c_module->module~radbelt_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, private, parameter :: filename_len = 14 length of the model data file names real(kind=wp), private, parameter :: Era = 6371.2_wp earth radius for normalization of cartesian coordinates (6371.2 km) real(kind=wp), private, parameter :: erequ = 6378.16_wp real(kind=wp), private, parameter :: erpol = 6356.775_wp real(kind=wp), private, parameter :: Aquad = erequ*erequ square of major half axis for\nearth ellipsoid as recommended by international\nastronomical union real(kind=wp), private, parameter :: Bquad = erpol*erpol square of minor half axis for\nearth ellipsoid as recommended by international\nastronomical union real(kind=wp), private, parameter :: Umr = atan(1.0_wp)*4.0_wp/180.0_wp atan(1.0) 4./180. umr= real(kind=wp), private, parameter, dimension(3, 3) :: u = reshape([+0.3511737_wp, -0.9148385_wp, -0.1993679_wp, +0.9335804_wp, +0.3583680_wp, +0.0000000_wp, +0.0714471_wp, -0.1861260_wp, +0.9799247_wp], [3, 3]) integer, private, parameter :: max_loop_index = 3333 used in shellg for the field line integration loop Derived Types type, public :: shellig_type Components Type Visibility Attributes Name Initial character(len=:), private, allocatable :: igrf_dir directory containing the data files real(kind=wp), private, dimension(3) :: sp = 0.0_wp real(kind=wp), private, dimension(3) :: xi = 0.0_wp real(kind=wp), private, dimension(144) :: h = 0.0_wp Field model coefficients adjusted for shellg integer, private :: iyea = 0 the int year corresponding to the file name that has been read character(len=:), private, allocatable :: name file name integer, private :: nmax = 0 maximum order of spherical harmonics real(kind=wp), private :: Time = 0.0_wp year (decimal: 1973.5) for which magnetic field is to be calculated real(kind=wp), private, dimension(144) :: g = 0.0_wp g(m) -- normalized field coefficients (see feldcof ) m=nmax*(nmax+2) integer, private :: nmax1 = 0 saved variables from the file integer, private :: nmax2 = 0 saved variables from the file real(kind=wp), private, dimension(144) :: g_cache = 0.0_wp saved g from the file real(kind=wp), private :: step = 0.20_wp step size for field line tracing real(kind=wp), private :: steq = 0.03_wp step size for integration real(kind=wp), private, dimension(120) :: gh2 = 0.0_wp real(kind=wp), private, dimension(:, :), allocatable :: p this was p(8,100) in the original code.\nused for the field line integration loop.\nchanged it to be allocatable since it was\nchanged to be p(8,3334). Type-Bound Procedures procedure, public :: igrfc procedure, public :: igrf procedure, public :: feldcof procedure, public :: feldc procedure, public :: feldg procedure, public :: shellc procedure, public :: shellg procedure, public :: findb0 procedure, private :: feldi procedure, private :: stoer procedure, public :: get_data_file_dir procedure, public :: set_data_file_dir procedure, public :: destroy => destroy_shellig_type Functions private function get_data_file_dir (me) result(dir) Get the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(in) :: me Return Value character(len=:), allocatable private pure function geo_to_cart (glat, glon, alt) result(x) geodetic to scaled cartesian coordinates Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level Return Value real(kind=wp), dimension(3) cartesian coordinates in earth radii (6371.2 km) x-axis pointing to equator at 0 longitude y-axis pointing to equator at 90 long. z-axis pointing to north pole Subroutines private subroutine destroy_shellig_type (me) Destroy a shellig_type . Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(out) :: me private subroutine set_data_file_dir (me, dir) Set the directory containing the data files. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me character(len=*), intent(in) :: dir private subroutine igrf (me, lon, lat, height, year, xl, bbx) Wrapper for IGRF functions. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: lon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: lat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: height altitude in km above sea level real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio private subroutine igrfc (me, v, year, xl, bbx) Alternate version of igrf for cartesian coordinates. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: xl l-value real(kind=wp), intent(out) :: bbx b_total / b_equatorial ratio private subroutine findb0 (me, stps, bdel, value, bequ, rr0) Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: stps real(kind=wp), intent(inout) :: bdel logical, intent(out) :: value real(kind=wp), intent(out) :: bequ real(kind=wp), intent(out) :: rr0 private subroutine shellc (me, v, dimo, fl, icode, b0) Wrapper to shellg to be used with cartesian coordinates. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\n* x-axis pointing to equator at 0 longitude\n* y-axis pointing to equator at 90 long.\n* z-axis pointing to north pole real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss private subroutine shellg (me, glat, glon, alt, dimo, fl, icode, b0, v) calculates l-value for specified geodaetic coordinates, altitude\n and gemagnetic field model. Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(in) :: dimo dipol moment in gauss (normalized to earth radius) real(kind=wp), intent(out) :: fl l-value integer, intent(out) :: icode Read more… real(kind=wp), intent(out) :: b0 magnetic field strength in gauss real(kind=wp), intent(in), optional, dimension(3) :: v cartesian coordinates in earth radii (6371.2 km) Read more… private subroutine stoer (me, p, bq, r) subroutine used for field line tracing in shellg .\ncalls entry point feldi in geomagnetic field subroutine feldg Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(inout), dimension(7) :: p real(kind=wp), intent(out) :: bq real(kind=wp), intent(out) :: r private subroutine feldg (me, glat, glon, alt, bnorth, beast, bdown, Babs) Calculates earth magnetic field from spherical harmonics model Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: glat geodetic latitude in degrees (north) real(kind=wp), intent(in) :: glon geodetic longitude in degrees (east) real(kind=wp), intent(in) :: alt altitude in km above sea level real(kind=wp), intent(out) :: bnorth components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: beast components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: bdown components of the field with respect\nto the local geodetic coordinate system, with axis\npointing in the tangential plane to the north, east\nand downward. real(kind=wp), intent(out) :: Babs magnetic field strength in gauss private subroutine feldc (me, v, b) Alternate version of feldg to be used with cartesian coordinates Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in), dimension(3) :: v cartesian coordinates in earth radii (6371.2 km)\nx-axis pointing to equator at 0 longitude\ny-axis pointing to equator at 90 long.\nz-axis pointing to north pole real(kind=wp), intent(out) :: b (3) field components private subroutine feldi (me) Used for l computation. Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me private subroutine feldcof (me, year, dimo) Determines coefficients and dipol moment from IGRF models Read more… Arguments Type Intent Optional Attributes Name class( shellig_type ), intent(inout) :: me real(kind=wp), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=wp), intent(out) :: dimo geomagnetic dipol moment in gauss (normalized\nto earth's radius) at the time (year) private subroutine getshc (Fspec, Nmax, Erad, Gh, Ier) Reads spherical harmonic coefficients from the specified\n file into an array. Read more… Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: Fspec File specification integer, intent(out) :: Nmax Maximum degree and order of model real(kind=wp), intent(out) :: Erad Earth's radius associated with the spherical\nharmonic coefficients, in the same units as\nelevation real(kind=wp), intent(out), dimension(*) :: Gh Schmidt quasi-normal internal spherical\nharmonic coefficients integer, intent(out) :: Ier Error number: Read more… private subroutine intershc (date, dte1, nmax1, gh1, dte2, nmax2, gh2, nmax, gh) Interpolates linearly, in time, between two spherical\n harmonic models. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of earlier model integer, intent(in) :: nmax1 Maximum degree and order of earlier model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real(kind=wp), intent(in) :: dte2 Date of later model integer, intent(in) :: nmax2 Maximum degree and order of later model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of later model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model private subroutine extrashc (date, dte1, nmax1, gh1, nmax2, gh2, nmax, gh) Extrapolates linearly a spherical harmonic model with a\n rate-of-change model. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: date Date of resulting model (in decimal year) real(kind=wp), intent(in) :: dte1 Date of base model integer, intent(in) :: nmax1 Maximum degree and order of base model real(kind=wp), intent(in) :: gh1 (*) Schmidt quasi-normal internal spherical harmonic coefficients of base model integer, intent(in) :: nmax2 Maximum degree and order of rate-of-change model real(kind=wp), intent(in) :: gh2 (*) Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model integer, intent(out) :: nmax Maximum degree and order of resulting model real(kind=wp), intent(out) :: gh (*) Coefficients of resulting model","tags":"","loc":"module/shellig_module.html"},{"title":"radbelt_c_module – radbelt","text":"Experimental C interface to the radbelt module. Uses iso_c_binding radbelt_module module~~radbelt_c_module~~UsesGraph module~radbelt_c_module radbelt_c_module iso_c_binding iso_c_binding module~radbelt_c_module->iso_c_binding module~radbelt_module radbelt_module module~radbelt_c_module->module~radbelt_module module~radbelt_kinds_module radbelt_kinds_module module~radbelt_module->module~radbelt_kinds_module module~shellig_module shellig_module module~radbelt_module->module~shellig_module module~trmfun_module trmfun_module module~radbelt_module->module~trmfun_module iso_fortran_env iso_fortran_env module~radbelt_kinds_module->iso_fortran_env module~shellig_module->module~radbelt_kinds_module module~trmfun_module->module~radbelt_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Functions public function c2f_str (cstr) result(fstr) Convert C string to Fortran Arguments Type Intent Optional Attributes Name character(kind=c_char, len=1), intent(in), dimension(:) :: cstr string from C Return Value character(len=:), allocatable fortran string Subroutines public subroutine int_pointer_to_f_pointer (ipointer, p) Convert an integer pointer to a radbelt_type pointer. Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer integer pointer from C type( radbelt_type ), pointer :: p fortran pointer public subroutine initialize_c (ipointer) bind(C, name=\"initialize_c\") create a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(out) :: ipointer public subroutine destroy_c (ipointer) bind(C, name=\"destroy_c\") destroy a radbelt_type from C Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer public subroutine set_trm_file_path_c (ipointer, aep8_dir, n) bind(C, name=\"set_trm_file_path_c\") C interface for setting the trm data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir integer(kind=c_int), intent(in) :: n size of aep8_dir public subroutine set_igrf_file_path_c (ipointer, igrf_dir, n) bind(C, name=\"set_igrf_file_path\") C interface for setting the igrf data file path Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: igrf_dir integer(kind=c_int), intent(in) :: n size of igrf_dir public subroutine set_data_files_paths_c (ipointer, aep8_dir, igrf_dir, n, m) bind(C, name=\"set_data_files_paths_c\") C interface for setting the data file paths Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer character(kind=c_char, len=1), intent(in), dimension(n) :: aep8_dir character(kind=c_char, len=1), intent(in), dimension(m) :: igrf_dir integer(kind=c_int), intent(in) :: n size of aep8_dir integer(kind=c_int), intent(in) :: m size of igrf_dir public subroutine get_flux_g_c (ipointer, lon, lat, height, year, e, imname, flux) bind(C, name=\"get_flux_g_c\") C interface to get_flux_g . Arguments Type Intent Optional Attributes Name integer(kind=c_intptr_t), intent(in) :: ipointer real(kind=c_double), intent(in) :: lon geodetic longitude in degrees (east) real(kind=c_double), intent(in) :: lat geodetic latitude in degrees (north) real(kind=c_double), intent(in) :: height altitude in km above sea level real(kind=c_double), intent(in) :: year decimal year for which geomagnetic field is to\nbe calculated (e.g.:1995.5 for day 185 of 1995) real(kind=c_double), intent(in) :: e minimum energy integer(kind=c_int), intent(in) :: imname which method to use: Read more… real(kind=c_double), intent(out) :: flux The flux of particles above the given energy, in units of cm^-2 s^-1.","tags":"","loc":"module/radbelt_c_module.html"},{"title":"radbelt_kinds_module.F90 – radbelt","text":"Files dependent on this one sourcefile~~radbelt_kinds_module.f90~~AfferentGraph sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_module.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Numeric kind definitions for radbelt. module radbelt_kinds_module use , intrinsic :: iso_fortran_env implicit none private #ifdef REAL32 integer , parameter , public :: wp = real32 !! Real working precision [4 bytes] #elif REAL64 integer , parameter , public :: wp = real64 !! Real working precision [8 bytes] #elif REAL128 integer , parameter , public :: wp = real128 !! Real working precision [16 bytes] #else integer , parameter , public :: wp = real64 !! Real working precision if not specified [8 bytes] #endif #ifdef INT8 integer , parameter , public :: ip = int8 !! Integer working precision [1 byte] #elif INT16 integer , parameter , public :: ip = int16 !! Integer working precision [2 bytes] #elif INT32 integer , parameter , public :: ip = int32 !! Integer working precision [4 bytes] #elif INT64 integer , parameter , public :: ip = int64 !! Integer working precision [8 bytes] #else integer , parameter , public :: ip = int32 !! Integer working precision if not specified [4 bytes] #endif !***************************************************************************************** end module radbelt_kinds_module !*****************************************************************************************","tags":"","loc":"sourcefile/radbelt_kinds_module.f90.html"},{"title":"radbelt_module.f90 – radbelt","text":"This file depends on sourcefile~~radbelt_module.f90~~EfferentGraph sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~radbelt_module.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~radbelt_module.f90~~AfferentGraph sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Main module. ! !### See also ! * https://ccmc.gsfc.nasa.gov/pub/modelweb/geomagnetic/igrf/fortran_code/bilcal.for ! * https://ccmc.gsfc.nasa.gov/pub/modelweb/radiation_belt/radbelt/fortran_code/radbelt.for module radbelt_module use radbelt_kinds_module use trmfun_module use shellig_module implicit none type , public :: radbelt_type !! the main class that can be used to get the flux. private type ( trm_type ) :: trm type ( shellig_type ) :: igrf contains private generic , public :: get_flux => get_flux_g_ , get_flux_c_ procedure :: get_flux_g_ , get_flux_c_ procedure , public :: set_trm_file_path , & set_igrf_file_path , & set_data_files_paths end type radbelt_type interface get_flux !! simple function versions for testing procedure :: get_flux_g procedure :: get_flux_c end interface public :: get_flux contains !***************************************************************************************** !> ! Set the `trm` path. subroutine set_trm_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % trm % set_data_file_dir ( trim ( dir )) end subroutine set_trm_file_path !***************************************************************************************** !***************************************************************************************** !> ! Set the `igrf` path. subroutine set_igrf_file_path ( me , dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir call me % igrf % set_data_file_dir ( trim ( dir )) end subroutine set_igrf_file_path !***************************************************************************************** !***************************************************************************************** !> ! Set the paths to the data files. ! If not used or blank, the folder `data/aep8` and `data/igrf` in the ! current working directory is assumed subroutine set_data_files_paths ( me , aep8_dir , igrf_dir ) class ( radbelt_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: aep8_dir character ( len =* ), intent ( in ) :: igrf_dir call me % set_trm_file_path ( trim ( aep8_dir )) call me % set_igrf_file_path ( trim ( igrf_dir )) end subroutine set_data_files_paths !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. function get_flux_g_ ( me , lon , lat , height , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrf ( lon , lat , height , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_g_ !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. ! This is just a function version of the class method from [[radbelt_type]]. ! !@note This routine is not efficient at all since it will reload all the ! files every time it is called. function get_flux_g ( lon , lat , height , year , e , imname ) result ( flux ) real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( lon , lat , height , year , e , imname ) end function get_flux_g !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. ! This is an alternate version of [[get_flux_g_]] for cartesian coordinates. function get_flux_c_ ( me , v , year , e , imname ) result ( flux ) class ( radbelt_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. real ( wp ) :: xl !! l value real ( wp ) :: bbx call me % igrf % igrfc ( v , year , xl , bbx ) call me % trm % aep8 ( e , xl , bbx , imname , flux ) end function get_flux_c_ !***************************************************************************************** !***************************************************************************************** !> ! Calculate the flux of trapped particles at a specific location and time. ! This is just a function version of the class method from [[radbelt_type]]. ! !@note This routine is not efficient at all since it will reload all the ! files every time it is called. function get_flux_c ( v , year , e , imname ) result ( flux ) real ( wp ), dimension ( 3 ), intent ( in ) :: v real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( in ) :: e !! minimum energy integer , intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( wp ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ) :: radbelt flux = radbelt % get_flux ( v , year , e , imname ) end function get_flux_c end module radbelt_module","tags":"","loc":"sourcefile/radbelt_module.f90.html"},{"title":"trmfun.f90 – radbelt","text":"This file depends on sourcefile~~trmfun.f90~~EfferentGraph sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~trmfun.f90~~AfferentGraph sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Trapped radiation model. ! !### History ! * Based on: `trmfun.for` 1987 module trmfun_module use radbelt_kinds_module implicit none private character ( len = 10 ), dimension ( 4 ), parameter :: mname = [ 'ae8min.asc' , & 'ae8max.asc' , & 'ap8min.asc' , & 'ap8max.asc' ] !! data files available type , public :: trm_type !! main class for the `aep8` model private character ( len = :), allocatable :: aep8_dir !! directory containing the data files ! data read from the files: character ( len = :), allocatable :: file_loaded !! the file that has been loaded integer , dimension ( 8 ) :: ihead = 0 integer , dimension (:), allocatable :: map real ( wp ) :: fistep = 0.0_wp !! the stepsize for the parameterization of the logarithm of flux. !! formerly stored in common block `tra2` ! formerly saved variables in trara1: real ( wp ) :: f1 = 1.001_wp real ( wp ) :: f2 = 1.002_wp contains private procedure , public :: aep8 !! main routine procedure , public :: trara1 , trara2 !! low-level routine procedure , public :: set_data_file_dir , get_data_file_dir end type trm_type contains !***************************************************************************************** !> ! Set the directory containing the data files. subroutine set_data_file_dir ( me , dir ) class ( trm_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % aep8_dir = trim ( dir ) end subroutine set_data_file_dir !***************************************************************************************** !> ! Get the directory containing the data files. function get_data_file_dir ( me ) result ( dir ) class ( trm_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % aep8_dir )) then dir = trim ( me % aep8_dir ) // '/' else dir = 'data/aep8/' ! default end if end function get_data_file_dir !***************************************************************************************** !> ! Main wrapper for the radiation model. ! Reads the coefficient file and calls the low-level routine. subroutine aep8 ( me , e , l , bb0 , imname , flux ) class ( trm_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: e real ( wp ), intent ( in ) :: l real ( wp ), intent ( in ) :: bb0 integer , intent ( in ) :: imname !! which model to load (index in `mname` array) real ( wp ), intent ( out ) :: flux real ( wp ) :: ee ( 1 ), f ( 1 ) !! temp variables integer :: i , ierr , iuaeap , nmap character ( len = :), allocatable :: name logical :: load_file name = me % get_data_file_dir () // trim ( mname ( Imname )) ! the file to load ! JW : do we need to reset some or all of these ? me % fistep = 0.0_wp me % f1 = 1.001_wp me % f2 = 1.002_wp ! check to see if this file has already been loaded ! [the class can store one file at a time] load_file = . true . if ( allocated ( me % file_loaded )) then if ( name == me % file_loaded ) load_file = . false . end if if ( load_file ) then open ( newunit = iuaeap , file = name , status = 'OLD' , iostat = ierr , form = 'FORMATTED' ) if ( ierr /= 0 ) then error stop 'error reading ' // trim ( name ) end if read ( iuaeap , '(1X,12I6)' ) me % ihead nmap = me % ihead ( 8 ) allocate ( me % map ( nmap )) read ( iuaeap , '(1X,12I6)' ) ( me % map ( i ), i = 1 , nmap ) close ( iuaeap ) me % file_loaded = trim ( name ) end if ee ( 1 ) = e call me % trara1 ( me % ihead , me % map , L , Bb0 , ee , f , 1 ) flux = f ( 1 ) if ( Flux > 0.0_wp ) Flux = 1 0.0_wp ** Flux end subroutine aep8 !***************************************************************************************** !***************************************************************************************** !> ! [[trara1]] finds particle fluxes for given energies, magnetic field ! strength and l-value. function [[trara2]] is used to interpolate in ! b-l-space. subroutine trara1 ( me , descr , map , fl , bb0 , e , f , n ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: n !! number of energies integer , intent ( in ) :: descr ( 8 ) !! header of specified trapped radition model real ( wp ), intent ( in ) :: e ( n ) !! array of energies in mev real ( wp ), intent ( in ) :: fl !! l-value real ( wp ), intent ( in ) :: bb0 !! =b/b0 magnetic field strength normalized !! to field strength at magnetic equator integer , intent ( in ) :: map ( * ) !! map of trapped radition model !! (descr and map are explained at the begin !! of the main program model) real ( wp ), intent ( out ) :: f ( n ) !! decadic logarithm of integral fluxes in !! particles/(cm*cm*sec) real ( wp ) :: e0 , e1 , e2 , escale , f0 , fscale , xnl real ( wp ) :: bb0_ !! local copy of `bb0`. in the original code !! this was modified by this routine. !! added this so `bb0` could be `intent(in)` integer :: i0 , i1 , i2 , i3 , ie , l3 , nb , nl logical :: s0 , s1 , s2 e0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings f0 = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings i0 = 0 ! to avoid -Wmaybe-uninitialized warnings s0 = . false . ! to avoid -Wmaybe-uninitialized warnings -- but not sure what default value here should be ! -JW bb0_ = bb0 me % fistep = descr ( 7 ) / descr ( 2 ) escale = descr ( 4 ) fscale = descr ( 7 ) xnl = min ( 1 5.6_wp , abs ( fl )) nl = int ( xnl * descr ( 5 )) if ( bb0_ < 1.0_wp ) bb0_ = 1.0_wp nb = int (( bb0_ - 1.0_wp ) * descr ( 6 )) ! i2 is the number of elements in the flux map for the first energy. ! i3 is the index of the last element of the second energy map. ! l3 is the length of the map for the third energy. ! e1 is the energy of the first energy map (unscaled) ! e2 is the energy of the second energy map (unscaled) i1 = 0 i2 = map ( 1 ) i3 = i2 + map ( i2 + 1 ) l3 = map ( i3 + 1 ) e1 = map ( i1 + 2 ) / escale e2 = map ( i2 + 2 ) / escale ! s0, s1, s2 are logical variables which indicate whether the flux for ! a particular e, b, l point has already been found in a previous call ! to function trara2. if not, s.. =.true. s1 = . true . s2 = . true . ! energy loop do ie = 1 , n ! for each energy e(i) find the successive energies e0,e1,e2 in ! model map, which obey e0 < e1 < e(i) < e2 . do while (( e ( ie ) > e2 ) . and . ( l3 /= 0 )) i0 = i1 i1 = i2 i2 = i3 i3 = i3 + l3 l3 = map ( i3 + 1 ) e0 = e1 e1 = e2 e2 = map ( i2 + 2 ) / escale s0 = s1 s1 = s2 s2 = . true . f0 = me % f1 me % f1 = me % f2 end do ! call trara2 to interpolate the flux-maps for e1,e2 in l-b/b0- ! space to find fluxes f1,f2 [if they have not already been ! calculated for a previous e(i)]. if ( s1 ) me % f1 = me % trara2 ( map ( i1 + 3 ), nl , nb ) / fscale if ( s2 ) me % f2 = me % trara2 ( map ( i2 + 3 ), nl , nb ) / fscale s1 = . false . s2 = . false . ! finally, interpolate in energy. f ( ie ) = me % f1 + ( me % f2 - me % f1 ) * ( e ( ie ) - e1 ) / ( e2 - e1 ) if ( me % f2 <= 0.0_wp ) then if ( i1 /= 0 ) then ! --------- special interpolation --------------------------------- ! if the flux for the second energy cannot be found (i.e. f2=0.0), ! and the zeroth energy map has been defined (i.e. i1 not equal 0), ! then interpolate using the flux maps for the zeroth and first ! energy and choose the minimum of this interpolations and the ! interpolation that was done with f2=0. if ( s0 ) f0 = me % trara2 ( map ( i0 + 3 ), nl , nb ) / fscale s0 = . false . f ( ie ) = min ( f ( ie ), f0 + ( me % f1 - f0 ) * ( e ( ie ) - e0 ) / ( e1 - e0 )) end if end if ! the logarithmic flux is always kept greater or equal zero. f ( ie ) = max ( f ( ie ), 0.0_wp ) end do end subroutine trara1 !***************************************************************************************** !> ! [[trara2]] interpolates linearly in l-b/b0-map to obtain ! the logarithm of integral flux at given l and b/b0. ! !### Note ! see main program 'model' for explanation of map format ! scaling factors. function trara2 ( me , map , il , ib ) class ( trm_type ), intent ( inout ) :: me integer , intent ( in ) :: map ( * ) !! is sub-map (for specific energy) of !! trapped radiation model map integer , intent ( in ) :: il !! scaled l-value integer , intent ( in ) :: ib !! scaled b/b0-1 real ( wp ) :: trara2 !! scaled logarithm of particle flux real ( wp ) :: dfl , fincr1 , fincr2 , fistep , fkb , fkb1 , fkb2 , fkbj1 , fkbj2 , & fkbm , fll1 , fll2 , flog , flog1 , flog2 , flogm , & fnb , fnl , sl1 , sl2 integer :: i1 , i2 , itime , j1 , j2 , kt , l1 , l2 logical :: dummy fistep = me % fistep !******** ! to avoid -Wmaybe-uninitialized warning dfl = 0.0_wp fincr1 = 0.0_wp fincr2 = 0.0_wp fkb = 0.0_wp fkb1 = 0.0_wp fkb2 = 0.0_wp fkbm = 0.0_wp flog = 0.0_wp flog1 = 0.0_wp flog2 = 0.0_wp flogm = 0.0_wp fnb = 0.0_wp fnl = 0.0_wp sl2 = 0.0_wp i1 = 0 i2 = 0 itime = 0 j2 = 0 l1 = 0 l2 = 0 !******** ! these are recursive functions that ! replace the gotos in the original code call task1 ( dummy ) contains recursive subroutine task1 ( done ) logical , intent ( out ) :: done done = . false . fnl = il fnb = ib itime = 0 i2 = 0 do ! find consecutive sub-sub-maps for scaled l-values ls1,ls2, ! with il less or equal ls2. l1,l2 are lengths of sub-sub-maps. ! i1,i2 are indeces of first elements minus 1. l2 = map ( i2 + 1 ) if ( map ( i2 + 2 ) <= il ) then i1 = i2 l1 = l2 i2 = i2 + l2 ! if sub-sub-maps are empty, i. e. length less 4, than trara2=0 elseif (( l1 < 4 ) . and . ( l2 < 4 )) then trara2 = 0.0_wp done = . true . return else ! if flog2 less flog1, than ls2 first map and ls1 second map if ( map ( i2 + 3 ) <= map ( i1 + 3 )) exit call task3 ( done ) return end if end do call task2 ( done ) end subroutine task1 recursive subroutine task2 ( done ) logical , intent ( out ) :: done done = . false . kt = i1 i1 = i2 i2 = kt kt = l1 l1 = l2 l2 = kt call task3 ( done ) end subroutine task2 recursive subroutine task3 ( done ) logical , intent ( out ) :: done logical :: check done = . false . ! determine interpolate in scaled l-value fll1 = map ( i1 + 2 ) fll2 = map ( i2 + 2 ) dfl = ( fnl - fll1 ) / ( fll2 - fll1 ) flog1 = map ( i1 + 3 ) flog2 = map ( i2 + 3 ) fkb1 = 0.0_wp fkb2 = 0.0_wp if ( l1 >= 4 ) then ! b/b0 loop check = . true . do j2 = 4 , l2 fincr2 = map ( i2 + j2 ) if ( fkb2 + fincr2 > fnb ) then check = . false . exit end if fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep end do if ( check ) then itime = itime + 1 if ( itime == 1 ) then call task2 ( done ) return end if trara2 = 0.0_wp done = . true . return end if if ( itime /= 1 ) then if ( j2 == 4 ) then call task4 ( done ) return end if sl2 = flog2 / fkb2 check = . true . do j1 = 4 , l1 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) if ( fkbj1 <= fkb1 ) then check = . false . exit end if end do if ( check ) then if ( fkbj1 <= fkb2 ) then trara2 = 0.0_wp done = . true . return end if end if if ( fkbj1 <= fkb2 ) then fkbm = fkbj1 + ( fkb2 - fkbj1 ) * dfl flogm = fkbm * sl2 flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl1 = flog1 / fkb1 sl2 = flog2 / fkb2 call task5 ( done ) return else fkb1 = 0.0_wp end if end if fkb2 = 0.0_wp end if j2 = 4 fincr2 = map ( i2 + j2 ) flog2 = map ( i2 + 3 ) flog1 = map ( i1 + 3 ) call task4 ( done ) end subroutine task3 recursive subroutine task4 ( done ) logical , intent ( out ) :: done done = . false . flogm = flog1 + ( flog2 - flog1 ) * dfl fkbm = 0.0_wp fkb2 = fkb2 + fincr2 flog2 = flog2 - fistep sl2 = flog2 / fkb2 if ( l1 < 4 ) then fincr1 = 0.0_wp sl1 = - 90000 0.0_wp call task6 ( done ) return else j1 = 4 fincr1 = map ( i1 + j1 ) fkb1 = fkb1 + fincr1 flog1 = flog1 - fistep sl1 = flog1 / fkb1 end if call task5 ( done ) end subroutine task4 recursive subroutine task5 ( done ) logical , intent ( out ) :: done done = . false . do while ( sl1 >= sl2 ) fkbj2 = (( flog2 / fistep ) * fincr2 + fkb2 ) / (( fincr2 / fistep ) * sl1 + 1.0_wp ) fkb = fkb1 + ( fkbj2 - fkb1 ) * dfl flog = fkb * sl1 if ( fkb >= fnb ) then call task7 ( done ) return end if fkbm = fkb flogm = flog if ( j1 >= l1 ) then trara2 = 0.0_wp done = . true . return else j1 = j1 + 1 fincr1 = map ( i1 + j1 ) flog1 = flog1 - fistep fkb1 = fkb1 + fincr1 sl1 = flog1 / fkb1 end if end do call task6 ( done ) end subroutine task5 recursive subroutine task6 ( done ) logical , intent ( out ) :: done done = . false . fkbj1 = (( flog1 / fistep ) * fincr1 + fkb1 ) / (( fincr1 / fistep ) * sl2 + 1.0_wp ) fkb = fkbj1 + ( fkb2 - fkbj1 ) * dfl flog = fkb * sl2 if ( fkb < fnb ) then fkbm = fkb flogm = flog if ( j2 >= l2 ) then trara2 = 0.0_wp done = . true . return else j2 = j2 + 1 fincr2 = map ( i2 + j2 ) flog2 = flog2 - fistep fkb2 = fkb2 + fincr2 sl2 = flog2 / fkb2 call task5 ( done ) return end if end if call task7 ( done ) end subroutine task6 recursive subroutine task7 ( done ) logical , intent ( out ) :: done if ( fkb < fkbm + 1.0e-10_wp ) then trara2 = 0.0_wp else trara2 = flogm + ( flog - flogm ) * (( fnb - fkbm ) / ( fkb - fkbm )) trara2 = max ( trara2 , 0.0_wp ) end if done = . true . end subroutine task7 end function trara2 end module trmfun_module","tags":"","loc":"sourcefile/trmfun.f90.html"},{"title":"shellig.f90 – radbelt","text":"This file depends on sourcefile~~shellig.f90~~EfferentGraph sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~shellig.f90~~AfferentGraph sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! IGRF model ! !### History ! * SHELLIG.FOR, Version 2.0, January 1992 ! * 11/01/91-DKB- SHELLG: lowest starting point for B0 search is 2 ! * 1/27/92-DKB- Adopted to IGRF-91 coefficients model ! * 2/05/92-DKB- Reduce variable-names: INTER(P)SHC,EXTRA(P)SHC,INITI(ALI)ZE ! * 8/08/95-DKB- Updated to IGRF-45-95; new coeff. DGRF90, IGRF95, IGRF95S ! * 5/31/00-DKB- Updated to IGRF-45-00; new coeff.: IGRF00, IGRF00s ! * 3/24/05-DKB- Updated to IGRF-45-10; new coeff.: IGRF05, IGRF05s module shellig_module use radbelt_kinds_module implicit none private integer , parameter :: filename_len = 14 !! length of the model data file names ! parameters formerly in `gener` common block real ( wp ), parameter :: Era = 637 1.2_wp !! earth radius for normalization of cartesian coordinates (6371.2 km) real ( wp ), parameter :: erequ = 637 8.16_wp real ( wp ), parameter :: erpol = 635 6.775_wp real ( wp ), parameter :: Aquad = erequ * erequ !! square of major half axis for !! earth ellipsoid as recommended by international !! astronomical union real ( wp ), parameter :: Bquad = erpol * erpol !! square of minor half axis for !! earth ellipsoid as recommended by international !! astronomical union real ( wp ), parameter :: Umr = atan ( 1.0_wp ) * 4.0_wp / 18 0.0_wp !! atan(1.0)*4./180. *umr= real ( wp ), dimension ( 3 , 3 ), parameter :: u = reshape ([ + 0.3511737_wp , - 0.9148385_wp , - 0.1993679_wp , & + 0.9335804_wp , + 0.3583680_wp , + 0.0000000_wp , & + 0.0714471_wp , - 0.1861260_wp , + 0.9799247_wp ], [ 3 , 3 ]) integer , parameter :: max_loop_index = 3333 !! used in [[shellg]] for the field line integration loop type , public :: shellig_type private character ( len = :), allocatable :: igrf_dir !! directory containing the data files ! formerly in the `fidb0` common block real ( wp ), dimension ( 3 ) :: sp = 0.0_wp ! formerly in blank common real ( wp ), dimension ( 3 ) :: xi = 0.0_wp real ( wp ), dimension ( 144 ) :: h = 0.0_wp !! Field model coefficients adjusted for [[shellg]] ! formerly in `model` common block integer :: iyea = 0 !! the int year corresponding to the file `name` that has been read character ( len = :), allocatable :: name !! file name integer :: nmax = 0 !! maximum order of spherical harmonics real ( wp ) :: Time = 0.0_wp !! year (decimal: 1973.5) for which magnetic field is to be calculated real ( wp ), dimension ( 144 ) :: g = 0.0_wp !! `g(m)` -- normalized field coefficients (see [[feldcof]]) m=nmax*(nmax+2) integer :: nmax1 = 0 !! saved variables from the file integer :: nmax2 = 0 !! saved variables from the file real ( wp ), dimension ( 144 ) :: g_cache = 0.0_wp !! saved `g` from the file ! formerly saved vars in shellg: real ( wp ) :: step = 0.20_wp !! step size for field line tracing real ( wp ) :: steq = 0.03_wp !! step size for integration ! from feldcof, so we can cache the coefficients real ( wp ), dimension ( 120 ) :: gh2 = 0.0_wp ! JW : why is this 120 and g is 144 ??? real ( wp ), dimension (:, :), allocatable :: p !! this was `p(8,100)` in the original code. !! used for the field line integration loop. !! changed it to be allocatable since it was !! changed to be p(8,3334). contains private procedure , public :: igrf , igrfc procedure , public :: feldcof procedure , public :: feldg , feldc procedure , public :: shellg , shellc procedure , public :: findb0 procedure :: stoer , feldi procedure , public :: set_data_file_dir , get_data_file_dir procedure , public :: destroy => destroy_shellig_type end type shellig_type contains !***************************************************************************************** !***************************************************************************************** !> ! Destroy a [[shellig_type]]. subroutine destroy_shellig_type ( me ) class ( shellig_type ), intent ( out ) :: me end subroutine destroy_shellig_type !***************************************************************************************** !> ! Set the directory containing the data files. subroutine set_data_file_dir ( me , dir ) class ( shellig_type ), intent ( inout ) :: me character ( len =* ), intent ( in ) :: dir me % igrf_dir = trim ( dir ) end subroutine set_data_file_dir !***************************************************************************************** !> ! Get the directory containing the data files. function get_data_file_dir ( me ) result ( dir ) class ( shellig_type ), intent ( in ) :: me character ( len = :), allocatable :: dir if ( allocated ( me % igrf_dir )) then dir = trim ( me % igrf_dir ) // '/' else dir = 'data/igrf/' ! default end if end function get_data_file_dir !***************************************************************************************** !> ! Wrapper for IGRF functions. subroutine igrf ( me , lon , lat , height , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: height !! altitude in km above sea level real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , babs , bdel , bdown , beast , & beq , bequ , bnorth , dimo , rr0 integer :: icode logical :: val real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldg ( lat , lon , height , bnorth , beast , bdown , babs ) call me % shellg ( lat , lon , height , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq end if bbx = babs / bequ end subroutine igrf !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[igrf]] for cartesian coordinates. subroutine igrfc ( me , v , year , xl , bbx ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: xl !! l-value real ( wp ), intent ( out ) :: bbx !! b_total / b_equatorial ratio real ( wp ) :: bab1 , bdel , beq , bequ , dimo , rr0 integer :: icode logical :: val real ( wp ), dimension ( 3 ) :: b real ( wp ), parameter :: stps = 0.05_wp ! JW : do we need to reset some or all of these ? me % sp = 0.0_wp me % xi = 0.0_wp me % h = 0.0_wp me % step = 0.20_wp me % steq = 0.03_wp call me % feldcof ( year , dimo ) call me % feldc ( v , b ) call me % shellc ( v , dimo , xl , icode , bab1 ) bequ = dimo / ( xl * xl * xl ) if ( icode == 1 ) then bdel = 1.0e-3_wp call me % findb0 ( stps , bdel , val , beq , rr0 ) if ( val ) bequ = beq end if bbx = norm2 ( b ) / bequ end subroutine igrfc !***************************************************************************************** !***************************************************************************************** !> subroutine findb0 ( me , stps , bdel , value , bequ , rr0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: stps real ( wp ), intent ( inout ) :: bdel real ( wp ), intent ( out ) :: bequ logical , intent ( out ) :: value real ( wp ), intent ( out ) :: rr0 real ( wp ) :: b , bdelta , bmin , bold , bq1 , & bq2 , bq3 , p ( 8 , 4 ), r1 , r2 , r3 , & rold , step , step12 , zz integer :: i , irun , j , n step = stps irun = 0 rold = 0.0_wp ! to avoid -Wmaybe-uninitialized warnings main : do irun = irun + 1 if ( irun > 5 ) then value = . false . exit main end if ! first three points p ( 1 , 2 ) = me % sp ( 1 ) p ( 2 , 2 ) = me % sp ( 2 ) p ( 3 , 2 ) = me % sp ( 3 ) step = - sign ( step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then step = - step r3 = r1 bq3 = bq1 do i = 1 , 5 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz end do end if ! initialization step12 = step / 1 2.0_wp value = . true . bmin = 1.0e4_wp bold = 1.0e4_wp ! corrector (field line tracing) n = 0 corrector : do p ( 1 , 3 ) = p ( 1 , 2 ) + step12 * ( 5.0_wp * p ( 4 , 3 ) + 8.0_wp * p ( 4 , 2 ) - p ( 4 , 1 )) n = n + 1 p ( 2 , 3 ) = p ( 2 , 2 ) + step12 * ( 5.0_wp * p ( 5 , 3 ) + 8.0_wp * p ( 5 , 2 ) - p ( 5 , 1 )) ! predictor (field line tracing) p ( 1 , 4 ) = p ( 1 , 3 ) + step12 * ( 2 3.0_wp * p ( 4 , 3 ) - 1 6.0_wp * p ( 4 , 2 ) + 5.0_wp * p ( 4 , 1 )) p ( 2 , 4 ) = p ( 2 , 3 ) + step12 * ( 2 3.0_wp * p ( 5 , 3 ) - 1 6.0_wp * p ( 5 , 2 ) + 5.0_wp * p ( 5 , 1 )) p ( 3 , 4 ) = p ( 3 , 3 ) + step call me % stoer ( p ( 1 , 4 ), bq3 , r3 ) do j = 1 , 3 do i = 1 , 8 p ( i , j ) = p ( i , j + 1 ) end do end do b = sqrt ( bq3 ) if ( b < bmin ) bmin = b if ( b > bold ) exit corrector bold = b rold = 1.0_wp / r3 me % sp ( 1 ) = p ( 1 , 4 ) me % sp ( 2 ) = p ( 2 , 4 ) me % sp ( 3 ) = p ( 3 , 4 ) end do corrector if ( bold /= bmin ) value = . false . bdelta = ( b - bold ) / bold if ( bdelta <= bdel ) exit main step = step / 1 0.0_wp end do main rr0 = rold bequ = bold bdel = bdelta end subroutine findb0 !***************************************************************************************** !> ! Wrapper to [[shellg]] to be used with cartesian coordinates. ! !@note In the original code, this was an ENTRY point in [[shellg]] and didn't ! include all the outputs. subroutine shellc ( me , v , dimo , fl , icode , b0 ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ) :: glat , glon , alt !! not used call me % shellg ( glat , glon , alt , dimo , fl , icode , b0 , v ) end subroutine shellc !***************************************************************************************** !> ! calculates l-value for specified geodaetic coordinates, altitude ! and gemagnetic field model. ! !### Reference ! * G. KLUGE, EUROPEAN SPACE OPERATIONS CENTER, INTERNAL NOTE ! NO. 67, 1970. ! * G. KLUGE, COMPUTER PHYSICS COMMUNICATIONS 3, 31-35, 1972 ! !### History ! * CHANGES (D. BILITZA, NOV 87): ! - USING CORRECT DIPOL MOMENT I.E.,DIFFERENT COMMON/MODEL/ ! - USING IGRF EARTH MAGNETIC FIELD MODELS FROM 1945 TO 1990 subroutine shellg ( me , glat , glon , alt , dimo , fl , icode , b0 , v ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( in ) :: dimo !! dipol moment in gauss (normalized to earth radius) real ( wp ), intent ( out ) :: fl !! l-value integer , intent ( out ) :: icode !! * =1 normal completion !! * =2 unphysical conjugate point (fl meaningless) !! * =3 shell parameter greater than limit up to !! which accurate calculation is required; !! approximation is used. real ( wp ), intent ( out ) :: b0 !! magnetic field strength in gauss real ( wp ), dimension ( 3 ), intent ( in ), optional :: v !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole !! !! If this argument is present, it is used !! instead of glat,glon,alt. See [[shellc]]. real ( wp ) :: arg1 , arg2 , bequ , bq1 , bq2 , bq3 , c0 , c1 , c2 , c3 , & d0 , d1 , d2 , dimob0 , e0 , e1 , e2 , ff , fi , gg , & hli , oradik , oterm , r , r1 , r2 , r3 , r3h , radik , & rq , step12 , step2 , stp , t , term , xx , z , zq , zz integer :: i , iequ , n real ( wp ), parameter :: rmin = 0.05_wp !! boundaries for identification of `icode=2 and 3` real ( wp ), parameter :: rmax = 1.01_wp !! boundaries for identification of `icode=2 and 3` if (. not . allocated ( me % p )) allocate ( me % p ( 8 , max_loop_index + 1 )) ! because `p(:,n+1)` in the loop bequ = 1.0e10_wp if ( present ( v )) then me % xi ( 1 ) = v ( 1 ) me % xi ( 2 ) = v ( 2 ) me % xi ( 3 ) = v ( 3 ) else me % xi = geo_to_cart ( glat , glon , alt ) end if associate ( p => me % p ) ! convert to dipol-oriented co-ordinates rq = 1.0_wp / ( me % xi ( 1 ) * me % xi ( 1 ) + me % xi ( 2 ) * me % xi ( 2 ) + me % xi ( 3 ) * me % xi ( 3 )) r3h = sqrt ( rq * sqrt ( rq )) p ( 1 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 1 ) + me % xi ( 2 ) * u ( 2 , 1 ) + me % xi ( 3 ) * u ( 3 , 1 )) * r3h p ( 2 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 2 ) + me % xi ( 2 ) * u ( 2 , 2 )) * r3h p ( 3 , 2 ) = ( me % xi ( 1 ) * u ( 1 , 3 ) + me % xi ( 2 ) * u ( 2 , 3 ) + me % xi ( 3 ) * u ( 3 , 3 )) * rq ! first three points of field line me % step = - sign ( me % step , p ( 3 , 2 )) call me % stoer ( p ( 1 , 2 ), bq2 , r2 ) b0 = sqrt ( bq2 ) p ( 1 , 3 ) = p ( 1 , 2 ) + 0.5_wp * me % step * p ( 4 , 2 ) p ( 2 , 3 ) = p ( 2 , 2 ) + 0.5_wp * me % step * p ( 5 , 2 ) p ( 3 , 3 ) = p ( 3 , 2 ) + 0.5_wp * me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) p ( 1 , 1 ) = p ( 1 , 2 ) - me % step * ( 2.0_wp * p ( 4 , 2 ) - p ( 4 , 3 )) p ( 2 , 1 ) = p ( 2 , 2 ) - me % step * ( 2.0_wp * p ( 5 , 2 ) - p ( 5 , 3 )) p ( 3 , 1 ) = p ( 3 , 2 ) - me % step call me % stoer ( p ( 1 , 1 ), bq1 , r1 ) p ( 1 , 3 ) = p ( 1 , 2 ) + me % step * ( 2 0.0_wp * p ( 4 , 3 ) - 3. * p ( 4 , 2 ) + p ( 4 , 1 )) / 1 8.0_wp p ( 2 , 3 ) = p ( 2 , 2 ) + me % step * ( 2 0.0_wp * p ( 5 , 3 ) - 3. * p ( 5 , 2 ) + p ( 5 , 1 )) / 1 8.0_wp p ( 3 , 3 ) = p ( 3 , 2 ) + me % step call me % stoer ( p ( 1 , 3 ), bq3 , r3 ) ! invert sense if required if ( bq3 > bq1 ) then me % step = - me % step r3 = r1 bq3 = bq1 do i = 1 , 7 zz = p ( i , 1 ) p ( i , 1 ) = p ( i , 3 ) p ( i , 3 ) = zz end do end if ! search for lowest magnetic field strength if ( bq1 < bequ ) then bequ = bq1 iequ = 1 end if if ( bq2 < bequ ) then bequ = bq2 iequ = 2 end if if ( bq3 < bequ ) then bequ = bq3 iequ = 3 end if ! initialization of integration loops step12 = me % step / 1 2.0_wp step2 = me % step + me % step me % steq = sign ( me % steq , me % step ) fi = 0.0_wp icode = 1 oradik = 0.0_wp oterm = 0.0_wp stp = r2 * me % steq z = p ( 3 , 2 ) + stp stp = stp / 0.75_wp p ( 8 , 1 ) = step2 * ( p ( 1 , 1 ) * p ( 4 , 1 ) + p ( 2 , 1 ) * p ( 5 , 1 )) p ( 8 , 2 ) = step2 * ( p ( 1 , 2 ) * p ( 4 , 2 ) + p ( 2 , 2 ) * p ( 5 , 2 )) ! main loop (field line tracing) main : do n = 3 , max_loop_index ! corrector (field line tracing) p ( 1 , n ) = p ( 1 , n - 1 ) + step12 * ( 5.0_wp * p ( 4 , n ) + 8.0_wp * p ( 4 , n - 1 ) - p ( 4 , n - 2 )) p ( 2 , n ) = p ( 2 , n - 1 ) + step12 * ( 5.0_wp * p ( 5 , n ) + 8.0_wp * p ( 5 , n - 1 ) - p ( 5 , n - 2 )) ! prepare expansion coefficients for interpolation ! of slowly varying quantities p ( 8 , n ) = step2 * ( p ( 1 , n ) * p ( 4 , n ) + p ( 2 , n ) * p ( 5 , n )) c0 = p ( 1 , n - 1 ) ** 2 + p ( 2 , n - 1 ) ** 2 c1 = p ( 8 , n - 1 ) c2 = ( p ( 8 , n ) - p ( 8 , n - 2 )) * 0.25_wp c3 = ( p ( 8 , n ) + p ( 8 , n - 2 ) - c1 - c1 ) / 6.0_wp d0 = p ( 6 , n - 1 ) d1 = ( p ( 6 , n ) - p ( 6 , n - 2 )) * 0.5_wp d2 = ( p ( 6 , n ) + p ( 6 , n - 2 ) - d0 - d0 ) * 0.5_wp e0 = p ( 7 , n - 1 ) e1 = ( p ( 7 , n ) - p ( 7 , n - 2 )) * 0.5_wp e2 = ( p ( 7 , n ) + p ( 7 , n - 2 ) - e0 - e0 ) * 0.5_wp inner : do ! inner loop (for quadrature) t = ( z - p ( 3 , n - 1 )) / me % step if ( t > 1.0_wp ) then ! predictor (field line tracing) p ( 1 , n + 1 ) = p ( 1 , n ) + step12 * ( 2 3.0_wp * p ( 4 , n ) - 1 6.0_wp * p ( 4 , n - 1 ) + 5.0_wp * p ( 4 , n - 2 )) p ( 2 , n + 1 ) = p ( 2 , n ) + step12 * ( 2 3.0_wp * p ( 5 , n ) - 1 6.0_wp * p ( 5 , n - 1 ) + 5.0_wp * p ( 5 , n - 2 )) p ( 3 , n + 1 ) = p ( 3 , n ) + me % step call me % stoer ( p ( 1 , n + 1 ), bq3 , r3 ) ! search for lowest magnetic field strength if ( bq3 < bequ ) then iequ = n + 1 bequ = bq3 end if exit inner else hli = 0.5_wp * ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) zq = z * z r = hli + sqrt ( hli * hli + zq ) if ( r <= rmin ) then ! approximation for high values of l. icode = 3 t = - p ( 3 , n - 1 ) / me % step fl = 1.0_wp / ( abs ((( c3 * t + c2 ) * t + c1 ) * t + c0 ) + 1.0e-15_wp ) return end if rq = r * r ff = sqrt ( 1.0_wp + 3.0_wp * zq / rq ) radik = b0 - (( d2 * t + d1 ) * t + d0 ) * r * rq * ff if ( r > rmax ) then icode = 2 radik = radik - 1 2.0_wp * ( r - rmax ) ** 2 end if if ( radik + radik <= oradik ) exit main term = sqrt ( radik ) * ff * (( e2 * t + e1 ) * t + e0 ) / ( rq + zq ) fi = fi + stp * ( oterm + term ) oradik = radik oterm = term stp = r * me % steq z = z + stp end if end do inner end do main if ( iequ < 2 ) iequ = 2 me % sp ( 1 ) = p ( 1 , iequ - 1 ) me % sp ( 2 ) = p ( 2 , iequ - 1 ) me % sp ( 3 ) = p ( 3 , iequ - 1 ) if ( oradik >= 1.0e-15_wp ) fi = fi + stp / 0.75_wp * oterm * oradik / ( oradik - radik ) ! the minimal allowable value of fi was changed from 1e-15 to 1e-12, ! because 1e-38 is the minimal allowable arg. for alog in our envir. ! d. bilitza, nov 87. fi = 0.5_wp * abs ( fi ) / sqrt ( b0 ) + 1.0e-12_wp ! compute l from b and i. same as carmel in invar. ! correct dipole moment is used here. d. bilitza, nov 87. dimob0 = dimo / b0 arg1 = log ( fi ) arg2 = log ( dimob0 ) ! arg = fi*fi*fi/dimob0 ! if(abs(arg)>88.0_wp) arg=88.0_wp xx = 3 * arg1 - arg2 if ( xx > 2 3.0_wp ) then gg = xx - 3.0460681_wp elseif ( xx > 1 1.7_wp ) then gg = ((((( 2.8212095e-8_wp * xx - 3.8049276e-6_wp ) * xx + & 2.170224e-4_wp ) * xx - 6.7310339e-3_wp ) * xx + & 1.2038224e-1_wp ) * xx - 1.8461796e-1_wp ) * xx + 2.0007187_wp elseif ( xx > + 3.0_wp ) then gg = (((((((( 6.3271665e-10_wp * xx - 3.958306e-8_wp ) * xx + & 9.9766148e-07_wp ) * xx - 1.2531932e-5_wp ) * xx + & 7.9451313e-5_wp ) * xx - 3.2077032e-4_wp ) * xx + & 2.1680398e-3_wp ) * xx + 1.2817956e-2_wp ) * xx + & 4.3510529e-1_wp ) * xx + 6.222355e-1_wp elseif ( xx > - 3.0_wp ) then gg = (((((((( 2.6047023e-10_wp * xx + 2.3028767e-9_wp ) * xx - & 2.1997983e-8_wp ) * xx - 5.3977642e-7_wp ) * xx - & 3.3408822e-6_wp ) * xx + 3.8379917e-5_wp ) * xx + & 1.1784234e-3_wp ) * xx + 1.4492441e-2_wp ) * xx + & 4.3352788e-1_wp ) * xx + 6.228644e-1_wp elseif ( xx > - 2 2.0_wp ) then gg = (((((((( - 8.1537735e-14_wp * xx + 8.3232531e-13_wp ) * xx + & 1.0066362e-9_wp ) * xx + 8.1048663e-8_wp ) * xx + & 3.2916354e-6_wp ) * xx + 8.2711096e-5_wp ) * xx + & 1.3714667e-3_wp ) * xx + 1.5017245e-2_wp ) * xx + & 4.3432642e-1_wp ) * xx + 6.2337691e-1_wp else gg = 3.33338e-1_wp * xx + 3.0062102e-1_wp end if fl = exp ( log (( 1.0_wp + exp ( gg )) * dimob0 ) / 3.0_wp ) end associate end subroutine shellg !***************************************************************************************** !> ! subroutine used for field line tracing in [[shellg]]. ! calls entry point [[feldi]] in geomagnetic field subroutine [[feldg]] subroutine stoer ( me , p , bq , r ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 7 ), intent ( inout ) :: p real ( wp ), intent ( out ) :: bq real ( wp ), intent ( out ) :: r real ( wp ) :: dr , dsq , dx , dxm , dy , dym , dz , & dzm , fli , q , rq , wr , xm , ym , zm ! xm,ym,zm are geomagnetic cartesian inverse co-ordinates zm = P ( 3 ) fli = P ( 1 ) * P ( 1 ) + P ( 2 ) * P ( 2 ) + 1.0e-15_wp R = 0.5_wp * ( fli + sqrt ( fli * fli + ( zm + zm ) ** 2 )) rq = R * R wr = sqrt ( R ) xm = P ( 1 ) * wr ym = P ( 2 ) * wr ! transform to geographic co-ordinate system me % Xi ( 1 ) = xm * u ( 1 , 1 ) + ym * u ( 1 , 2 ) + zm * u ( 1 , 3 ) me % Xi ( 2 ) = xm * u ( 2 , 1 ) + ym * u ( 2 , 2 ) + zm * u ( 2 , 3 ) me % Xi ( 3 ) = xm * u ( 3 , 1 ) + zm * u ( 3 , 3 ) ! compute derivatives ! Changed from CALL FELDI(XI,H); XI, H are in COMMON block; results ! are the same; dkb Feb 1998. ! JW : feb 2024 : xi, h now class variables. call me % feldi () q = me % H ( 1 ) / rq dx = me % H ( 3 ) + me % H ( 3 ) + q * me % Xi ( 1 ) dy = me % H ( 4 ) + me % H ( 4 ) + q * me % Xi ( 2 ) dz = me % H ( 2 ) + me % H ( 2 ) + q * me % Xi ( 3 ) ! transform back to geomagnetic co-ordinate system dxm = u ( 1 , 1 ) * dx + u ( 2 , 1 ) * dy + u ( 3 , 1 ) * dz dym = u ( 1 , 2 ) * dx + u ( 2 , 2 ) * dy dzm = u ( 1 , 3 ) * dx + u ( 2 , 3 ) * dy + u ( 3 , 3 ) * dz dr = ( xm * dxm + ym * dym + zm * dzm ) / R ! form slowly varying expressions P ( 4 ) = ( wr * dxm - 0.5_wp * P ( 1 ) * dr ) / ( R * dzm ) P ( 5 ) = ( wr * dym - 0.5_wp * P ( 2 ) * dr ) / ( R * dzm ) dsq = rq * ( dxm * dxm + dym * dym + dzm * dzm ) Bq = dsq * rq * rq P ( 6 ) = sqrt ( dsq / ( rq + 3.0_wp * zm * zm )) P ( 7 ) = P ( 6 ) * ( rq + zm * zm ) / ( rq * dzm ) end subroutine stoer !***************************************************************************************** !> ! Calculates earth magnetic field from spherical harmonics model ! !### Reference ! ref: g. kluge, european space operations centre, internal note 61, ! 1970. ! !### History ! * changes (d. bilitza, nov 87): ! - field coefficients in binary data files instead of block data ! - calculates dipol moment ! !@note In the original code, [[feldc] and [[feldi]] were ! ENTRY points to this routine subroutine feldg ( me , glat , glon , alt , bnorth , beast , bdown , babs ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), intent ( out ) :: bnorth , beast , bdown !! components of the field with respect !! to the local geodetic coordinate system, with axis !! pointing in the tangential plane to the north, east !! and downward. real ( wp ), intent ( out ) :: Babs !! magnetic field strength in gauss real ( wp ) :: brho , bxxx , byyy , bzzz , cp , ct , d , f , rho , & rlat , rlon , rq , s , sp , st , t , & x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m ! same calculation as geo_to_cart, but not used here ! because the intermediate variables are also used below. rlat = glat * umr ct = sin ( rlat ) st = cos ( rlat ) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rlon = glon * umr cp = cos ( rlon ) sp = sin ( rlon ) zzz = ( alt + bquad / d ) * ct / era rho = ( alt + aquad / d ) * st / era xxx = rho * cp yyy = rho * sp rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) bxxx = t * ( me % h ( 3 ) - s * xxx ) byyy = t * ( me % h ( 4 ) - s * yyy ) bzzz = t * ( me % h ( 2 ) - s * zzz ) babs = sqrt ( bxxx * bxxx + byyy * byyy + bzzz * bzzz ) beast = byyy * cp - bxxx * sp brho = byyy * sp + bxxx * cp bnorth = bzzz * st - brho * ct bdown = - bzzz * ct - brho * st end subroutine feldg !***************************************************************************************** !> ! Alternate version of [[feldg]] to be used with cartesian coordinates subroutine feldc ( me , v , b ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), dimension ( 3 ), intent ( in ) :: v !! cartesian coordinates in earth radii (6371.2 km) !! x-axis pointing to equator at 0 longitude !! y-axis pointing to equator at 90 long. !! z-axis pointing to north pole real ( wp ), intent ( out ) :: b ( 3 ) !! field components real ( wp ) :: f , rq , s , t , x , xxx , y , yyy , z , zzz integer :: i , ih , ihmax , il , imax , k , last , m xxx = v ( 1 ) yyy = v ( 2 ) zzz = v ( 3 ) rq = 1.0_wp / ( xxx * xxx + yyy * yyy + zzz * zzz ) me % xi = [ xxx , yyy , zzz ] * rq ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do s = 0.5_wp * me % h ( 1 ) + 2.0_wp * ( me % h ( 2 ) * me % xi ( 3 ) + me % h ( 3 ) * me % xi ( 1 ) + me % h ( 4 ) * me % xi ( 2 )) t = ( rq + rq ) * sqrt ( rq ) b ( 1 ) = t * ( me % h ( 3 ) - s * xxx ) b ( 2 ) = t * ( me % h ( 4 ) - s * yyy ) b ( 3 ) = t * ( me % h ( 2 ) - s * zzz ) end subroutine feldc !***************************************************************************************** !> ! Used for `l` computation. subroutine feldi ( me ) class ( shellig_type ), intent ( inout ) :: me real ( wp ) :: f , x , y , z integer :: i , ih , ihmax , il , imax , k , last , m ihmax = me % nmax * me % nmax + 1 last = ihmax + me % nmax + me % nmax imax = me % nmax + me % nmax - 1 do i = ihmax , last me % h ( i ) = me % g ( i ) end do do k = 1 , 3 , 2 i = imax ih = ihmax do il = ih - i f = 2.0_wp / real ( i - k + 2 , wp ) x = me % xi ( 1 ) * f y = me % xi ( 2 ) * f z = me % xi ( 3 ) * ( f + f ) i = i - 2 if (( i - 1 ) >= 0 ) then if (( i - 1 ) > 0 ) then do m = 3 , i , 2 me % h ( il + m + 1 ) = me % g ( il + m + 1 ) + z * me % h ( ih + m + 1 ) + x * ( me % h ( ih + m + 3 ) - & me % h ( ih + m - 1 )) - y * ( me % h ( ih + m + 2 ) + me % h ( ih + m - 2 )) me % h ( il + m ) = me % g ( il + m ) + z * me % h ( ih + m ) + x * ( me % h ( ih + m + 2 ) - & me % h ( ih + m - 2 )) + y * ( me % h ( ih + m + 3 ) + me % h ( ih + m - 1 )) end do end if me % h ( il + 2 ) = me % g ( il + 2 ) + z * me % h ( ih + 2 ) + x * me % h ( ih + 4 ) - y * ( me % h ( ih + 3 ) + me % h ( ih )) me % h ( il + 1 ) = me % g ( il + 1 ) + z * me % h ( ih + 1 ) + y * me % h ( ih + 4 ) + x * ( me % h ( ih + 3 ) - me % h ( ih )) end if me % h ( il ) = me % g ( il ) + z * me % h ( ih ) + 2.0_wp * ( x * me % h ( ih + 1 ) + y * me % h ( ih + 2 )) ih = il if ( i < k ) exit end do end do end subroutine feldi !***************************************************************************************** !> ! Determines coefficients and dipol moment from IGRF models ! !### Author ! * D. BILITZA, NSSDC, GSFC, CODE 633, GREENBELT, MD 20771, ! (301) 286-9536 NOV 1987. ! !### History ! * corrected for 2000 update - dkb- 5/31/2000 ! * updated to IGRF-2000 version -dkb- 5/31/2000 ! * updated to IGRF-2005 version -dkb- 3/24/2000 subroutine feldcof ( me , year , dimo ) class ( shellig_type ), intent ( inout ) :: me real ( wp ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( wp ), intent ( out ) :: dimo !! geomagnetic dipol moment in gauss (normalized !! to earth's radius) at the time (year) real ( wp ) :: dte1 , dte2 , erad , gha ( 144 ), sqrt2 integer :: i , ier , j , l , m , n , iyea character ( len = :), allocatable :: fil2 real ( wp ) :: x , f0 , f !! these were double precision in original !! code while everything else was single precision ! changed to conform with IGRF 45-95, also FILMOD, DTEMOD arrays +1 character ( len = filename_len ), dimension ( 17 ), parameter :: filmod = [ & 'dgrf1945.dat ' , 'dgrf1950.dat ' , 'dgrf1955.dat ' , 'dgrf1960.dat ' , & 'dgrf1965.dat ' , 'dgrf1970.dat ' , 'dgrf1975.dat ' , 'dgrf1980.dat ' , & 'dgrf1985.dat ' , 'dgrf1990.dat ' , 'dgrf1995.dat ' , 'dgrf2000.dat ' , & 'dgrf2005.dat ' , 'dgrf2010.dat ' , 'dgrf2015.dat ' , 'igrf2020.dat ' , & 'igrf2020s.dat' ] real ( wp ), dimension ( 17 ), parameter :: dtemod = [ 194 5.0_wp , 195 0.0_wp , 195 5.0_wp , & 196 0.0_wp , 196 5.0_wp , 197 0.0_wp , & 197 5.0_wp , 198 0.0_wp , 198 5.0_wp , & 199 0.0_wp , 199 5.0_wp , 200 0.0_wp , & 200 5.0_wp , 201 0.0_wp , 201 5.0_wp , & 202 0.0_wp , 202 5.0_wp ] integer , parameter :: numye = size ( dtemod ) - 1 ! number of 5-year priods represented by IGRF integer , parameter :: is = 0 !! * is=0 for schmidt normalization !! * is=1 gauss normalization logical :: read_file !-- determine igrf-years for input-year me % time = year iyea = int ( year / 5.0_wp ) * 5 read_file = iyea /= me % iyea ! if we have to read the file me % iyea = iyea l = ( me % iyea - 1945 ) / 5 + 1 if ( l < 1 ) l = 1 if ( l > numye ) l = numye dte1 = dtemod ( l ) me % name = me % get_data_file_dir () // trim ( filmod ( l )) dte2 = dtemod ( l + 1 ) fil2 = me % get_data_file_dir () // trim ( filmod ( l + 1 )) if ( read_file ) then ! get igrf coefficients for the boundary years ! [if they have not ready been loaded] call getshc ( me % name , me % nmax1 , erad , me % g , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( me % name ) me % g_cache = me % g ! because it is modified below, we have to cache the original values from the file call getshc ( fil2 , me % nmax2 , erad , me % gh2 , ier ) if ( ier /= 0 ) error stop 'error reading file: ' // trim ( fil2 ) else me % g = me % g_cache end if !-- determine igrf coefficients for year if ( l <= numye - 1 ) then call intershc ( year , dte1 , me % nmax1 , me % g , dte2 , me % nmax2 , me % gh2 , me % nmax , gha ) else call extrashc ( year , dte1 , me % nmax1 , me % g , me % nmax2 , me % gh2 , me % nmax , gha ) end if !-- determine magnetic dipol moment and coeffiecients g f0 = 0.0_wp do j = 1 , 3 f = gha ( j ) * 1.0e-5_wp f0 = f0 + f * f end do dimo = sqrt ( f0 ) me % g ( 1 ) = 0.0_wp i = 2 f0 = 1.0e-5_wp if ( is == 0 ) f0 = - f0 sqrt2 = sqrt ( 2.0_wp ) do n = 1 , me % nmax x = n f0 = f0 * x * x / ( 4.0_wp * x - 2.0_wp ) if ( is == 0 ) f0 = f0 * ( 2.0_wp * x - 1.0_wp ) / x f = f0 * 0.5_wp if ( is == 0 ) f = f * sqrt2 me % g ( i ) = gha ( i - 1 ) * f0 i = i + 1 do m = 1 , n f = f * ( x + m ) / ( x - m + 1.0_wp ) if ( is == 0 ) f = f * sqrt (( x - m + 1.0_wp ) / ( x + m )) me % g ( i ) = gha ( i - 1 ) * f me % g ( i + 1 ) = gha ( i ) * f i = i + 2 end do end do end subroutine feldcof !***************************************************************************************** !> ! Reads spherical harmonic coefficients from the specified ! file into an array. ! !### Author ! * Version 1.01, A. Zunde, USGS, MS 964, ! Box 25046 Federal Center, Denver, CO 80225 subroutine getshc ( Fspec , Nmax , Erad , Gh , Ier ) character ( len =* ), intent ( in ) :: Fspec !! File specification integer , intent ( out ) :: Nmax !! Maximum degree and order of model real ( wp ), intent ( out ) :: Erad !! Earth's radius associated with the spherical !! harmonic coefficients, in the same units as !! elevation real ( wp ), dimension ( * ), intent ( out ) :: Gh !! Schmidt quasi-normal internal spherical !! harmonic coefficients integer , intent ( out ) :: Ier !! Error number: !! !! * 0, no error !! * -2, records out of order !! * FORTRAN run-time error number integer :: iu !! logical unit number real ( wp ) :: g , h integer :: i , m , mm , n , nn read_file : block ! --------------------------------------------------------------- ! Open coefficient file. Read past first header record. ! Read degree and order of model and Earth's radius. ! --------------------------------------------------------------- open ( newunit = Iu , FILE = Fspec , STATUS = 'OLD' , IOSTAT = Ier ) if ( Ier /= 0 ) then write ( * , * ) 'Error opening file: ' // trim ( fspec ) exit read_file end if read ( Iu , * , IOSTAT = Ier ) if ( Ier /= 0 ) exit read_file read ( Iu , * , IOSTAT = Ier ) Nmax , Erad if ( Ier /= 0 ) exit read_file ! --------------------------------------------------------------- ! Read the coefficient file, arranged as follows: ! ! N M G H ! ---------------------- ! / 1 0 GH(1) - ! / 1 1 GH(2) GH(3) ! / 2 0 GH(4) - ! / 2 1 GH(5) GH(6) ! NMAX*(NMAX+3)/2 / 2 2 GH(7) GH(8) ! records \\ 3 0 GH(9) - ! \\ . . . . ! \\ . . . . ! NMAX*(NMAX+2) \\ . . . . ! elements in GH \\ NMAX NMAX . . ! ! N and M are, respectively, the degree and order of the ! coefficient. ! --------------------------------------------------------------- i = 0 main : do nn = 1 , Nmax do mm = 0 , nn read ( Iu , * , IOSTAT = Ier ) n , m , g , h if ( Ier /= 0 ) exit main if ( nn /= n . or . mm /= m ) then Ier = - 2 exit main end if i = i + 1 Gh ( i ) = g if ( m /= 0 ) then i = i + 1 Gh ( i ) = h end if end do end do main end block read_file close ( Iu ) end subroutine getshc !***************************************************************************************** !> ! Interpolates linearly, in time, between two spherical ! harmonic models. ! ! The coefficients (GH) of the resulting model, at date ! DATE, are computed by linearly interpolating between the ! coefficients of the earlier model (GH1), at date DTE1, ! and those of the later model (GH2), at date DTE2. If one ! model is smaller than the other, the interpolation is ! performed with the missing coefficients assumed to be 0. ! !### Author ! * Version 1.01, A. Zunde ! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 subroutine intershc ( date , dte1 , nmax1 , gh1 , dte2 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of earlier model integer , intent ( in ) :: nmax1 !! Maximum degree and order of earlier model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of earlier model real ( wp ), intent ( in ) :: dte2 !! Date of later model integer , intent ( in ) :: nmax2 !! Maximum degree and order of later model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of later model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) / ( dte2 - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) + factor * ( - gh1 ( i )) end do nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) end do nmax = nmax2 end if do i = 1 , k gh ( i ) = gh1 ( i ) + factor * ( gh2 ( i ) - gh1 ( i )) end do end subroutine intershc !***************************************************************************************** !> ! Extrapolates linearly a spherical harmonic model with a ! rate-of-change model. ! ! The coefficients (GH) of the resulting model, at date ! DATE, are computed by linearly extrapolating the coef- ! ficients of the base model (GH1), at date DTE1, using ! those of the rate-of-change model (GH2), at date DTE2. If ! one model is smaller than the other, the extrapolation is ! performed with the missing coefficients assumed to be 0. ! !### Author ! * Version 1.01, A. Zunde ! USGS, MS 964, Box 25046 Federal Center, Denver, CO 80225 subroutine extrashc ( date , dte1 , nmax1 , gh1 , nmax2 , gh2 , nmax , gh ) real ( wp ), intent ( in ) :: date !! Date of resulting model (in decimal year) real ( wp ), intent ( in ) :: dte1 !! Date of base model integer , intent ( in ) :: nmax1 !! Maximum degree and order of base model real ( wp ), intent ( in ) :: gh1 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of base model integer , intent ( in ) :: nmax2 !! Maximum degree and order of rate-of-change model real ( wp ), intent ( in ) :: gh2 ( * ) !! Schmidt quasi-normal internal spherical harmonic coefficients of rate-of-change model real ( wp ), intent ( out ) :: gh ( * ) !! Coefficients of resulting model integer , intent ( out ) :: nmax !! Maximum degree and order of resulting model real ( wp ) :: factor integer :: i , k , l factor = ( date - dte1 ) if ( nmax1 == nmax2 ) then k = nmax1 * ( nmax1 + 2 ) nmax = nmax1 elseif ( nmax1 > nmax2 ) then k = nmax2 * ( nmax2 + 2 ) l = nmax1 * ( nmax1 + 2 ) do i = k + 1 , l gh ( i ) = gh1 ( i ) end do nmax = nmax1 else k = nmax1 * ( nmax1 + 2 ) l = nmax2 * ( nmax2 + 2 ) do i = k + 1 , l gh ( i ) = factor * gh2 ( i ) end do nmax = nmax2 end if do i = 1 , k gh ( i ) = gh1 ( i ) + factor * gh2 ( i ) end do end subroutine extrashc !***************************************************************************************** !> ! geodetic to scaled cartesian coordinates pure function geo_to_cart ( glat , glon , alt ) result ( x ) real ( wp ), intent ( in ) :: glat !! geodetic latitude in degrees (north) real ( wp ), intent ( in ) :: glon !! geodetic longitude in degrees (east) real ( wp ), intent ( in ) :: alt !! altitude in km above sea level real ( wp ), dimension ( 3 ) :: x !! cartesian coordinates in earth radii (6371.2 km) !! !! * x-axis pointing to equator at 0 longitude !! * y-axis pointing to equator at 90 long. !! * z-axis pointing to north pole real ( wp ) :: rlat !! latitude in radians real ( wp ) :: rlon !! longitude in radians real ( wp ) :: d , rho ! deg to radians: rlat = glat * umr rlon = glon * umr ! JW : it's weird that ct is sin, and st is cos...it was like that in the original code associate ( ct => sin ( rlat ), st => cos ( rlat ), cp => cos ( rlon ), sp => sin ( rlon )) d = sqrt ( aquad - ( aquad - bquad ) * ct * ct ) rho = ( alt + aquad / d ) * st / era x = [ rho * cp , rho * sp , ( alt + bquad / d ) * ct / era ] end associate end function geo_to_cart end module SHELLIG_module","tags":"","loc":"sourcefile/shellig.f90.html"},{"title":"radbelt_c_module.f90 – radbelt","text":"This file depends on sourcefile~~radbelt_c_module.f90~~EfferentGraph sourcefile~radbelt_c_module.f90 radbelt_c_module.f90 sourcefile~radbelt_module.f90 radbelt_module.f90 sourcefile~radbelt_c_module.f90->sourcefile~radbelt_module.f90 sourcefile~radbelt_kinds_module.f90 radbelt_kinds_module.F90 sourcefile~radbelt_module.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~shellig.f90 shellig.f90 sourcefile~radbelt_module.f90->sourcefile~shellig.f90 sourcefile~trmfun.f90 trmfun.f90 sourcefile~radbelt_module.f90->sourcefile~trmfun.f90 sourcefile~shellig.f90->sourcefile~radbelt_kinds_module.f90 sourcefile~trmfun.f90->sourcefile~radbelt_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! Experimental C interface to the radbelt module. module radbelt_c_module use iso_c_binding , only : c_double , c_int , c_char , c_null_char , & c_intptr_t , c_ptr , c_loc , c_f_pointer , & c_null_ptr , c_associated use radbelt_module , only : radbelt_type implicit none contains !***************************************************************************************** !***************************************************************************************** !> ! Convert C string to Fortran function c2f_str ( cstr ) result ( fstr ) character ( kind = c_char , len = 1 ), dimension (:), intent ( in ) :: cstr !! string from C character ( len = :), allocatable :: fstr !! fortran string integer :: i !! counter fstr = '' do i = 1 , size ( cstr ) fstr = fstr // cstr ( i ) end do fstr = trim ( fstr ) end function c2f_str !***************************************************************************************** !> ! Convert an integer pointer to a [[radbelt_type]] pointer. subroutine int_pointer_to_f_pointer ( ipointer , p ) integer ( c_intptr_t ), intent ( in ) :: ipointer !! integer pointer from C type ( radbelt_type ), pointer :: p !! fortran pointer type ( c_ptr ) :: cp cp = transfer ( ipointer , c_null_ptr ) if ( c_associated ( cp )) then call c_f_pointer ( cp , p ) else p => null () end if end subroutine int_pointer_to_f_pointer !***************************************************************************************** !> ! create a [[radbelt_type]] from C subroutine initialize_c ( ipointer ) bind ( C , name = \"initialize_c\" ) integer ( c_intptr_t ), intent ( out ) :: ipointer type ( radbelt_type ), pointer :: p type ( c_ptr ) :: cp allocate ( p ) cp = c_loc ( p ) ipointer = transfer ( cp , 0_c_intptr_t ) end subroutine initialize_c !***************************************************************************************** !> ! destroy a [[radbelt_type]] from C subroutine destroy_c ( ipointer ) bind ( C , name = \"destroy_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) deallocate ( p ) end subroutine destroy_c !***************************************************************************************** !> ! C interface for setting the `trm` data file path subroutine set_trm_file_path_c ( ipointer , aep8_dir , n ) bind ( C , name = \"set_trm_file_path_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir character ( len = :), allocatable :: aep8_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) call p % set_trm_file_path ( aep8_dir_ ) else error stop 'error in set_trm_file_path_c: class is not associated' end if end subroutine set_trm_file_path_c !***************************************************************************************** !***************************************************************************************** !> ! C interface for setting the `igrf` data file path subroutine set_igrf_file_path_c ( ipointer , igrf_dir , n ) bind ( C , name = \"set_igrf_file_path\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then igrf_dir_ = c2f_str ( igrf_dir ) call p % set_igrf_file_path ( igrf_dir_ ) else error stop 'error in set_igrf_file_path: class is not associated' end if end subroutine set_igrf_file_path_c !***************************************************************************************** !***************************************************************************************** !> ! C interface for setting the data file paths subroutine set_data_files_paths_c ( ipointer , aep8_dir , igrf_dir , n , m ) bind ( C , name = \"set_data_files_paths_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer integer ( c_int ), intent ( in ) :: n !! size of `aep8_dir` character ( kind = c_char , len = 1 ), dimension ( n ), intent ( in ) :: aep8_dir integer ( c_int ), intent ( in ) :: m !! size of `igrf_dir` character ( kind = c_char , len = 1 ), dimension ( m ), intent ( in ) :: igrf_dir character ( len = :), allocatable :: aep8_dir_ , igrf_dir_ type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then aep8_dir_ = c2f_str ( aep8_dir ) igrf_dir_ = c2f_str ( igrf_dir ) call p % set_data_files_paths ( aep8_dir_ , igrf_dir_ ) else error stop 'error in set_data_files_paths_c: class is not associated' end if end subroutine set_data_files_paths_c !***************************************************************************************** !***************************************************************************************** !> ! C interface to [[get_flux_g]]. subroutine get_flux_g_c ( ipointer , lon , lat , height , year , e , imname , flux ) bind ( C , name = \"get_flux_g_c\" ) integer ( c_intptr_t ), intent ( in ) :: ipointer real ( c_double ), intent ( in ) :: lon !! geodetic longitude in degrees (east) real ( c_double ), intent ( in ) :: lat !! geodetic latitude in degrees (north) real ( c_double ), intent ( in ) :: height !! altitude in km above sea level real ( c_double ), intent ( in ) :: year !! decimal year for which geomagnetic field is to !! be calculated (e.g.:1995.5 for day 185 of 1995) real ( c_double ), intent ( in ) :: e !! minimum energy integer ( c_int ), intent ( in ) :: imname !! which method to use: !! !! * 1 -- particle species: electrons, solar activity: min !! * 2 -- particle species: electrons, solar activity: max !! * 3 -- particle species: protons, solar activity: min !! * 4 -- particle species: protons, solar activity: max real ( c_double ), intent ( out ) :: flux !! The flux of particles above the given energy, in units of cm^-2 s^-1. type ( radbelt_type ), pointer :: p call int_pointer_to_f_pointer ( ipointer , p ) if ( associated ( p )) then flux = p % get_flux ( lon , lat , height , year , e , imname ) else error stop 'error in get_flux_g_c: class is not associated' end if end subroutine get_flux_g_c !***************************************************************************************** end module radbelt_c_module !*****************************************************************************************","tags":"","loc":"sourcefile/radbelt_c_module.f90.html"}]}
\ No newline at end of file
diff --git a/type/radbelt_type.html b/type/radbelt_type.html
index caa36a1..816f3e2 100644
--- a/type/radbelt_type.html
+++ b/type/radbelt_type.html
@@ -466,7 +466,7 @@ Arguments
:: |
imname |
- which method to use: Read more…
+which method to use: Read more…
|
@@ -572,7 +572,7 @@ Arguments
:: |
imname |
- which method to use: Read more…
+which method to use: Read more…
|