SUBROUTINE XBTbiashamon(itsprobe,depth,temp,maxlevel,maxcalc,
     *numsec,numlevels,iyearx,ixprobe,rlat,rlon,bmiss,ifix,iplat)

c     XBTbiasHamon corrects XBT bias based on information from
c     Hamon et al. The corrections are made before interpolation
c     to standard levels

      parameter (maxyear=3000,maxset=40)
      parameter (ntmax=6)
      parameter (n7db=8,n46=8,ntno=7,nt0=1)
      character*14 firsttime
      dimension depth(maxlevel),temp(maxlevel,maxcalc)
      dimension doffDA(maxyear,ntmax),doffDB(maxyear,ntmax)
      dimension doffZD(maxyear,ntmax)
      dimension toff(maxyear,ntmax)
      dimension itype7db(n7db),itype46(n46)
      dimension itypeno(ntno)
      data itype46 /202,203,208,209,215,216,223,226/
      data itype7db /201,207,214,217,227,228,232,235/
      data itypeno /234,233,224,225,205,211,220/
c      data itype0 /2/
      save firsttime
      save toff,doffDA,doffDB,doffZD,nyearmin,nyearmax,
     * myearmin,myearmax

      if ( firsttime .ne. 'XBTbiashamon' ) then
       firsttime = 'XBTbiashamon'
c read in corrections
       call readhamontable1(maxyear,ntyp,toff)
       call readhamontable2(maxyear,ntyp,doffDA,doffDB,doffZD,
     *  nyearmin,nyearmax)
       call readhamontable3(maxyear,ntyp,doffDA,doffDB,doffZD,
     *  nyearmin,nyearmax)
       call readhamontable4(maxyear,ntyp,doffDA,doffDB,doffZD,
     *  myearmin,myearmax)
       endif
       ntyp=0
       ifix=0
      if ( numlevels .le. maxlevel ) then
       dpt=depth(numlevels)
      else
       call overmax(maxlevel,numsec,numlevels,0,ic,np)
      dpt=temp(ic,np)
      endif
      shalmax=500.
      call xbtshallowdeep(ishallow,ixprobe,dpt,shalmax,iplat)
c     write(6,*) 'ishallow:',ishallow 
      if (ishallow .eq. -1) return      
  
      call xbtwestpacocean(iwestpacific,rlat,rlon)
c      write(6,*) 'rlat,rlon',rlat,rlon
c     write(6,*) 'iwestpacific:', iwestpacific,depth(110)

      call hamon_mbtxbtmean(itsprobe,temp, maxlevel,maxcalc,iwarm,
     *  numlevels,bmiss,depth,nbinmax,xmeanall)      
c     write(6,*) 'iwarm:', iwarm
          iyear=iyearx
      if (iyearx .lt. nyearmin ) iyear=nyearmin
      if (iyearx .gt. nyearmax ) iyear=nyearmax
c       write(6,*) 'nyearmin, nyearmax', nyearmin , nyearmax

      if (iyearx .gt. 1985) then
       iwestpacific = 0
      endif
c     write(6,*) 'iyear,iwestpacific:',iyear, iwestpacific
         if (itsprobe .eq. 2.) then
c       write(6,*) 'itsprobe', itsprobe
c      write(6,*) 'iyear',iyear,ixprobe
        if (ixprobe .eq. 2. ) then
         ntyp=0
       if (ntyp .eq. 0) then
         if (ishallow .eq. 0 .and. iwestpacific .eq. 0 .and.
     *       iwarm .eq. 0) ntyp=1
         if (ishallow .eq. 0 .and. iwestpacific .eq. 0 .and.
     *        iwarm .eq. 1) ntyp=2
         if (ishallow .eq. 0 .and. iwestpacific .eq. 1) 
     *                      ntyp=5

         if (ishallow .eq. 1 .and. iwestpacific .eq. 0 .and.
     *        iwarm .eq. 0) ntyp=3
         if (ishallow .eq. 1 .and. iwestpacific .eq. 0 .and.
     *        iwarm .eq. 1) ntyp=4

         if (ishallow .eq. 1 .and. iwestpacific .eq. 1) 
     *                      ntyp=6
       endif

         elseif (ixprobe .ne. 2.  .and. ixprobe .ne. 0.) then

       do 701 nn=1,n46
701     if ( ixprobe .eq. itype46(nn) ) ntyp=7
       do 702 nn=1,n7db
702     if ( ixprobe .eq. itype7db(nn) ) ntyp=8
       do 703 nn=1,ntno
703     if ( ixprobe .eq. itypeno(nn) ) ntyp=-1
         if (ntyp .eq. -1) return

c       write(6,*) iyear,ntyp 
        if (ntyp .eq. 7) then
         if (iwestpacific .eq. 0 .and. iwarm .eq. 0) ntyp=3 
         if (iwestpacific .eq. 0 .and. iwarm .eq. 1) ntyp=4
         if (iwestpacific .eq. 1) ntyp=6
       endif
        if (ntyp .eq. 8) then
        
         if (iwestpacific .eq. 0 .and. iwarm .eq. 0) ntyp=1 
         if (iwestpacific .eq. 0 .and. iwarm .eq. 1) ntyp=2
        if (iwestpacific .eq. 1) ntyp=5
       endif
        endif
        endif

       ifix=1
      do 200 k=1, numlevels
c       write(6,*) 'depth', depth(k)
       depth(k) = depth(k)*(1. -doffDB(iyear,ntyp)-
     *  (doffDA(iyear,ntyp)*depth(k)))-(doffZD(iyear,ntyp))
       temp(k,1) = temp(k,1)-toff(iyear,ntyp)
c       write(6,*) 'depth', depth(k)
200   continue
c      write(6,*) 'iyear,ntyp', iyear,ntyp
c      write(6,*)'doffDA,doffDB,doffZD,toff',doffDA(iyear,ntyp),
c    * doffDB(iyear,ntyp),doffZD(iyear,ntyp),toff(iyear,ntyp)


      return
      end