!
      module magfield_module
!
! Read and calculate magnetic field data used for transformation 
!   between geographic and geomagnetic coordinate systems. 
!   Sub magfield is called once per run from main tgcm.F.
!   Magfield calls nc_rdmag, magdyn, and dynpotmag.
!
! Nc_rdmag:  Read netcdf file containing magnetic field information.
! Magdyn:    Establish magnetic field and grid (bx,by,bz).
! Dynpotmag: Transform electric potential (from source history) from
!            geographic to geomagnetic grid.
!
! Sub sunloc is called once per timestep from advance to determine
!   sun's longitudes for current ut model time.
!
      use params_module,only: nmlonp1,nmlat,nlat,nlonp4,nlatp2,nlonp2,
     |  nlon,nlonp1,nlevp1,nmlon,nlatp1,nmlev
      use input_module,only: tempdir,magvol
      use nchist_module,only: nc_open,nc_close,handle_ncerr
      implicit none
!
! Netcdf header file:
#ifdef SUN
#include "netcdf3.inc"
#else
#include "netcdf.inc"
#endif
!
! Grid dimensions:
!
! Magnetic quantities read from magvol by sub nc_rdmag (called by rdmag)
! (see input_module for magvol file) (these were in old version fieldz.h)
!
      real,dimension(nlonp1,0:nlatp1) ::
     |  alatm,   ! geomagnetic latitude at each geographic grid point (radians)
     |  alonm,   ! geomagnetic longitude at each geographic grid point (radians)
     |  xb,      ! northward component of magnetic field
     |  yb,      ! eastward component of magnetic field
     |  zb,      ! downward component of magnetic field
     |  bmod,    ! magnitude of magnetic field (gauss?)
     |  dmlat,   ! dipole latitude corresponding to apex of field line
     |  rmag11,  ! (a1.a1)/p*sin(i)*cos(thetas)
     |  rmagc,   ! (a1.a2)/p*sin(i)
     |  rmag2,   ! 1./bmod
     |  rmag22,  ! (a2.a2)/p*sin(i)/cos(thetas)
     |  rjacd,   ! determinant of rjac
     |  p
!
! rjac: scaled derivatives of geomagnetic coords wrt geographic coordinates.
! rjac(1,1) = cos(thetas)/cos(theta)*d(lamdas)/d(lamda)
! rjac(1,2) = cos(thetas)*d(lamdas)/d(theta)
! rjac(2,1) = 1./cos(theta)*d(thetas)/d(lamda)
! rjac(2,2) = d(thetas)/d(theta)
! where (lamda,theta) are geographic coordinates
!       (lamdas,thetas) are geomagnetic coordinates
!
      real :: rjac(nlonp1,0:nlatp1,2,2) 
!
! av  = the two magnetic vectors a1 and a2
! av1 = a1
! av2 = a2/cos(thetas)
!
      real :: av  (nlonp1,0:nlatp1,3,2)
!
! Quantities needed to transform scalar fields between geographic and
! geomagnetic coordinate systems (these were in old version cterp.h)
!
      integer :: 
     |  ig(nmlonp1,nmlat),   ! geog lon grid containing each geomag point
     |  jg(nmlonp1,nmlat),   ! geog lat grid containing each geomag point
     |  im(nlonp1,0:nlatp1), ! geomag lon grid containing each geog point
     |  jm(nlonp1,0:nlatp1)  ! geomag lat grid containing each geog point
!
! wt(4) are interpolation weights to be applied to function values at 4 
!   corners of geographic grid element (ig,jg)
! dim and djm are fractions in i and j directions, used for bilinear 
!   interpolation in geomagnetic grid element.
!
      real ::
     |  wt(4,nmlonp1,nmlat),   
     |  dim(nlonp1,0:nlatp1),
     |  djm(nlonp1,0:nlatp1)
!
! Trigonometric factors needed in the calculation of the derivatives
! of the geomagnetic coordinates wrt the geographic coordinates
! (these were in old versions header file trig.h) 
!
      real,dimension(nlonp1,nlat) ::
     |  cslatm, ! cos(thetas)
     |  snlatm, ! sin(thetas)
     |  cslonm, ! cos(lamdas)
     |  snlonm  ! sin(lamdas)
!
! 10/17/02 bf: cslatg and snlatg dim changed from nlat to 0:nlatp1
!   for apxparm (apex.F).
      real ::
     |  cslatg(0:nlatp1), ! cos(theta)
     |  snlatg(0:nlatp1), ! sin(theta)
     |  cslong(nlonp1),   ! cos(lamda)
     |  snlong(nlonp1)    ! sin(lamda)
!
! Magnetic field at geographic grid. These are defined by magdyn after 
!   reading magdat file (formerly in common /MAGFLD/ and header file trgm.h)
! (note bx,by,bz,bmod2 are dimensioned nlonp4 rather than -1:nlonp2, as
!  in earlier versions, so these fields can be referenced at i rather than
!  i-2, e.g. in sub oplus)
!
      real,dimension(nlonp4,-1:nlatp2) :: bx,by,bz,bmod2
      real,dimension(nlonp4,nlat) ::
     |  rlatm,rlonm,dipmag,decmag,sndec,csdec,sn2dec,sncsdc
