C
       SUBROUTINE ATOOLC_DML(iac,NF,FR,NT,TR,NR,RC,
     *                  NSTEP,PRFRad,RelAZX,RelAXY,RelPRFRadAng,
     *                  Z1,dip1,rot1,
     *                  istr,NMED,R_OT,R_ON,E_OT,E_ON,Z_M,
     *                  IDRT,IDRN,IDZI,IDT,IDN,IDZ,Npar,xtr,
     *                  sxx,sxy,sxz,syy,syz,szx,szy,szz,
     *                  dxx,dxy,dxz,dyy,dyz,dzx,dzy,dzz)
c input
c      iac - index of accuracy
c      NF - number of frequencies 
c      FR - frequencies (KHz)
c      NT - number of transmitters
c      TR - coordinates of transmitters relatively measure point in tool coordinate system (m)
c      NR - number of receivers
c      RC - coordinates of receivers    relatively measure point in tool coordinate system (m)
c      NSTEP  - number of profiling steps
c      RelAZX - (dip_i-dip1) angles (degree)
c      RelAXY - (rot_i-rot1) angles (degree)
c	 PRFRad - length of radius-vector from first profiling point to profiling point
c	 RelPRFRadAng - (psi_i-dip1) angles (degree), where psi_i - angle of radius-vector rotation
c      z1     - z-coordinate (m) of 1st point along profile
c      dip1   - 1st dip angle
c      rot1   - 1st rot angle
c      istr   - 0 - isotropic layer, then R_ON=R_OT, IDRN=IDRT inside code
c               1 - anisotropic medium
c      NMED   - number of boundaries
c      R_OT   - hor.  resistivities (Ohmm)
c      R_ON   - vert. resistivities (Ohmm)
c      E_OT   - hor.  permittivities
c      E_ON   - vert. permittivities
c      Z_M    - z-coordinates of boundaries
c      IDRT   - indexes to calculate hor.  resist. derivative (0 or 1)
c      IDRN   - indexes to calculate vert. resist. derivative (0 or 1)
c      IDZI   - indexes to calculate boundary      derivative (0 or 1)
c      IDT    - number of hor.  resist. derivatives
c      IDN    - number of vert. resist. derivatives
c      IDZ    - number of boundary      derivatives        
c      Npar   - number of used derivatives  = IDT+IDN+IDZ       
c output
c      xtr  - array spacings 
c      s**  - magnetic fields
c      d**  - derivatives
c order of measurements:
c       do ist=1,nstep
c       do ifr=1,nf
c	  i=ifr+(ist-1)*nf
c       do irc=1,nr
c       do itr=1,nt
c	  j=itr+(irc-1)*nt
c       h**=s**(j,i) ! - magnetic field at {prfzp(ist),fr(ifr),rc(irc),tr(itr)}
c        do k=1,npar
c        d**=d**(j,i,k) ! - derivative of magnetic field wrt k-th earth parameter
c        enddo 
c       enddo 
c       enddo 
c       enddo 
c       enddo 
c other arrays
c      PRFZP  - coordinates of measure points along borehole (m)
c               1st coordinate is z-coordinate connected with earth model (is not used)
c      PRF    - z-coordinates of measure points connected with earth model (m)
c
	!DEC$ IF DEFINED (_DLL)
	USE KERNEL32, only: GetProcAddress, LoadLibrary, FreeLibrary
      use ifwin
	!DEC$ END IF
	implicit none
	!DEC$ IF DEFINED (_DLL)
	character*80 dll_name
   	character*80 dll_sub_name
   	integer(HANDLE) lib_handle !(HANDLE)
   	interface
		subroutine DIPMAG_DML(FREQ,NTRN,XL_TRN,NREC,XL_REC,
     *                    NMED,R_OT,IDRT,IDT,R_ON,IDRN,IDN,Z_M,IDZI,IDZ,
     *                    NSTEP,PRFAZX,PRFAXY,PRFZ,tm,
     *                    ITF,INF,IZF,
     *                    HXX,DRTXX,DRNXX,DZXX,
     *                    HYY,DRTYY,DRNYY,DZYY,
     *                    HZZ,DRTZZ,DRNZZ,DZZZ,
     *                    HXY,DRTXY,DRNXY,DZXY,
     *                    HYX,DRTYX,DRNYX,DZYX,
     *                    HXZ,DRTXZ,DRNXZ,DZXZ,
     *                    HZX,DRTZX,DRNZX,DZZX,
     *                    HYZ,DRTYZ,DRNYZ,DZYZ,
     *                    HZY,DRTZY,DRNZY,DZZY,
     *                    IERR,iac)
			INTEGER iac,NREC,NTRN
			real*8  XL_TRN(NTRN),XM_SX(NTRN),XM_SY(NTRN),XM_SZ(NTRN)
			real*8  XL_REC(NREC),XM_RX(NREC),XM_RY(NREC),XM_RZ(NREC)
			INTEGER NMED,IDRT(0:NMED),IDRN(0:NMED),IDZI(NMED)
			real*8  FREQ,Z_M(NMED)
			complex*16 R_OT(0:NMED),R_ON(0:NMED)
			INTEGER NSTEP
			real*8  PRFAZX(NSTEP),PRFAXY(NSTEP),PRFZ(NSTEP)
			INTEGER IDT,IDN,IDZ,ITF,INF,IZF,IERR
			complex*16 HXX(NSTEP*NREC*NTRN),
     *                   DRTXX(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNXX(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZXX (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HYY(NSTEP*NREC*NTRN),
     *                   DRTYY(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNYY(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZYY (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HZZ(NSTEP*NREC*NTRN),
     *                   DRTZZ(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNZZ(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZZZ (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HXY(NSTEP*NREC*NTRN),
     *                   DRTXY(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNXY(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZXY (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HYX(NSTEP*NREC*NTRN),
     *                   DRTYX(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNYX(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZYX (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HXZ(NSTEP*NREC*NTRN),
     *                   DRTXZ(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNXZ(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZXZ (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HZX(NSTEP*NREC*NTRN),
     *                   DRTZX(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNZX(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZZX (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HYZ(NSTEP*NREC*NTRN),
     *                   DRTYZ(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNYZ(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZYZ (IZF*NSTEP*NREC*NTRN,IDZ)
			complex*16 HZY(NSTEP*NREC*NTRN),
     *                   DRTZY(ITF*NSTEP*NREC*NTRN,IDT),
     *                   DRNZY(INF*NSTEP*NREC*NTRN,IDN),
     *                   DZZY (IZF*NSTEP*NREC*NTRN,IDZ)
			character*2 tm
C
!			real*8  TX_,TY_,TZ_,RX_,RY_,RZ_,AZX_,AXY_
!			complex*16 XX_,YY_,ZZ_,XZ_,ZX_,CZERO
!			complex*16 HXX_,HYY_,HZZ_,HXY_,HYX_,HXZ_,HZX_,HYZ_,HZY_
!			INTEGER I,J,JT,JN,JZ,ID,ITZ,K,INT,INC,III,IT,IN,IZ
!			real*8  R
		end subroutine DIPMAG_DML
   	end interface
   	pointer (p,DIPMAG_DML)
	logical status
	character*256 name
	common /DMDLL_DML/ name
	!DEC$ END IF

      INTEGER nstep,nmed,Npar,IDT,IDN,IDZ,NF,NR,NT,i,j,k,m,l
	INTEGER ITF,INF,IZF,itr,irc,ifr,ierr,iac
      INTEGER IDRT(0:NMED),IDRN(0:NMED),IDZI(NMED),istr(0:NMED)
      INTEGER kstr(IDT),mstr(IDN)
      pointer (Pkstr,kstr),(Pmstr,mstr)
      	
	REAL*8 dcosd,dabs
      REAL*8 R_OT(0:NMED),R_ON(0:NMED),Z_M(NMED)
      REAL*8 E_OT(0:NMED),E_ON(0:NMED)
      COMPLEX*16 RET(0:NMED),REN(0:NMED)
	POINTER(PRET,RET),(PREN,REN)
      REAL*8 PRFRad(NSTEP),RelAZX(NSTEP)
	REAL*8 RelAXY(NSTEP), RelPRFRadAng(NSTEP)
	REAL*8 Z1, dip1, rot1
	REAL*8 PRFAZX(NSTEP), PRFAXY(NSTEP)
      REAL*8 FREQ,EPS0
      REAL*8 PRF(NSTEP)
	POINTER(PPRF,PRF)
      REAL*8 FR(NF),TR(NT),RC(NR),XTR(NT,NR)
      character*2 tm

      COMPLEX*16 sxx(NT*NR,NF*NSTEP),dxx(NT*NR,NF*NSTEP,Npar)
      COMPLEX*16 sxy(NT*NR,NF*NSTEP),dxy(NT*NR,NF*NSTEP,Npar)
      COMPLEX*16 sxz(NT*NR,NF*NSTEP),dxz(NT*NR,NF*NSTEP,Npar)
      COMPLEX*16 syy(NT*NR,NF*NSTEP),dyy(NT*NR,NF*NSTEP,Npar)
      COMPLEX*16 syz(NT*NR,NF*NSTEP),dyz(NT*NR,NF*NSTEP,Npar)
      COMPLEX*16 szx(NT*NR,NF*NSTEP),dzx(NT*NR,NF*NSTEP,Npar)
      COMPLEX*16 szy(NT*NR,NF*NSTEP),dzy(NT*NR,NF*NSTEP,Npar)
      COMPLEX*16 szz(NT*NR,NF*NSTEP),dzz(NT*NR,NF*NSTEP,Npar)

      complex*16 HXX(NSTEP*NR*NT),
     *     DRTXX(NSTEP*NR*NT,IDT),
     *     DRNXX(NSTEP*NR*NT,IDN),
     *     DZXX (NSTEP*NR*NT,IDZ)
      complex*16 HYY(NSTEP*NR*NT),
     *     DRTYY(NSTEP*NR*NT,IDT),
     *     DRNYY(NSTEP*NR*NT,IDN),
     *     DZYY (NSTEP*NR*NT,IDZ)
      complex*16 HZZ(NSTEP*NR*NT),
     *     DRTZZ(NSTEP*NR*NT,IDT),
     *     DRNZZ(NSTEP*NR*NT,IDN),
     *     DZZZ (NSTEP*NR*NT,IDZ)
      complex*16 HXY(NSTEP*NR*NT),
     *     DRTXY(NSTEP*NR*NT,IDT),
     *     DRNXY(NSTEP*NR*NT,IDN),
     *     DZXY (NSTEP*NR*NT,IDZ)
      complex*16 HYX(NSTEP*NR*NT),
     *     DRTYX(NSTEP*NR*NT,IDT),
     *     DRNYX(NSTEP*NR*NT,IDN),
     *     DZYX (NSTEP*NR*NT,IDZ)
      complex*16 HXZ(NSTEP*NR*NT),
     *     DRTXZ(NSTEP*NR*NT,IDT),
     *     DRNXZ(NSTEP*NR*NT,IDN),
     *     DZXZ (NSTEP*NR*NT,IDZ)
      complex*16 HZX(NSTEP*NR*NT),
     *     DRTZX(NSTEP*NR*NT,IDT),
     *     DRNZX(NSTEP*NR*NT,IDN),
     *     DZZX (NSTEP*NR*NT,IDZ)
      complex*16 HYZ(NSTEP*NR*NT),
     *     DRTYZ(NSTEP*NR*NT,IDT),
     *     DRNYZ(NSTEP*NR*NT,IDN),
     *     DZYZ (NSTEP*NR*NT,IDZ)
      complex*16 HZY(NSTEP*NR*NT),
     *     DRTZY(NSTEP*NR*NT,IDT),
     *     DRNZY(NSTEP*NR*NT,IDN),
     *     DZZY (NSTEP*NR*NT,IDZ)

      POINTER(PHXX,HXX),(PDRTXX,DRTXX),(PDRNXX,DRNXX),(PDZXX,DZXX)
      POINTER(PHXY,HXY),(PDRTXY,DRTXY),(PDRNXY,DRNXY),(PDZXY,DZXY)
      POINTER(PHXZ,HXZ),(PDRTXZ,DRTXZ),(PDRNXZ,DRNXZ),(PDZXZ,DZXZ)
      POINTER(PHYX,HYX),(PDRTYX,DRTYX),(PDRNYX,DRNYX),(PDZYX,DZYX)
      POINTER(PHYY,HYY),(PDRTYY,DRTYY),(PDRNYY,DRNYY),(PDZYY,DZYY)
      POINTER(PHYZ,HYZ),(PDRTYZ,DRTYZ),(PDRNYZ,DRNYZ),(PDZYZ,DZYZ)
      POINTER(PHZX,HZX),(PDRTZX,DRTZX),(PDRNZX,DRNZX),(PDZZX,DZZX)
      POINTER(PHZY,HZY),(PDRTZY,DRTZY),(PDRNZY,DRNZY),(PDZZY,DZZY)
      POINTER(PHZZ,HZZ),(PDRTZZ,DRTZZ),(PDRNZZ,DRNZZ),(PDZZZ,DZZZ)

	Pkstr    = MALLOC(4*IDT)
	Pmstr    = MALLOC(4*IDN)
      PPRF     = MALLOC(8*NSTEP)
	l=16*(NMED+1)
      PRET     = MALLOC(l)
      PREN     = MALLOC(l)
	l=16*NSTEP*NR*NT
      PHXX     = MALLOC(l)
      PDRTXX   = MALLOC(l*IDT)
      PDRNXX   = MALLOC(l*IDN)
      PDZXX    = MALLOC(l*IDZ)
      PHXY     = MALLOC(l)
      PDRTXY   = MALLOC(l*IDT)
      PDRNXY   = MALLOC(l*IDN)
      PDZXY    = MALLOC(l*IDZ)
      PHXZ     = MALLOC(l)
      PDRTXZ   = MALLOC(l*IDT)
      PDRNXZ   = MALLOC(l*IDN)
      PDZXZ    = MALLOC(l*IDZ)
      PHYX     = MALLOC(l)
      PDRTYX   = MALLOC(l*IDT)
      PDRNYX   = MALLOC(l*IDN)
      PDZYX    = MALLOC(l*IDZ)
      PHYY     = MALLOC(l)
      PDRTYY   = MALLOC(l*IDT)
      PDRNYY   = MALLOC(l*IDN)
      PDZYY    = MALLOC(l*IDZ)
      PHYZ     = MALLOC(l)
      PDRTYZ   = MALLOC(l*IDT)
      PDRNYZ   = MALLOC(l*IDN)
      PDZYZ    = MALLOC(l*IDZ)
      PHZX     = MALLOC(l)
      PDRTZX   = MALLOC(l*IDT)
      PDRNZX   = MALLOC(l*IDN)
      PDZZX    = MALLOC(l*IDZ)
      PHZY     = MALLOC(l)
      PDRTZY   = MALLOC(l*IDT)
      PDRNZY   = MALLOC(l*IDN)
      PDZZY    = MALLOC(l*IDZ)
      PHZZ     = MALLOC(l)
      PDRTZZ   = MALLOC(l*IDT)
      PDRNZZ   = MALLOC(l*IDN)
      PDZZZ    = MALLOC(l*IDZ)
c anisotrophy
      DO I = 0,NMED
	  if(istr(i) == 0) then
      R_ON(I)=R_OT(I)
      IDRN(I)=IDRT(I)
	  end if
      ENDDO
c smth difficult
      k=0
      DO I = 0,NMED
	  if(idrt(i) == 1) then
      k=k+1
	kstr(k)=0
	  if(istr(i) == 0) then
	m=0
      DO J = 0,I
	  if(idrn(j) == 1) then
	m=m+1
	  end if
      ENDDO
	kstr(k)=m ! if = 0 - anis.layer, if = m - number of rn derivative to add
	  end if
c      write(1,*) k,kstr(k)
	  end if
      ENDDO
c
      k=0
      DO I = 0,NMED
	  if(idrn(i) == 1) then
      k=k+1
	mstr(k)=0
	  if(istr(i) == 0) then
	mstr(k)=1 ! if = 0 - anis.layer, if = 1 - isotr. layer
	  end if
c      write(1,*) k,mstr(k)
	  end if
      ENDDO
c derivative indexes
      ITF=0
      INF=0
      IZF=0
      IF(IDT /= 0) ITF=1
      IF(IDN /= 0) INF=1
      IF(IDZ /= 0) IZF=1
c z-coordinates of meas points
	DO I=1,NSTEP
		PRF(i)=Z1+PRFRad(i)*dcosd(RelPRFRadAng(i)+dip1)
		PRFAZX(i)=RelAZX(i)+dip1
		PRFAXY(i)=RelAXY(i)+rot1
      ENDDO
c array spacings
        do itr=1,nt
      do irc=1,nr
      XTR(itr,irc)=dabs(rc(irc)-tr(itr))
      enddo
        enddo ! itr
c
      tm='tl' !'tl' ! tool coordinate system
	!iac=2   ! accuracy parameter 
c
C Main cycle by frequency
c
      EPS0=0.55555555555555555555555555555556D-7 ! 2*PI*1.d3*EPS_0, EPS_0=1.D-9/(36.D0*PI)

      do ifr=1,nf
		FREQ=fr(ifr)
c		complex resistivities
		DO I = 0,NMED
		RET(I)=1.d0 / (1.d0/R_OT(I)-(0.d0,1.d0)*FREQ*E_OT(I)*EPS0)
		  if(istr(i) == 1) then
		REN(I)=1.d0 / (1.d0/R_ON(I)-(0.d0,1.d0)*FREQ*E_ON(I)*EPS0)
		  else
		REN(I)=RET(I)
		  end if
		ENDDO      
	!DEC$ IF DEFINED (_DLL)
   		lib_handle = LoadLibrary(trim(name)//achar(0))
   		dll_sub_name = 'DIPMAG_DML'
   		p = GetProcAddress(lib_handle, trim(dll_sub_name)//achar(0))
	!DEC$ END IF
		call DIPMAG_DML(FREQ,NT,TR,NR,RC,
     *                 NMED,RET,IDRT,IDT,REN,IDRN,IDN,Z_M,IDZI,IDZ,
     *                 NSTEP,PRFAZX,PRFAXY,PRF,tm,
     *                 ITF,INF,IZF,
     *                 HXX,DRTXX,DRNXX,DZXX,
     *                 HYY,DRTYY,DRNYY,DZYY,
     *                 HZZ,DRTZZ,DRNZZ,DZZZ,
     *                 HXY,DRTXY,DRNXY,DZXY,
     *                 HYX,DRTYX,DRNYX,DZYX,
     *                 HXZ,DRTXZ,DRNXZ,DZXZ,
     *                 HZX,DRTZX,DRNZX,DZZX,
     *                 HYZ,DRTYZ,DRNYZ,DZYZ,
     *                 HZY,DRTZY,DRNZY,DZZY,
     *                 IERR,iac)
	!DEC$ IF DEFINED (_DLL)
		status=FreeLibrary(lib_handle)
	!DEC$ END IF

	if (ierr /= 0) then
		write(*,'(a,i2)') 'Error: DipMag error ierr = ',ierr
		stop
	endif

         ENDDO ! ifr
C
	CALL FREE(Pkstr)
	CALL FREE(Pmstr)
      CALL FREE(PPRF)
      CALL FREE(PRET)
      CALL FREE(PREN)
      CALL FREE(PHXX)
      CALL FREE(PDRTXX)
      CALL FREE(PDRNXX)
      CALL FREE(PDZXX) 
      CALL FREE(PHXY)
      CALL FREE(PDRTXY)
      CALL FREE(PDRNXY)
      CALL FREE(PDZXY)
      CALL FREE(PHXZ)
      CALL FREE(PDRTXZ)
      CALL FREE(PDRNXZ)
      CALL FREE(PDZXZ)
      CALL FREE(PHYX)
      CALL FREE(PDRTYX)
      CALL FREE(PDRNYX)
      CALL FREE(PDZYX)
      CALL FREE(PHYY)
      CALL FREE(PDRTYY)
      CALL FREE(PDRNYY)
      CALL FREE(PDZYY)
      CALL FREE(PHYZ)
      CALL FREE(PDRTYZ)
      CALL FREE(PDRNYZ)
      CALL FREE(PDZYZ)
      CALL FREE(PHZX)
      CALL FREE(PDRTZX)
      CALL FREE(PDRNZX)
      CALL FREE(PDZZX)
      CALL FREE(PHZY)
      CALL FREE(PDRTZY)
      CALL FREE(PDRNZY)
      CALL FREE(PDZZY)
      CALL FREE(PHZZ)
      CALL FREE(PDRTZZ)
      CALL FREE(PDRNZZ)
      CALL FREE(PDZZZ)
C
      RETURN
      END SUBROUTINE ATOOLC_DML


C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       SUBROUTINE DIPMAG_DML(FREQ,NTRN,XL_TRN,NREC,XL_REC,
     *                    NMED,R_OT,IDRT,IDT,R_ON,IDRN,IDN,Z_M,IDZI,IDZ,
     *                    NSTEP,PRFAZX,PRFAXY,PRFZ,tm,
     *                    ITF,INF,IZF,
     *                    HXX,DRTXX,DRNXX,DZXX,
     *                    HYY,DRTYY,DRNYY,DZYY,
     *                    HZZ,DRTZZ,DRNZZ,DZZZ,
     *                    HXY,DRTXY,DRNXY,DZXY,
     *                    HYX,DRTYX,DRNYX,DZYX,
     *                    HXZ,DRTXZ,DRNXZ,DZXZ,
     *                    HZX,DRTZX,DRNZX,DZZX,
     *                    HYZ,DRTYZ,DRNYZ,DZYZ,
     *                    HZY,DRTZY,DRNZY,DZZY,
     *                    IERR,iac)
	!DEC$ IF DEFINED (_DLL)
	!DEC$ ATTRIBUTES DLLEXPORT :: DIPMAG_DML
	!DEC$ END IF

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  ATTENTION !!! THIS IS THE NEW UNIVERSAL VERSION subroutine DIPMAG. 
C                DINAMIC MEMORY. Comlex resistivities and spatial harmonic.
c  methods of integration - Gauss and int. on complex surface
c                   ED. BY V.MOGILATOV, Marth 12 2009.
C                                  VER. 4 (current)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C  LANGUAGE: FORTRAN 77 EXTENDED FOR SUN (SPARCOMPILER FORTRAN)
C  PURPOSE:  SIGNAL OF ANY complex*16 (MULTITRANSMITTER, MULTICOIL, MULTIFREQUENCY)
C            INDIUCTION LOGGING TOOL.
C            JACOBIAN C IN HORIZONTALLY LAYERED ANISOTROPIC MEDIUM
C            IN MEDIIUM and TOOL COORDINATE SYSTEMS
C
C  ARGUMENTS  TYPE     IN-OUT     DESCRIPTION
C  FREQ       real*8      INPUT      FREQUENCY   (KHZ)
C  NTRN       INT      INPUT      NUMBER OF TRANSMITTERS
C  XL_TRN     real*8      INPUT      POSITIONS OF TRANSMITTER (M)
C  NREC       INT      INPUT      NUMBER OF 2-COIL PROBES
C  XL_REC     real*8      INPUT      P0SITIONS OF 2-COIL PROBES (M)
C  NMED       INT      INPUT      NUMBER OF BOUNDARIES
C  R_OT       complex*16  INPUT      HORIZONTAL RESISTIVITIS (OHM*M)
C  IDRT       INT      INPUT      MARKER OF HORIZONTAL RESISTIVITY DERIVATIVES
C  R_ON       complex*16     INPUT      VERTICAL RESISTIVITIS  (OHM*M)
C  IDRN       INT      INPUT      MARKER OF VERTICAL RESISTIVITY DERIVATIVES
C  Z_M        real*8      INPUT      DEPTH OF BOUNDARIES  (M)
C  IDZI       INT      INPUT      MARKER OF BOUNDARY DEPTH DERIVATIVES
C  NSTEP      INT      INPUT      NUMBER OF POINT ALONG PROFILE
C  PRFZX      real*8      INPUT      ARRAY OF DIP ANGLES ALONG PROFILE (DEG)
C  PRFXY      real*8      INPUT      ARRAY OF ROTATION ANGLES ALONG PROFILE (DEG)
C  PRF        real*8      INPUT      DEPTHS ALONG PROFILE (M)
C  IDT        INT      INPUT      NUMBER OF HORIZONTAL RESISTIVITY DERIVATIVES
C  IDN        INT      INPUT      NUMBER OF VERTICAL RESISTIVITY DERIVATIVES
C  IDZ        INT      INPUT      NUMBER OF BOUNDARY DEPTH DERIVATIVES
C  ITF        INT      INPUT      | YES (1) OR NO (0) HOR. RES. DER.
C  INF        INT      INPUT      | YES (1) OR NO (0) VER. RES. DER.
C  IZF        INT      INPUT      | YES (1) OR NO (0) DEPTH DER.
C  HXX       complex*16   OUTPUT     XX-MAGNETIC COMPONENT     
C  DRTXX     complex*16   OUTPUT     D(HXX)/D(R_OT)            
C  DRNXX     complex*16   OUTPUT     D(HXX)/D(R_ON)            
C  DZXX      complex*16   OUTPUT     D(HXX)/DZ                 
C  HYY       complex*16   OUTPUT     YY-MAGNETIC COMPONENT     
C  DRTYY     complex*16   OUTPUT     D(HYY)/D(R_OT)            
C  DRNYY     complex*16   OUTPUT     D(HYY)/D(R_ON)            
C  DZYY      complex*16   OUTPUT     D(HYY)/DZ                 
C  HZZ       complex*16   OUTPUT     ZZ-MAGNETIC COMPONENT     
C  DRTZZ     complex*16   OUTPUT     D(HZZ)/D(R_OT)            
C  DRNZZ     complex*16   OUTPUT     D(HZZ)/D(R_ON)            
C  DZZZ      complex*16   OUTPUT     D(HZZ)/DZ                 
C  HXY       complex*16   OUTPUT     XY-MAGNETIC COMPONENT     
C  DRTXY     complex*16   OUTPUT     D(HXY)/D(R_OT)            
C  DRNXY     complex*16   OUTPUT     D(HXY)/D(R_ON)
C  DZXY      complex*16   OUTPUT     D(HXY)/DZ
C  HYX       complex*16   OUTPUT     YX-MAGNETIC COMPONENT
C  DRTYX     complex*16   OUTPUT     D(HYX)/D(R_OT)
C  DRNYX     complex*16   OUTPUT     D(HYX)/D(R_ON)
C  DZYX      complex*16   OUTPUT     D(HYX)/DZ
C  HXZ       complex*16   OUTPUT     XZ-MAGNETIC COMPONENT
C  DRTXZ     complex*16   OUTPUT     D(HXZ)/D(R_OT)
C  DRNXZ     complex*16   OUTPUT     D(HXZ)/D(R_ON)
C  DZXZ      complex*16   OUTPUT     D(HXZ)/DZ
C  HZX       complex*16   OUTPUT     ZX-MAGNETIC COMPONENT
C  DRTZX     complex*16   OUTPUT     D(HZX)/D(R_OT)
C  DRNZX     complex*16   OUTPUT     D(HZX)/D(R_ON)
C  DZZX      complex*16   OUTPUT     D(HZX)/DZ
C  HYZ       complex*16   OUTPUT     YZ-MAGNETIC COMPONENT
C  DRTYZ     complex*16   OUTPUT     D(HYZ)/D(R_OT)
C  DRNYZ     complex*16   OUTPUT     D(HYZ)/D(R_ON)
C  DZYZ      complex*16   OUTPUT     D(HYZ)/DZ
C  HZY       complex*16   OUTPUT     ZY-MAGNETIC COMPONENT
C  DRTZY     complex*16   OUTPUT     D(HZY)/D(R_OT)
C  DRNZY     complex*16   OUTPUT     D(HZY)/D(R_ON)
C  DZZY      complex*16   OUTPUT     D(HZY)/DZ
C  tm        character*2  input      'tl' -in tool or 'md' -in medium coo.
C  iac       integer      input  accuracy (0-regular, 1,2,3-improve, 
C                                          10,11,12,13,14,15-special)  
c                                            
C  ROUTINES USED: DIPDIP, TOOLSYS
C
C  **********************************************
C
	implicit none
      INTEGER iac,NREC,NTRN,KI

      real*8  dreal
	complex*16 dcmplx
      real*8  XL_TRN(NTRN) !,XM_SX(NTRN),XM_SY(NTRN),XM_SZ(NTRN)
      real*8  XL_REC(NREC) !,XM_RX(NREC),XM_RY(NREC),XM_RZ(NREC)
      INTEGER NMED,IDRT(0:NMED),IDRN(0:NMED),IDZI(NMED)
      real*8  FREQ,Z_M(NMED)
      complex*16 R_OT(0:NMED),R_ON(0:NMED)
      INTEGER NSTEP
      real*8  PRFAZX(NSTEP),PRFAXY(NSTEP),PRFZ(NSTEP)
      INTEGER IDT,IDN,IDZ,ITF,INF,IZF,IERR
      complex*16 HXX(NSTEP*NREC*NTRN),
     *     DRTXX(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNXX(INF*NSTEP*NREC*NTRN,IDN),
     *     DZXX (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HYY(NSTEP*NREC*NTRN),
     *     DRTYY(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNYY(INF*NSTEP*NREC*NTRN,IDN),
     *     DZYY (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HZZ(NSTEP*NREC*NTRN),
     *     DRTZZ(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNZZ(INF*NSTEP*NREC*NTRN,IDN),
     *     DZZZ (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HXY(NSTEP*NREC*NTRN),
     *     DRTXY(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNXY(INF*NSTEP*NREC*NTRN,IDN),
     *     DZXY (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HYX(NSTEP*NREC*NTRN),
     *     DRTYX(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNYX(INF*NSTEP*NREC*NTRN,IDN),
     *     DZYX (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HXZ(NSTEP*NREC*NTRN),
     *     DRTXZ(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNXZ(INF*NSTEP*NREC*NTRN,IDN),
     *     DZXZ (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HZX(NSTEP*NREC*NTRN),
     *     DRTZX(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNZX(INF*NSTEP*NREC*NTRN,IDN),
     *     DZZX (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HYZ(NSTEP*NREC*NTRN),
     *     DRTYZ(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNYZ(INF*NSTEP*NREC*NTRN,IDN),
     *     DZYZ (IZF*NSTEP*NREC*NTRN,IDZ)
      complex*16 HZY(NSTEP*NREC*NTRN),
     *     DRTZY(ITF*NSTEP*NREC*NTRN,IDT),
     *     DRNZY(INF*NSTEP*NREC*NTRN,IDN),
     *     DZZY (IZF*NSTEP*NREC*NTRN,IDZ)
C
      real*8  AZX_,AXY_
      complex*16 XX_,YY_,ZZ_,XZ_,ZX_,CZERO
      complex*16 HXX_,HYY_,HZZ_,HXY_,HYX_,HXZ_,HZX_,HYZ_,HZY_
      INTEGER I,J,JT,JN,JZ,ID,ITZ,K,INT,INC,III,IT,IN,IZ
      real*8  R
      character*2 tm
C
      IERR=0
C ******************   CONTROL  *****************
C
c      IF (FREQ < 0.00001 .OR. FREQ > 25000.0) IERR=1     !kHz
      IF (IERR /= 0) GO TO 333
      IF (NREC < 1)                      IERR=3
      IF (IERR /= 0) GO TO 333
      IF (NTRN < 1)                      IERR=3
      IF (IERR /= 0) GO TO 333
      IF (NMED < 0)                      IERR=4
      IF (IERR /= 0) GO TO 333
      DO J=0,NMED
         R=dreal(R_OT(J))
         IF (R < 1.0E-18 .OR. R > 1.0E+18)  IERR=5
	   IF (IERR /= 0) GO TO 333
         R=dreal(R_ON(J))
         IF (R < 1.0E-18 .OR. R > 1.0E+18)  IERR=5
	   IF (IERR /= 0) GO TO 333
      ENDDO
      DO J=0,NMED
         ID=IDRT(J)
         IF (ID /= 0 .AND. ID /= 1)         IERR=6
	   IF (IERR /= 0) GO TO 333
         ID=IDRN(J)
         IF (ID /= 0 .AND. ID /= 1)         IERR=6
	   IF (IERR /= 0) GO TO 333
      ENDDO
      DO J=1,NMED-1
         IF(Z_M(J+1) < Z_M(J))           IERR=7
         IF (IERR /= 0) GO TO 333
      ENDDO
      DO J=1,NMED
         ID=IDZI(J)
         IF (ID /= 0 .AND. ID /= 1)         IERR=8
         IF (IERR /= 0) GO TO 333
      ENDDO
      IF (NSTEP < 1)                     IERR=11
      IF (IERR /= 0) GO TO 333
C  **********************************************
      IF (ITF /= 0 .AND. ITF /= 1)          IERR=45
      IF (IERR /= 0) GO TO 333
      IF (INF /= 0 .AND. INF /= 1)          IERR=45
      IF (IERR /= 0) GO TO 333
      IF (IZF /= 0 .AND. IZF /= 1)          IERR=45
      IF (IERR /= 0) GO TO 333
      IT=0
      DO I=0,NMED
         IF (IDRT(I) == 1) IT=IT+1
      ENDDO
      IF (IT > IDT) THEN
                                          IERR=12     ! BAD SIZE OF ARRAY
         GO TO 333
      ENDIF
      IN=0
      DO I=0,NMED
         IF (IDRN(I) == 1) IN=IN+1
      ENDDO
      IF (IN > IDN) THEN
                                          IERR=12      ! BAD SIZE OF ARRAY
         GO TO 333
      ENDIF
      IZ=0
      DO I=1,NMED
         IF (IDZI(I) == 1) IZ=IZ+1
      ENDDO
      IF (IZ > IDZ) THEN
                                          IERR=12     ! BAD SIZE OF ARRAY
         GO TO 333
      ENDIF

	DRNZZ=dcmplx(0.D0,0.D0)
	DRNXZ=dcmplx(0.D0,0.D0)
	DRNZX=dcmplx(0.D0,0.D0)

      IF (IERR /= 0) THEN
         GO TO 333
      ENDIF
       
       CZERO=DCMPLX(0.d0,0.d0)

        DO ITZ=1,NSTEP
         KI=(ITZ-1)*NTRN*NREC
         DO INT=1,NTRN
         DO INC=1,NREC
           K=(INT-1)*NREC+INC
              III=KI+K
            HXY(III)=czero
            HYX(III)=czero
            HYZ(III)=czero
		  HZY(III)=czero
              DO JT=1,IDT
                   DRTXY(III,JT)=czero            
                   DRTYX(III,JT)=czero            
                   DRTYZ(III,JT)=czero            
                   DRTZY(III,JT)=czero            
              ENDDO                      
              DO JN=1,IDN
                   DRNXY(III,JN)=czero          
                   DRNXY(III,JN)=czero          
                   DRNYZ(III,JN)=czero          
                   DRNZY(III,JN)=czero          
              ENDDO
              DO JZ=1,IDZ
                   DZXY(III,JZ)=czero            
                   DZYX(III,JZ)=czero            
                   DZYZ(III,JZ)=czero            
                   DZZY(III,JZ)=czero            
              ENDDO                      
         ENDDO
         ENDDO
        ENDDO
C
333   CONTINUE
      RETURN
      END SUBROUTINE DIPMAG_DML
      
