!**********************************************************************
SUBROUTINE dipmag_express(freq, ntrn, xl_trn, nrec, xl_rec, &
  nmed, r_ot, r_on, e_ot, e_on, z_m,           &
  nstep, prfazx, prfaxy, prfz, tm,             &
  hxx, hyy, hzz, hxy, hyx, hxz, hzx, hyz, hzy, &
  ierr, iac)
	!DEC$ IF DEFINED (_DLL)
	!DEC$ ATTRIBUTES DLLEXPORT :: DIPMAG_EXPRESS
	!DEC$ END IF

!**********************************************************************
! This is a wrapper for the new universal DIPMAG. This wrapper disables
! all the Jacobian calculations.
!
! Other changes:
! FREQ is in Hz
! Instead of passing in a complex resitivity we pass in resistivity
! and dielectric constants separately, so:
!    R_OT is real
!    R_ON is real
!    E_OT is added
!    E_ON is added
!**********************************************************************
!  LANGUAGE: FORTRAN 77 EXTENDED FOR SUN (SPARCOMPILER FORTRAN)
!  PURPOSE:  SIGNAL OF ANY complex*16 (MULTITRANSMITTER, MULTICOIL, MULTIFREQUENCY)
!            INDIUCTION LOGGING TOOL.
!            HORIZONTALLY LAYERED ANISOTROPIC MEDIUM
!            IN MEDIIUM and TOOL COORDINATE SYSTEMS
!
!  ARGUMENTS  TYPE     IN-OUT     DESCRIPTION
!  FREQ       real*8   INPUT      FREQUENCY
!  NTRN       INT      INPUT      NUMBER OF TRANSMITTERS
!  XL_TRN     real*8   INPUT      POSITIONS OF TRANSMITTER (M)
!  NREC       INT      INPUT      NUMBER OF 2-COIL PROBES
!  XL_REC     real*8   INPUT      P0SITIONS OF 2-COIL PROBES (M)
!  NMED       INT      INPUT      NUMBER OF BOUNDARIES
!  R_OT       real*8   INPUT      HORIZONTAL RESISTIVITIS (OHM*M)
!  R_ON       real*8   INPUT      VERTICAL RESISTIVITIS  (OHM*M)
!  E_OT       real*8   INPUT      HORIZONTAL DIELECTRIC CONSTANT (no units)
!  E_ON       real*8   INPUT      VERTICAL DIELECTRIC CONSTANT   (no units)
!  Z_M        real*8   INPUT      DEPTH OF BOUNDARIES  (M)
!  NSTEP      INT      INPUT      NUMBER OF POINT ALONG PROFILE
!  PRFZX      real*8      INPUT      ARRAY OF DIP ANGLES ALONG PROFILE (DEG)
!  PRFXY      real*8      INPUT      ARRAY OF ROTATION ANGLES ALONG PROFILE (DEG)
!  PRF        real*8      INPUT      DEPTHS ALONG PROFILE (M)
!  HXX       complex*16   OUTPUT     XX-MAGNETIC COMPONENT     
!  HYY       complex*16   OUTPUT     YY-MAGNETIC COMPONENT     
!  HZZ       complex*16   OUTPUT     ZZ-MAGNETIC COMPONENT     
!  HXY       complex*16   OUTPUT     XY-MAGNETIC COMPONENT     
!  HYX       complex*16   OUTPUT     YX-MAGNETIC COMPONENT
!  HXZ       complex*16   OUTPUT     XZ-MAGNETIC COMPONENT
!  HZX       complex*16   OUTPUT     ZX-MAGNETIC COMPONENT
!  HYZ       complex*16   OUTPUT     YZ-MAGNETIC COMPONENT
!  HZY       complex*16   OUTPUT     ZY-MAGNETIC COMPONENT
!  tm        character*2  input      'tl' -in tool or 'md' -in medium coo.
!  iac       integer      input  accuracy (0-regular, 1,2,3,4,5-improve, 
!                                          10,11,12,13,14,15-special)  
!                                            
!  ROUTINES USED: DIPMAG
!
!**********************************************************************
IMPLICIT NONE