!
! sunlons: sun's longitude in dipole coordinates (see sub sunloc)
! (this was dlons in earlier versions)
!
      real :: sunlons(nlat)
!
      contains
!-----------------------------------------------------------------------
      subroutine magfield(dynamo)
!
! Read magnetic field data file:
!
      implicit none
!
! Args:
      integer,intent(in) :: dynamo
!
! Local:
      integer :: nwds,j,k,i,ii,ier
      character(len=80) :: dskfile
!
! Get and read magnetic data file.
! 2/00: using new netcdf mag file (see ~foster/tgcm/mkmag)
! 9/00: In new getms, if MPI, only master proc actually acquires mspath.
! For systems without ncar mss (MSS==0), MAGVOL given in user input file 
!   should be a local file name, e.g., MAGVOL='TGCM.data.magfield.nc'
!
#if (MSS == 0)
      dskfile = magvol
      call get_diskfile(dskfile,' ') 
#else
      call mkdiskflnm(magvol,dskfile)
      call getms(magvol,dskfile,tempdir,' ') 
#endif
!
! If dynamo==2, then new dynamo will be called. The new dynamo uses
! apxparm (apex.F), so nc_rdmag is not necessary in this case.
!
      if (dynamo /= 2) then
        call nc_rdmag(dskfile)
      else
        write(6,"('magfield: nc_rdmag not called because dynamo=',
     |    i2)") dynamo
      endif
!
      call magdyn
      if (dynamo > 0) call dynpotmag
!
! Initialize mpi communication requirements for geo to mag 
! transformation:
      call init_geo2mag
      end subroutine magfield
!-------------------------------------------------------------------
      subroutine nc_rdmag(dskfile)
! 
! Read netcdf magnetic data file.
! The mss data file (magvol) is set from input according to current
!   horizontal resolution. Currently (1/02) there are 2 such files:
!   /TGCM/data/magdat.nc for 5.0 degree resolution, and
!   /TGCM/data/magdat_2.5h.nc for 2.5 degree resolution.
! These files are generated by code in hao /home/tgcm/mkmag, using
!   the apex parm code (s.a. Roy Barnes).
!
! The "original" cray-blocked file for 5 degrees was
!   /ECRIDLEY/ECR90/ECRMG6 (s.a. code in ~foster/tgcm/mkmag)
! 
      implicit none
! Args:
      character(len=*),intent(in) :: dskfile
!
! Local:
      integer :: istat,ncid,j
      integer :: ids1(1),ids2(2),ids3(3),ids4(4)
      integer :: id_nlat,id_nlonp1,id_nlatp2,id_dim2,id_dim3,
     |  id_nmlonp1,id_nmlat,id_dim4
      integer :: idv_alatm,idv_alonm,idv_xb,idv_yb,idv_zb,idv_bmod,
     |  idv_dmlat,idv_rjac,idv_av,idv_p,idv_rmag11,idv_rmagc,idv_rmag2,
     |  idv_rmag22,idv_rjacd,idv_im,idv_jm
      integer :: idv_ig,idv_jg,idv_wt,idv_dim,idv_djm
      integer :: idv_cslatm,idv_snlatm,idv_cslonm,idv_snlonm,idv_cslatg,
     |  idv_snlatg,idv_cslong,idv_snlong
      integer :: start_1d(1),count_1d(1),start_2d(2),count_2d(2),
     |  start_3d(3),count_3d(3),start_4d(4),count_4d(4)
      character(len=8) :: dimname
      real :: fmin,fmax
!
      write(6,"(/,72('-'))") 
      write(6,"('nc_rdmag: Read magnetic field data file ',a,
     |  /,10x,' (mss file ',a,')')") trim(dskfile),trim(magvol)
!
! Open the netcdf dataset:
      call nc_open(ncid,dskfile,'OLD','READ')
      if (ncid <= 0) then
        write(6,"(/,'>>> nc_rdmag: error opening netcdf mag data ',
     |    'file ',a)") trim(dskfile)
        stop 'nc_rdmag'
!     else
!       write(6,"('nc_rdmag: opened netcdf mag data file ',a,
!    |    ' ncid=',i8)") trim(dskfile),ncid
      endif 
!
! Check dimensions:
      call checkdim(ncid,"nlat"   ,nlat)
      call checkdim(ncid,"nlonp1" ,nlonp1)
      call checkdim(ncid,"nlatp2" ,nlatp1+1)
!     call checkdim(ncid,"nmlonp1",nmlonp1)
      call checkdim(ncid,"nmlon"  ,nmlonp1)
      call checkdim(ncid,"nmlat"  ,nmlat)
