C     Last change:  LMY   3 Dec 2001   11:46 am

      program ThreeDin
      IMPLICIT NONE
      ALLOCATABLE ex,ey,ez,hx,hy,hz
      REAL (KIND=4)  :: ex(:,:,:),ey(:,:,:),ez(:,:,:)
      REAL (KIND=4)  :: hx(:,:,:),hy(:,:,:),hz(:,:,:) ,single=0.
      REAL (KIND=4)  :: exmax,eymax,ezmax,hxmax,hymax,hzmax
      REAL (KIND=4)  :: exc,eyc,ezc,hxc,hyc,hzc,zpos,xpos,ypos,ez0
      REAL (KIND=4)  :: xmax,ymax,zmax
      INTEGER (KIND=2) :: int8a(4) ,iscal=0
      INTEGER (KIND=4) :: iok,izl,nmy,nmx,k,j,i,m,ixyloc,nmeshy,nmeshx
      CHARACTER (LEN=41) :: line
      CHARACTER (LEN=64) :: filename,ofilename
c      parameter (izl=300,nmy=19,nmx=19,xmax=1.205,ymax=1.205)
c      parameter (zmax=14.561)
       parameter (ixyloc=14)
   1  write (*,10)
   10 format (" This program will read a binary file written with a",/,
     &        " Matlab loop that generated a *.bfm file",//,
     &        " for k=izl:izi:izh",/,
     &        "    for j=1:Nmeshy",/,
     &        "       for i=1:Nmeshx",/,
     &        "          fwrite(fbinary,[24 0 0 0],'int8');",/,
     &        "          fwrite(fbinary,[Ei(1:6,i,j,k)'],'single');",/,
     &        "          fwrite(fbinary,[24 0 0 0],'int8');",/,
     &        "       end",/,
     &        "    end",/,
     &        " end",///,
     &        " ENTER INPUT 'filename'"  )
       READ (*,*)filename
      write (*,11)
   11 format (" enter izl,nmeshy,nmeshx,zmax,xmax,and ymax",/,
     &        " assuming zmin=0, xmin=-xmax, ymin=-ymax",/,
     &        " nmeshx and nmeshy must be odd numbers so that",/,
     &        " the middle indici is on axis",//)
       read (*,*)izl,nmeshy,nmeshx,zmax,xmax,ymax
      nmy=(nmeshy)/2
      nmx=(nmeshx)/2
      ALLOCATE (ex(-nmx:nmx,-nmy:nmy,izl)
     & ,ey(-nmx:nmx,-nmy:nmy,izl),
     & ez(-nmx:nmx,-nmy:nmy,izl),
     & hx(-nmx:nmx,-nmy:nmy,izl),
     & hy(-nmx:nmx,-nmy:nmy,izl),
     & hz(-nmx:nmx,-nmy:nmy,izl),stat=iok)
      if (iok.ne.0) then
      STOP " error allocating arrays"
      end if
c
      open (22,FILE=filename,ACCESS='transparent',ERR=1)
c
       do k=1, izl
         do j=-nmy, nmy
            do i=-nmx, nmx
      do m=1,32
      READ(22) line(m:m)
      end do
      int8a(1)=TRANSFER(line(1:2),iscal)
      int8a(2)=TRANSFER(line(3:4),iscal)
      Ex(i,j,k)=TRANSFER(line(5:8),single)
      Ey(i,j,k)=TRANSFER(line(9:12),single)
      Ez(i,j,k)=TRANSFER(line(13:16),single)
      Hx(i,j,k)=TRANSFER(line(17:20),single)
      Hy(i,j,k)=TRANSFER(line(21:24),single)
      Hz(i,j,k)=TRANSFER(line(25:28),single)
      int8a(3)=TRANSFER(line(19:30),iscal)
      int8a(4)=TRANSFER(line(31:32),iscal)
      exc=ex(i,j,k)
      eyc=ey(i,j,k)
      ezc=ez(i,j,k)
      hxc=hx(i,j,k)
      hyc=hy(i,j,k)
      hzc=hz(i,j,k)
      IF(i==0 .and. j==0 .AND. k==1)then
      WRITE(*,*)exc,eyc,ezc,hxc,hyc,hzc
      endif
            enddo
         enddo
       enddo
      if (int8a(1).ne.24) then
      write (*,*)i,j,k
      end if
      exmax=maxval(ex)
      eymax=MAXVAL(ey)
      ezmax=MAXVAL(ez)
      hxmax=MAXVAL(hx)
      hymax=MAXVAL(hy)
      hzmax=MAXVAL(hz)
      WRITE(*,*)exmax,eymax,ezmax,hxmax,hymax,hzmax
      ez0=0
      do k=1,izl
      ez0=ez0+ABS(ez(0,0,k))
      end do
      ez0=ez0/(izl-1)
      WRITE(*,*)'ez0=',ez0
      ez0=1./ez0
       do k=1, izl
         do j=-nmy, nmy
            do i=-nmx, nmx
      ex(i,j,k)=ex(i,j,k)*ez0
      ey(i,j,k)=ey(i,j,k)*ez0
      ez(i,j,k)=ez(i,j,k)*ez0
      hx(i,j,k)=hx(i,j,k)*ez0
      hy(i,j,k)=hy(i,j,k)*ez0
      hz(i,j,k)=hz(i,j,k)*ez0
            enddo
         enddo
       enddo
   13 format (" ENTER OUTPUT 'filename'")
    2   write (*,13)
       read (*,*)ofilename
       IF(ofilename==' ')STOP 'blank filename -- quitting'
      open (33,FILE=ofilename,FORM='unformatted',ERR=2)
      write (33) nmx,nmy,izl
      write (33) xmax,ymax,zmax
       do k=1, izl
         do j=-nmy, nmy
            do i=-nmx, nmx
              write (33) ex(i,j,k),ey(i,j,k),ez(i,j,k),
     1                     hx(i,j,k),hy(i,j,k),hz(i,j,k)
            enddo
         enddo
       enddo
      close (33)
      open (25,FILE="test.qkp")
      write (25,"('data  Ez(0)')")
      do i=1,izl
      zpos=REAL(i-1)/REAL(izl-1)*zmax
      write (25,"(f7.4,2x,e14.8)")zpos,ez(0,0,i)
      end do
      write (25,"('enddata')")
      xpos=xmax* REAL(ixyloc)/nmx
      write (25,"('data Ez x=',f8.4)") xpos
      do i=1,izl
      zpos=REAL(i-1)/REAL(izl-1)*zmax
      write (25,"(f7.4,2x,e14.8)")zpos,ez(ixyloc,0,i)
      end do
      write (25,"('enddata')")
      write (25,"('data Ex x=',f8.4)") xpos
      do i=1,izl
      zpos=REAL(i-1)/REAL(izl-1)*zmax
      write (25,"(f7.4,2x,e14.8)")zpos,ex(ixyloc,0,i)
      end do
      write (25,"('enddata')")
      ypos=ymax* REAL(ixyloc)/nmy
      write (25,"('data Ey y=',f8.4)") ypos
      do i=1,izl
      zpos=REAL(i-1)/REAL(izl-1)*zmax
      write (25,"(f7.4,2x,e14.8)")zpos,ey(0,ixyloc,i)
      end do
      write (25,"('enddata')")
      write (25,"('data Hx*1.E-3 y=',f8.4)") ypos
      do i=1,izl
      zpos=REAL(i-1)/REAL(izl-1)*zmax
      write (25,"(f7.4,2x,e14.8)")zpos,hx(0,ixyloc,i)*1.e-3
      end do
      write (25,"('enddata')")
      write (25,"('data Hy*1.E-3 x=',f8.4)") xpos
      do i=1,izl
      zpos=REAL(i-1)/REAL(izl-1)*zmax
      write (25,"(f7.4,2x,e14.8)")zpos,hy(ixyloc,0,i)*1.e-3
      end do
      write (25,"('enddata')")
      STOP 'end'
      end program