! Arguments
INTEGER ntrn, nrec, nmed, nstep, ierr, iac
REAL*8 freq
REAL*8 xl_trn(ntrn), xl_rec(nrec)
REAL*8 prfz(nstep), prfazx(nstep), prfaxy(nstep)
REAL*8 z_m(nmed)
REAL*8 r_ot(0:nmed), r_on(0:nmed)
REAL*8 e_ot(0:nmed), e_on(0:nmed)
COMPLEX*16 hxx(nstep*nrec*ntrn), hxy(nstep*nrec*ntrn), hxz(nstep*nrec*ntrn)
COMPLEX*16 hyx(nstep*nrec*ntrn), hyy(nstep*nrec*ntrn), hyz(nstep*nrec*ntrn)
COMPLEX*16 hzx(nstep*nrec*ntrn), hzy(nstep*nrec*ntrn), hzz(nstep*nrec*ntrn)
CHARACTER*2 tm

! Local variables
INTEGER j
REAL*8 frq, pi, e0, const
COMPLEX*16 s_ot, s_on
COMPLEX*16, ALLOCATABLE :: rc_ot(:), rc_on(:)         ! Complex resistivity

! Jacobian related variables, we are not using them so
! no memory is allocated.
INTEGER idt, idn, idz, itf, inf, izf
INTEGER, ALLOCATABLE :: idrt(:), idrn(:), idzi(:)
COMPLEX*16 dtxx(0,0),dnxx(0,0),dzxx(0,0)
COMPLEX*16 dtyy(0,0),dnyy(0,0),dzyy(0,0)
COMPLEX*16 dtzz(0,0),dnzz(0,0),dzzz(0,0)
COMPLEX*16 dtxy(0,0),dnxy(0,0),dzxy(0,0)
COMPLEX*16 dtyx(0,0),dnyx(0,0),dzyx(0,0)
COMPLEX*16 dtxz(0,0),dnxz(0,0),dzxz(0,0)
COMPLEX*16 dtzx(0,0),dnzx(0,0),dzzx(0,0)
COMPLEX*16 dtyz(0,0),dnyz(0,0),dzyz(0,0)
COMPLEX*16 dtzy(0,0),dnzy(0,0),dzzy(0,0)

! Some constants
pi=3.141592653589793238462643D0
e0 = 8.854187817D-12

! We are doing nothing with the Jacobians so initialize to 0
idt = 0
idn = 0
idz = 0
itf = 0
inf = 0
izf = 0

! Allocate memory and fill with zeros where needed
ALLOCATE(rc_ot(0:nmed), rc_on(0:nmed))
ALLOCATE(idrt(0:nmed), idrn(0:nmed), idzi(nmed))
idrt = 0.0
idrn = 0.0
idzi = 0.0

DO j = 0, nmed
  const = -2 * pi * freq * e0
  s_ot = 1.0D0/r_ot(j) + const*dcmplx(0.0,e_ot(j))
  rc_ot(j) = 1.0D0 / s_ot

  s_on = 1.0D0/r_on(j) + const*dcmplx(0.0,e_on(j))
  rc_on(j) = 1.0D0 / s_on
ENDDO

frq = freq / 1000.D0       ! Convert to kHz

CALL DIPMAG_DML(FRQ,NTRN,XL_TRN,NREC,XL_REC, &
  NMED,RC_OT,IDRT,IDT,RC_ON,IDRN,IDN,Z_M,IDZI,IDZ, &
  NSTEP,PRFAZX,PRFAXY,PRFZ,tm, &
  ITF,INF,IZF, &
  HXX,DTXX,DNXX,DZXX, &
  HYY,DTYY,DNYY,DZYY, &
  HZZ,DTZZ,DNZZ,DZZZ, &
  HXY,DTXY,DNXY,DZXY, &
  HYX,DTYX,DNYX,DZYX, &
  HXZ,DTXZ,DNXZ,DZXZ, &
  HZX,DTZX,DNZX,DZZX, &
  HYZ,DTYZ,DNYZ,DZYZ, &
  HZY,DTZY,DNZY,DZZY, &
  IERR,iac)

DEALLOCATE(rc_ot, rc_on)
DEALLOCATE(idrt, idrn, idzi)

RETURN
END