!
! Read variables for fieldz.h:
! 2-d doubles (nlonp1,0:nlatp1):
      start_2d(:) = 1
      count_2d(1) = nlonp1
      count_2d(2) = nlatp2
      call rd2dfld(ncid,'ALATM ',idv_alatm ,start_2d,count_2d,alatm )
      call rd2dfld(ncid,'ALONM ',idv_alonm ,start_2d,count_2d,alonm )
      call rd2dfld(ncid,'XB    ',idv_xb    ,start_2d,count_2d,xb    )
      call rd2dfld(ncid,'YB    ',idv_yb    ,start_2d,count_2d,yb    )
      call rd2dfld(ncid,'ZB    ',idv_zb    ,start_2d,count_2d,zb    )
      call rd2dfld(ncid,'BMOD  ',idv_bmod  ,start_2d,count_2d,bmod  )
      call rd2dfld(ncid,'DMLAT ',idv_dmlat ,start_2d,count_2d,dmlat )
      call rd2dfld(ncid,'P     ',idv_p     ,start_2d,count_2d,p     )
      call rd2dfld(ncid,'RMAG11',idv_rmag11,start_2d,count_2d,rmag11)
      call rd2dfld(ncid,'RMAGC ',idv_rmagc ,start_2d,count_2d,rmagc )
      call rd2dfld(ncid,'RMAG2 ',idv_rmag2 ,start_2d,count_2d,rmag2 )
      call rd2dfld(ncid,'RMAG22',idv_rmag22,start_2d,count_2d,rmag22)
      call rd2dfld(ncid,'RJACD ',idv_rjacd ,start_2d,count_2d,rjacd )
!
! RJAC(nlonp1,0:nlatp1,2,2):
      start_4d(:) = 1
      count_4d(1) = nlonp1
      count_4d(2) = nlatp2
      count_4d(3:4) = 2
      istat = nf_inq_varid(ncid,'RJAC',idv_rjac)
      istat = nf_get_vara_double(ncid,idv_rjac,start_4d,count_4d,rjac)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_double for rjac')
      call fminmax(rjac,nlonp1*nlatp2*2*2,fmin,fmax)
      write(6,"('  RJAC  min,max=',2e12.4)") fmin,fmax
!
! AV(nlonp1,0:nlatp1,3,2):
      start_4d(:) = 1
      count_4d(1) = nlonp1
      count_4d(2) = nlatp2
      count_4d(3) = 3
      count_4d(4) = 2
      istat = nf_inq_varid(ncid,'AV',idv_av)
      istat = nf_get_vara_double(ncid,idv_av,start_4d,count_4d,av)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_double for av')
      call fminmax(av,nlonp1*nlatp2*3*2,fmin,fmax)
      write(6,"('  AV    min,max=',2e12.4)") fmin,fmax
!
! Read variables to module data:
!
! IG(nmlonp1,nmlat)
      start_2d(:) = 1
      count_2d(1) = nmlonp1
      count_2d(2) = nmlat
      istat = nf_inq_varid(ncid,'IG',idv_ig)
      istat = nf_get_vara_int(ncid,idv_ig,start_2d,count_2d,ig)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_int for ig')
!
! JG(nmlonp1,nmlat)
      count_2d(1) = nmlonp1
      count_2d(2) = nmlat
      istat = nf_inq_varid(ncid,'JG',idv_jg)
      istat = nf_get_vara_int(ncid,idv_jg,start_2d,count_2d,jg)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_int for jg')
!
! IM(nlonp1,0:nlatp1):
      count_2d(1) = nlonp1
      count_2d(2) = nlatp2
      istat = nf_inq_varid(ncid,'IM',idv_im)
      istat = nf_get_vara_int(ncid,idv_im,start_2d,count_2d,im)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_int for im')
!
! JM(nlonp1,0:nlatp1):
      istat = nf_inq_varid(ncid,'JM',idv_jm)
      istat = nf_get_vara_int(ncid,idv_jm,start_2d,count_2d,jm)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_int for jm')
!
! WT(4,nmlonp1,nmlat):
      start_3d(:) = 1
      count_3d(1) = 4
      count_3d(2) = nmlonp1
      count_3d(3) = nmlat
      istat = nf_inq_varid(ncid,'WT',idv_wt)
      istat = nf_get_vara_double(ncid,idv_wt,start_3d,count_3d,wt)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_double for wt')
      call fminmax(wt,4*nmlonp1*nmlat,fmin,fmax)
      write(6,"('  WT    min,max=',2e12.4)") fmin,fmax
!
! DIM and DJM(nlonp1,0:nlatp1):
      start_2d(:) = 1
      count_2d(1) = nlonp1
      count_2d(2) = nlatp2
      call rd2dfld(ncid,'DIM   ',idv_dim ,start_2d,count_2d,dim )
      call rd2dfld(ncid,'DJM   ',idv_djm ,start_2d,count_2d,djm )
!
! cslatm, snlatm, cslonm, snlonm:
      start_2d(:) = 1
      count_2d(1) = nlonp1
      count_2d(2) = nlat
      call rd2dfld(ncid,'CSLATM ',idv_cslatm ,start_2d,count_2d,cslatm)
      call rd2dfld(ncid,'SNLATM ',idv_snlatm ,start_2d,count_2d,snlatm)
      call rd2dfld(ncid,'CSLONM ',idv_cslonm ,start_2d,count_2d,cslonm)
      call rd2dfld(ncid,'SNLONM ',idv_snlonm ,start_2d,count_2d,snlonm)
!
! CSLATG(nlat):
      start_1d(:) = 1
      count_1d(1) = nlat
      istat = nf_inq_varid(ncid,'CSLATG',idv_cslatg)
      istat = nf_get_vara_double(ncid,idv_cslatg,start_1d,count_1d,
     |  cslatg)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_double for cslatg')
      call fminmax(cslatg,nlat,fmin,fmax)
      write(6,"('  CSLATG  min,max=',2e12.4)") fmin,fmax
!
! SNLATG(nlat):
      istat = nf_inq_varid(ncid,'SNLATG',idv_snlatg)
      istat = nf_get_vara_double(ncid,idv_snlatg,start_1d,count_1d,
     |  snlatg)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_double for snlatg')
      call fminmax(snlatg,nlat,fmin,fmax)
      write(6,"('  SNLATG  min,max=',2e12.4)") fmin,fmax
!
! CSLONG(nlonp1):
      count_1d(1) = nlonp1
      istat = nf_inq_varid(ncid,'CSLONG',idv_cslong)
      istat = nf_get_vara_double(ncid,idv_cslong,start_1d,count_1d,
     |  cslong)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_double for cslong')
      call fminmax(cslong,nlonp1,fmin,fmax)
      write(6,"('  CSLONG  min,max=',2e12.4)") fmin,fmax
!
! SNLONG(nlonp1):
      istat = nf_inq_varid(ncid,'SNLONG',idv_snlong)
      istat = nf_get_vara_double(ncid,idv_cslong,start_1d,count_1d,
     |  snlong)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |    'Error return from nf_get_vara_double for snlong')
      call fminmax(snlong,nlonp1,fmin,fmax)
      write(6,"('  SNLONG  min,max=',2e12.4)") fmin,fmax
!
! Close the dataset:
      call nc_close(ncid)
      write(6,"('Completed read of magnetic field data file.')")
      write(6,"(72('-'),/)")
      end subroutine nc_rdmag
!-------------------------------------------------------------------
      subroutine checkdim(ncid,dimname,iparam)
!
! Get length of dimension "dimname". If this length is not equal
! to iparam, stop with error message.
!
      implicit none
!
! Args:
      integer,intent(in) :: ncid,iparam
      character(len=*),intent(in) :: dimname
!
! Local:
      integer :: istat,iddim,len
      character(len=80) :: char80
!
! Get dim id:
      istat = nf_inq_dimid(ncid,dimname,iddim)
      if (istat /= NF_NOERR) then
        write(char80,"('nc_rdmag: error getting dim id for ',
     |    a)") dimname
        call handle_ncerr(istat,char80)
      endif
!
! Get dim length:
      istat = nf_inq_dimlen(ncid,iddim,len)
      if (istat /= NF_NOERR) then
        write(char80,"('nc_rdmag: error getting length of ',
     |    'dimension ',a)") dimname
        call handle_ncerr(istat,char80)
      endif
!
! Compare with iparam:
      if (len /= iparam) then
        write(6,"(/,'>>> nc_rdmag: unexpected length for ',
     |    'dimension ',a)") dimname
        write(6,"('  length read = ',i3,' should be = ',i3)") 
     |    len,iparam
        stop 'nc_rdmag'
      endif
      end subroutine checkdim
!-------------------------------------------------------------------
      subroutine rd2dfld(ncid,name,idvout,start_2d,count_2d,var)
      implicit none
!
! Read 2-d double array from ncid to var:
!
! Args:
      integer,intent(in) :: ncid,start_2d(2),count_2d(2)
      character(len=*),intent(in) :: name
      integer,intent(out) :: idvout
      real,intent(out) :: var(count_2d(1),count_2d(2))
!
! Local:
      integer :: istat
      character(len=80) :: char80
      real :: fmin,fmax
!
      istat = nf_inq_varid(ncid,name,idvout)
      istat = nf_get_vara_double(ncid,idvout,start_2d,count_2d,var)
      write(char80,"('Error return from nf_get_vara_double for var',
     |  a)") name
      if (istat /= NF_NOERR) call handle_ncerr(istat,char80)
!     call fminmax(var,count_2d(1)*count_2d(2),fmin,fmax)
!     write(6,"('rd2dfld: ',a,' fmin,max=',2e12.4)") name,fmin,fmax
      end subroutine rd2dfld
!-----------------------------------------------------------------------
      subroutine magdyn
!
! Local:
      real,parameter :: sin10=0.17   ! should be equal to dipmin
      real :: cos10
!
! Field are calculated in local arrays dimensioned -1:nlonp2, then transferred 
!   to module data bx,by,bz,bmod2 at 1:nlonp4 for use in the model.
!
      real,dimension(-1:nlonp2,-1:nlatp2) :: bxtmp,bytmp,bztmp,bmod2tmp
      integer :: i,j
!
      cos10 = sqrt(1.-sin10**2)
      do j = 1,nlat
        do i = 1,nlon
          rlatm(i+2,j) = alatm(i,j)
          rlonm(i+2,j) = alonm(i,j)
          dipmag(i+2,j) = atan(zb(i,j)/sqrt(xb(i,j)**2+yb(i,j)**2))
          decmag(i+2,j) = -atan2(yb(i,j),xb(i,j))
          sndec(i+2,j) = sin(decmag(i+2,j))
          csdec(i+2,j) = cos(decmag(i+2,j))
          sn2dec(i+2,j) = sndec(i+2,j)**2
          sncsdc(i+2,j) = sndec(i+2,j)*csdec(i+2,j)
          bxtmp(i,j) = yb(i,j)/bmod(i,j)
          bytmp(i,j) = xb(i,j)/bmod(i,j)
          bztmp(i,j) = -zb(i,j)/bmod(i,j)
          bmod2tmp(i,j) = bmod(i,j)
!
! Set minimum dip to 10 degrees
          if (abs(bztmp(i,j))-sin10 < 0.) then
            bxtmp(i,j)=bxtmp(i,j)*(cos10/sqrt(1.-bztmp(i,j)**2))
            bytmp(i,j)=bytmp(i,j)*(cos10/sqrt(1.-bztmp(i,j)**2))
            bztmp(i,j)=sign(sin10,bztmp(i,j))
          endif
        enddo
      enddo
!
! Values at j = -1, 0, nlatp1, nlatp2:
      do j = 1,2
        do i = 1,nlon
          bxtmp(i,j-2) = -bxtmp(1+mod(i-1+nlon/2,nlon),3-j)
          bytmp(i,j-2) = -bytmp(1+mod(i-1+nlon/2,nlon),3-j)
          bztmp(i,j-2) =  bztmp(1+mod(i-1+nlon/2,nlon),3-j)
          bmod2tmp(i,j-2) = bmod2tmp(1+mod(i-1+nlon/2,nlon),3-j)
          bxtmp(i,nlat+j) = -bxtmp(1+mod(i-1+nlon/2,nlon),nlat+1-j)
          bytmp(i,nlat+j) = -bytmp(1+mod(i-1+nlon/2,nlon),nlat+1-j)
          bztmp(i,nlat+j) =  bztmp(1+mod(i-1+nlon/2,nlon),nlat+1-j)
          bmod2tmp(i,nlat+j) = bmod2tmp(1+mod(i-1+nlon/2,nlon),nlat+1-j)
        enddo
      enddo
!
! Periodic points:
      do i = 1,2
        do j = 1,nlat
          rlatm (i,j) = rlatm (i+nlon,j)
          rlonm (i,j) = rlonm (i+nlon,j)
          dipmag(i,j) = dipmag(i+nlon,j)
          decmag(i,j) = decmag(i+nlon,j)
          sndec (i,j) = sndec (i+nlon,j)
          csdec (i,j) = csdec (i+nlon,j)
          sn2dec(i,j) = sn2dec(i+nlon,j)
          sncsdc(i,j) = sncsdc(i+nlon,j)
!
          rlatm (i+nlonp2,j) = rlatm (i+2,j)
          rlonm (i+nlonp2,j) = rlonm (i+2,j)
          dipmag(i+nlonp2,j) = dipmag(i+2,j)
          decmag(i+nlonp2,j) = decmag(i+2,j)
          sndec (i+nlonp2,j) = sndec (i+2,j)
          csdec (i+nlonp2,j) = csdec (i+2,j)
          sn2dec(i+nlonp2,j) = sn2dec(i+2,j)
          sncsdc(i+nlonp2,j) = sncsdc(i+2,j)
        enddo
      enddo
      do i = 1,2
        do j = -1,nlatp2
          bxtmp(i-2,j) = bxtmp(i-2+nlon,j)
          bytmp(i-2,j) = bytmp(i-2+nlon,j)
          bztmp(i-2,j) = bztmp(i-2+nlon,j)
          bmod2tmp(i-2,j) = bmod2tmp(i-2+nlon,j)

          bxtmp(i+nlon,j) = bxtmp(i,j)
          bytmp(i+nlon,j) = bytmp(i,j)
          bztmp(i+nlon,j) = bztmp(i,j)
          bmod2tmp(i+nlon,j) = bmod2tmp(i,j)
        enddo
      enddo
!
! Save local fields -1:nlonp2 to module data at 1:nlonp4.
! This way, model routines (e.g., oplus) can reference i rather than i-2.
      do i=1,nlonp4
        bx(i,:) = bxtmp(i-2,:)
        by(i,:) = bytmp(i-2,:)
        bz(i,:) = bztmp(i-2,:)
        bmod2(i,:) = bmod2tmp(i-2,:)
      enddo ! i=1,nlonp4

!     do j=-1,nlatp2
!       write(6,"('magdyn: j=',i2)") j
!       write(6,"('bx(:,j)=',/,(6e12.4))") bx(:,j)
!       write(6,"('by(:,j)=',/,(6e12.4))") by(:,j)
!       write(6,"('bz(:,j)=',/,(6e12.4))") bz(:,j)
!     enddo ! j=-1,nlatp2

      end subroutine magdyn
!-----------------------------------------------------------------------
      subroutine dynpotmag
      use fields_module,only: dynpot,phim3d
      use mpi_module,only: mytid
!
! Transform electric potential to geomagnetic grid. 
!
! Electric potential dynpot on geographic grid was defined from source
!   history (see sub rdf4d in nchist.F) before the first step, then by 
!   dynamo module if input flat dynamo=1. Dynpot is dimensioned in 
!   fields_module (fields.F).
!
! Local:
      integer :: k,j,i
      real :: fmin,fmax
!
!     do j=1,nlat
!       do k=1,nlevp1
!         write(6,"('dynpotmag: j=',i2,' k=',i2,' dynpot(:,j,k)=',/,
!    |      (6e12.4))") j,k,dynpot(:,j,k)
!       enddo
!     enddo
!
! Sub geo2mag input dynpot is transformed to magnetic grid in phim3d output.
!     subroutine geo2mag(fmag,fgeo,long,latg,wght,nlonp1_geo,nlonp1_mag,
!    |  nlon_mag,nlat_mag,lat)
!
!     do k=1,nlevp1
!       do j=1,nmlat
!         call geo2mag(phim3d(1,j,k),dynpot(1,0,k),ig,jg,wt,nlonp1,
!    |      nmlonp1,nmlon,nmlat,j)
!       enddo ! j=1,nmlat
!     enddo ! k=1,nlevp1
!
! Fields.F:
!   dynpot(nlonp1,0:nlatp1,nlevp1),  ! 3d electric potential geographic
!   phim3d(nmlonp1,nmlat,-2:nlevp1), ! 3d electric potential magnetic
! Magfield.F:
!   ig(nmlonp1,nmlat),   ! geog lon index for each geomag point
!   jg(nmlonp1,nmlat),   ! geog lat index for each geomag point
! The "-1" in the j dimension of dynpot is because the dimension is
!   0:nlatp1. Previously, when grdint or geo2mag was called for this
!   transformation, dynpot(1,0,k) was passed as actual arg, and the 
!   dummy arg in the sub was fgeo(nlonp1_geo,*).
!
      do k=1,nlevp1
        do j=1,nmlat
          do i=1,nmlon
            phim3d(i,j,k) =
     |        dynpot(ig(i,j)  ,jg(i,j)  -1,k)*wt(1,i,j)+
     |        dynpot(ig(i,j)+1,jg(i,j)  -1,k)*wt(2,i,j)+
     |        dynpot(ig(i,j)+1,jg(i,j)+1-1,k)*wt(3,i,j)+
     |        dynpot(ig(i,j)  ,jg(i,j)+1-1,k)*wt(4,i,j)
          enddo ! i=1,nmlon
          phim3d(nmlonp1,j,k) = phim3d(1,j,k)
        enddo ! j=1,nmlat
      enddo ! k=1,nlevp1
!
! Periodic point:
!     do k=1,nlevp1
!       do j=1,nmlat
!         phim3d(nmlonp1,j,k) = phim3d(1,j,k)
!       enddo ! j=1,nmlat
!     enddo ! k=1,nlevp1
!
! Save to secondary history from root task:
! addfsech will not work because this routine is called once per run,
!   so write to stdout.
!
!     if (mytid==0) then
!       do j=0,nlatp1
!         call addfsech_ik('DYNPOT_0',' ',' ',dynpot(:,j,:),
!    |      1,nlonp1,nlevp1,nlevp1-1,j)
!
!  dynpot(nlonp1,0:nlatp1,nlevp1),  ! 3d electric potential geographic
!         call fminmax(dynpot(:,j,:),nlonp1*nlevp1,fmin,fmax)
!         write(6,"('dynpotmag: j=',i3,' dynpot min,max=',2e12.4)")
!    |      j,fmin,fmax 
!       enddo ! j=1,nlat
!       do j=1,nmlat
!         call addfsech_ik('PHIM3D_0',' ',' ',phim3d(:,j,:),
!    |      1,nmlonp1,nmlev,nmlev-1,j)
!
!    |  phim3d(nmlonp1,nmlat,-2:nlevp1)  ! 3d electric potential magnetic
!         call fminmax(phim3d(:,j,:),nmlonp1*nmlev,fmin,fmax)
!         write(6,"('dynpotmag: j=',i3,' phim3d min,max=',2e12.4)")
!    |      j,fmin,fmax 
!       enddo ! j=1,nmlat
!     endif
      end subroutine dynpotmag
!-----------------------------------------------------------------------
      subroutine sunloc(iday,secs)
      use cons_module,only: pi,dlamda,dphi
!
! Calculate sun's longitude in dipole coordinates, defining sunlons(nlat)
! (sunlons is module data above). This is called every timestep from advance.
!
! Args:
      integer,intent(in) :: iday ! day of year
      real,intent(in) :: secs    ! ut in seconds
!
! Local:
      integer :: j,isun,jsun
      real :: glats,glons,pisun,pjsun,sndlons,csdlons
!
! Sun's geographic coordinates:
      glats=asin(.398749*sin(2.*PI*(iday-80)/365.))
      glons=pi*(1.-2.*secs/86400.)
!
      pisun = (glons+pi)/dlamda+1.
      pjsun = (glats+.5*(pi-dphi))/dphi+1.
      isun = int(pisun)
      jsun = int(pjsun)
      pisun = pisun-float(isun)
      pjsun = pjsun-float(jsun)
      sndlons = (1.-pisun)*(1.-pjsun)*sin(rlonm(isun+2,jsun))+
     |           pisun*(1.-pjsun)*sin(rlonm(isun+3,jsun))+
     |           pisun*pjsun*sin(rlonm(isun+3,jsun+1))+
     |           (1.-pisun)*pjsun*sin(rlonm(isun+2,jsun+1))
      csdlons = (1.-pisun)*(1.-pjsun)*cos(rlonm(isun+2,jsun))+
     |           pisun*(1.-pjsun)*cos(rlonm(isun+3,jsun))+
     |           pisun*pjsun*cos(rlonm(isun+3,jsun+1))+
     |           (1.-pisun)*pjsun*cos(rlonm(isun+2,jsun+1))
      sunlons(1) = atan2(sndlons,csdlons)
      do j = 2,nlat
        sunlons(j) = sunlons(1)
      enddo
!     write(6,"('sunloc: sunlons=',/,(6e12.4))") sunlons
      end subroutine sunloc
!-----------------------------------------------------------------------
      subroutine init_geo2mag
!
! Determine points to be passed between tasks for parallel geo to mag 
! transformation.
!
! Module data from mpi.F:
!     integer,allocatable,dimension(:,:,:) :: ! (mlon0->1,mlat0->1,4)
!    |  igeo,  ! geo lon indices at 4 pts boxing each mag pt in my subdomain
!    |  jgeo,  ! geo lat indices at 4 pts boxing each mag pt in my subdomain
!    |  idgeo  ! tid of mpi task with each of the 4 pts (owner)
!     integer,allocatable :: nrcvgeo(:) ! # geo pts to be recvd from each task
!     integer,allocatable :: nsndgeo(:) ! # geo pts to be sent to each ntask
!     integer,allocatable,dimension(:,:) :: ! (mxrcv[mxsnd],ntask) 
!    |  ircvgeo, ! lon indices to be received from each task
!    |  jrcvgeo, ! lat indices to be received from each task
!    |  isndgeo, ! lon indices to be sent from each task
!    |  jsndgeo  ! lat indices to be sent from each task
!
      use mpi_module,only: ntask,mlon0,mlon1,mlat0,mlat1,mymlons,
     |  mymlats,igeo,jgeo,idgeo,ircvgeo,jrcvgeo,isndgeo,jsndgeo,
     |  nsndgeo,nrcvgeo,tasks,ntaskj,mytid
!     use magfield_module,only: ig, jg
      use init_module,only: glat,glon,gmlat,gmlon
!
! Local:
      integer :: im,jm,i,j,n,nmlats,nmlons,istat
      integer :: mxsndgeo,mxrcvgeo
!     logical,dimension(nlonp4,nlat) :: counted
      logical,allocatable,dimension(:,:,:) :: 
     |  counted ! (nlonp4,nlat,ntask)
!
! Set magnetic grid in degrees:
!
! Allocate arrays (module data from mpi.F):
      allocate(igeo(mlon0:mlon1,mlat0:mlat1,4),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' igeo: stat=',i3)") istat
      allocate(jgeo(mlon0:mlon1,mlat0:mlat1,4),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' jgeo: stat=',i3)") istat
      allocate(idgeo(mlon0:mlon1,mlat0:mlat1,4),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' idgeo: stat=',i3)") istat
      allocate(nrcvgeo(0:ntask-1),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' nrcvgeo: stat=',i3)") istat
      allocate(nsndgeo(0:ntask-1),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' nsndgeo: stat=',i3)") istat
!
! Assign igeo and jgeo from ig,jg (which were read by magfield):
! Numbering convention for the 4 geo pts surrounding a single mag pt
!   is 1 to 4, counterclockwise starting with 1 in lower left. 
!
      do jm=mlat0,mlat1
        do im=mlon0,mlon1
          igeo(im,jm,1) = ig(im,jm)  
          igeo(im,jm,2) = ig(im,jm)+1
          igeo(im,jm,3) = ig(im,jm)+1
          igeo(im,jm,4) = ig(im,jm)
!
          jgeo(im,jm,1) = jg(im,jm)  
          jgeo(im,jm,2) = jg(im,jm)
          jgeo(im,jm,3) = jg(im,jm)+1
          jgeo(im,jm,4) = jg(im,jm)+1
        enddo ! im=mlon0,mlon1
      enddo ! jm=mlat0,mlat1
!
      nmlats = mlat1-mlat0+1
      nmlons = mlon1-mlon0+1
!
! Determine owners (tasks) of each mag grid pt in my subdomain:
      idgeo(:,:,:) = -1
      do jm=mlat0,mlat1
        do im=mlon0,mlon1
          do i=1,4
            do n=0,ntask-1
              if (any(tasks(n)%mylons==igeo(im,jm,i)).and.
     |            any(tasks(n)%mylats==jgeo(im,jm,i))) then
                idgeo(im,jm,i) = n ! this needed pt is owned by task n
              elseif (any(tasks(n)%mylons==igeo(im,jm,i)).and.
     |          jgeo(im,jm,i) > nlat .and.
     |          tasks(n)%mytidj==ntaskj-1) then ! northernmost tasks
                idgeo(im,jm,i) = n ! owner of nlat+1,nlat+2
              endif
            enddo ! n=0,ntask-1
            if (idgeo(im,jm,i)==-1) then
              write(6,"('>>> init_geo2mag note: no owner: ',
     |          ' jm=',i3,' im=',i3,' i=',i3,' igeo=',i3,' jgeo=',i3)")
     |          jm,im,i,igeo(im,jm,i),jgeo(im,jm,i)
              stop 'init_geo2mag'
            endif
          enddo ! i=1,4
        enddo ! im=mlon0,mlon1
      enddo ! jm=mlat0,mlat1
      if (any(idgeo==-1)) then
        write(6,"('>>> WARNING init_geo2mag: some idgeo == -1')")
        stop 'idgeo'
      endif
!
! Determine how many points I must receive from each task, for
!   allocation purposes below.
! Use logical counted to remove redundancy -- only need to send/recv 
!   each point once.
!
      allocate(counted(nlonp4,nlat,0:ntask-1),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' counted: stat=',i3)") istat
      counted(:,:,:) = .false. ! (nlonp4,nlat,ntask)
      nrcvgeo(:) = 0
      nsndgeo(:) = 0
      do jm=mlat0,mlat1
        do im=mlon0,mlon1
          do i=1,4
            n = idgeo(im,jm,i)
            if (.not.counted(ig(im,jm),jg(im,jm),n)) then
              nrcvgeo(n) = nrcvgeo(n)+1
              if (n==mytid) nsndgeo(mytid) = nsndgeo(mytid)+1
              counted(ig(im,jm),jg(im,jm),n) = .true.
            endif
          enddo ! i=1,4
        enddo ! im=mlon0,mlon1
      enddo ! jm=mlat0,mlat1
      do n=0,ntask-1
        write(6,"('init_geo2mag: n=',i3,' nrcvgeo=',i4,' nsndgeo=',i4)")
     |    n,nrcvgeo(n),nsndgeo(n)
      enddo
!
! Allocate ircvgeo,jrcvgeo:
      mxrcvgeo = 0
      do n=0,ntask-1
        if (nrcvgeo(n) > mxrcvgeo) mxrcvgeo = nrcvgeo(n)
        if (nsndgeo(n) > mxsndgeo) mxsndgeo = nsndgeo(n)
      enddo
      allocate(ircvgeo(mxrcvgeo,0:ntask-1),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' ircvgeo: stat=',i3)") istat
      allocate(jrcvgeo(mxrcvgeo,0:ntask-1),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' jrcvgeo: stat=',i3)") istat
      allocate(isndgeo(mxsndgeo,0:ntask-1),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' isndgeo: stat=',i3)") istat
      allocate(jsndgeo(mxsndgeo,0:ntask-1),stat=istat)
      if (istat /= 0) write(6,"('>>> init_geo2mag: error allocating',
     |  ' jsndgeo: stat=',i3)") istat
!
! Determine lon,lat indices to be passed by each task.
! (recalc nrcvgeo, nsndgeo)
      counted(:,:,:) = .false. ! (nlonp4,nlat,ntask)
      nrcvgeo(:) = 0
      nsndgeo(:) = 0

!     write(6,"('needed fm',2x,'nrcvgeo',2x,'  mag lon',2x,
!    |  '  mag lat',2x,'  geo lon',2x,'  geo lat')") 

! 11/21/02: Hard to prove that this is really working..
      do jm=mlat0,mlat1
        do im=mlon0,mlon1
          do i=1,4
            n = idgeo(im,jm,i)
            if (.not.counted(ig(im,jm),jg(im,jm),n)) then
              nrcvgeo(n) = nrcvgeo(n)+1
              ircvgeo(nrcvgeo(n),n) = igeo(im,jm,i)
              jrcvgeo(nrcvgeo(n),n) = jgeo(im,jm,i)
              if (n==mytid) then
                nsndgeo(mytid) = nsndgeo(mytid)+1
                isndgeo(nsndgeo(n),n) = igeo(im,jm,i)
                jsndgeo(nsndgeo(n),n) = jgeo(im,jm,i)
              endif
              counted(ig(im,jm),jg(im,jm),n) = .true.

!             write(6,"(i9,2x,i7,2x,f9.2,2x,f9.2,2x,f9.2,2x,
!    |          f9.2)") n,nrcvgeo(n),glon(ircvgeo(nrcvgeo(n),n)),
!    |          glat(ircvgeo(nrcvgeo(n),n)),gmlon(im),gmlat(jm)

            endif
          enddo ! i=1,4
        enddo ! im=mlon0,mlon1
      enddo ! jm=mlat0,mlat1
      deallocate(counted)
!
      end subroutine init_geo2mag
!-----------------------------------------------------------------------
      end module magfield_module