      SUBROUTINE XBTBIASCHOOSE(ichoice,iyear,month,numlevels,isoor,
     * ifix,ireset54,ihanawaalready)

C     XBTBIASCHOOSE CALCULATES APPROPRIATE XBTBIAS
C     DEPENDING ON USER CHOICE

c   choices:
c    -1, reset second header 54 only
c     0. no corrections
c     1,needs Hanawa et al.; 1994 applied (XBT)
c     2,needs Kizu et al.; 2005 applied (XBT)
c     3,Hanawa et al.; 1994 applied (XBT)
c     4,Kizu et al.; 2005 applied (XBT)
c     Note: if choice is 3, 3 and 4 are executed
c     5,Levitus et al.; 2009 applied (XBT/MBT)
c     6,Wijffels et al.; 2008 Table 1 applied (XBT)
c     7,Wijffels et al.; 2008 Table 2 applied (XBT)
c     8,Ishii and Kimoto; 2009 applied (XBT/MBT)
c     9,Gouretski and Reseghetti; 2010 applied (XBT/MBT)
c     10,Good; 2011 applied (XBT)
c     11,Hamon et al.; 2012 applied (XBT/MBT)
c     12,Gourestki; 2012 applied (XBT)
c     13,Cowley et al. (in prep)
c     14,Lijing from Cowley et al. (in prep)
c     15,Lijing (in prep)

c     ireset54 is set to 1 if second header 54 is to
c     be reset based on above choice.

c     ihanawaalready is set to 1 if a depth equation 
c     transformation has already been applied (where appropriate)
c     [For most cases this means Hanawa has been applied,
c      for choice 9, Gouretski+Reseghetti, this means Sippican
c      depth equation]

      parameter (acoeff=6.472, bcoeff=0.00216)
      parameter (maxlevel=6000,maxcalc=200)
      parameter (kdim=137,noffset=200,bmiss=-1.E10)
      parameter (xbtmaxdepth=2500.)

      character*13 firsttime
      dimension numlevels(0:1),dz(kdim),t0(maxlevel)
      dimension iprec(maxlevel)

      common /thedata/ depth(maxlevel),temp(maxlevel,maxcalc)
      common /significant/ isignif(maxlevel,maxcalc)
      common /eachparm/ numeach(6),numtot2,numtot3,ntax,numsecse
      common /extra/ ireqpars2,ireqsecond,ireqbio

      save firsttime
      save levelmaxbias,dz,ndeps

      if ( firsttime .ne. 'XBTbiaschoice' ) then
       call setstandepsfromfile(ndeps,dz)
c      levelmaxbias is the maximum standard depth for XBTs
c      which are corrected (Levitus correction)
       call finddepthlevelnum(dz,kdim,ndeps,950.,levelmaxbias)

       firsttime='XBTbiaschoice'
      endif

c     Is this an XBT?

      xprobe=temp(numtot2+noffset+5,numeach(1))

      if ( temp(numtot2+29,numeach(1)) .gt. bmiss ) then
       ixtype=temp(numtot2+29,numeach(1))
      else
       ixtype=0
      endif

      if ( ixtype .ne. 2 ) then
       ifix=-1
       return
      endif

c     Get platform (for airdrops, airplane=183)
      iplat=-1
      if ( temp(numtot2+3,numeach(1)) .gt. bmiss )
     * iplat=temp(numtot2+3,numeach(1))

c     Check for depth fix instructions
c     If insufficient information, but year > 1997
c     assume Hanawa
c     xneg is to multiply eventual correction code by -1 
      xneg=1.
      xswitch=temp(numtot2+33,numeach(1))
      if ( temp(numtot2+54,numeach(1)) .le. bmiss )  then
       xno54=1.
      else
       xno54=0.
       if ( temp(numtot2+54,numeach(1)) .lt. 0. .and.
     *  iyear .gt. 1997 .and. ichoice .gt. 0 ) then
        xswitch=1.
        xneg=-1
       endif
      endif

      if ( xprobe .gt. bmiss ) then
       ixtype2=xprobe
      else
       ixtype2=ixtype
       xprobe=temp(numtot2+29,numeach(1))
      endif

c     Check if T5
      it5=0
      if ( ixtype2 .eq. 204 .or. ixtype2 .eq. 210 .or.
     *     ixtype2 .eq. 219 .or. ixtype .eq. 224 .or.
     *     ixtype2 .eq. 225 ) then
       it5=1
      endif

c     Check if a fix is needed
c      ifix=-1, no fix can be made due to
c      max depth exceeded for non-T5/Fast Deep/air drop
c      or no probe indicator, or no depth equation given
c      ifix=0, Hanawa correction already applied
c      ifix=1, run Hanawa correction

      ifix=0
      xfix=0.

      if ( ichoice .ne. 0 ) then

c      Record precision of each temperature
       
       do 400 nn=1,numlevels(isoor)
400     call findprecone(iprec(nn),isignif(nn,1),temp(nn,1))

c      Check for non-corrected XBTs
c      Air-drop, submarine, MHI, Sparton 20, 20DB
       if ( isoor .eq. 1 ) then
        dpt=dz(numlevels(1))
        do 355 nn=1,numlevels(1)
355      depth(nn)=dz(nn)
       elseif ( numlevels(0) .le. maxlevel ) then
        dpt=depth(numlevels(0))
       else
        call overmax(maxlevel,nsecond,numlevels(0),0,ic,np)
        dpt=temp(ic,np)
       endif

c     Exceeds max possible for XBT
       if ( dpt .gt. xbtmaxdepth ) then
        ifix=-1
        return
       endif
        
c      Hamon defines shallow/deep cutoff differently
c     shalmax is max depth for shallow XBT
c     from wijffels et al., except for hamon et al (11)
       shalmax=550.
       if ( ichoice .eq. 11 ) shalmax=500. 
       call xbtshallowdeep(ishallow,ixtype2,dpt,shalmax,iplat)
       call XBTneedsconv(numlevels(isoor),xprobe,xswitch,iyear,ifix,
     * iplat)
       xfix=ifix
       if ( xfix .gt. 0. ) xfix=xfix*xneg

c      Gouretski + Reseghetti (ichoice=9) uses uncorrected XBTs
c      Lijing corrections (14,15) use given depth equation
c      Wijjfels Table 2 (Willis) corrections (7) use given depth equation
       if ( ifix .gt. 0 .and. ichoice .ne. 9 .and.
     *      ichoice .gt. 0 .and.ichoice .ne. 14 .and.
     *      ichoice .ne. 15 .and. ichoice .ne. 7 .and.
     *      ihanawaalready .eq. 0 .and.
     *    (ishallow .ge. 0 .or. it5 .eq. 1 )) then
c      Conversion to Hanawa or Kizu (TSK T5)
        call XBTconv(numlevels(isoor),xprobe)
        write(6,*) 'H95',depth(697)
c      Reset xfix to  Hanawa/Kizu fix
c      Hanawa=3, Kizu=4 (where ifix=1,2)
        xfix=ifix+2.
       endif

       if ( ichoice .eq. 5 ) then

c      Levitus corrections

        if ( ifix .ge. 0 .and.
     *     (ishallow .ge. 0 .or. it5 .eq. 1 )) then

         call XBTbiasant(ixtype,temp,maxlevel,maxcalc,
     *    numlevels(isoor),iyear,levelmaxbias,depth,isoor,
     *    numeach(1))
         xfix=ichoice*xneg

        endif

       elseif ( ichoice .eq. 6 ) then

        if ( ishallow .ge. 0 .and. ixtype .eq. 2 ) then
c        Wijffels Table 1
         call XBTbiaswij(ixtype,depth,temp,maxlevel,
     *    maxcalc,numeach(1),numlevels(isoor),iyear,month,
     *    ifix)
         xfix=ichoice*xneg
        endif

       elseif ( ichoice .eq. 7 ) then
c        Wijffels Table 2 (Willis)
          if ( xswitch .gt. bmiss ) then
           iswitch=xswitch
          else
           if ( iyear .gt. 1997 ) then
           iswitch=1
          else
           iswitch=0
          endif
         endif

c        write(6,*) 'here',iswitch,ixtype,ixtype2
         call XBTbiaswil(ixtype,ixtype2,depth,temp,maxlevel,
     *    maxcalc,numeach(1),numlevels(isoor),iyear,month,
     *    iswitch,ifix,iplat)
         if ( ifix .eq. 1 ) xfix=ichoice*xneg

       elseif ( ichoice .eq. 8 ) then

c       Ishii + Kimoto
        call XBTbiasish(ixtype,ixtype2,depth,temp,maxlevel,
     *   maxcalc,numeach(1),numlevels(isoor),iyear,month,ifix)
        if ( ifix .eq. 1 ) xfix=ichoice*xneg

       elseif ( ichoice .eq. 9 ) then

c      Gouretski + Reseghetti

c      Adjust depths to Sippican equation if necessary
        if ( xswitch .eq. 1. .and. ihanawaalready .eq. 0 ) then

         call timefromdepth(numlevels(isoor),t0,maxlevel,1,
     *    depth)
         call droprate_apply(acoeff,bcoeff,numlevels(isoor),depth,
     *    maxlevel,t0)
        endif

        call XBTbias_gour_rese_new(ixtype,depth,temp,maxlevel,
     *   maxcal,numeach(1),numlevels(isoor),iyear,month,ixtype2,
     *   bmiss,ifix,iplat)
 
c        call XBTbiasgour(ixtype,depth,temp,maxlevel,
c     *   maxcalc,numeach(1),numlevels(isoor),iyear,ixtype2,bmiss,
c     *   ifix)
c       write(6,*) 'ifixgour',ifix
        if ( ifix .eq. 1 ) xfix=ichoice*xneg

c     Adjust for below zero values

        ncheck=8
        if ( ncheck .gt. numlevels(isoor) )
     *   ncheck=numlevels(isoor)
        islessthanzero=0
        do 700 kk=1,ncheck
         if ( depth(kk) .lt. 0. ) then
          islessthanzero=1
          temp(kk,1)=bmiss
         endif
700     continue

        if ( islessthanzero .eq. 1 .and. depth(1) .le. 0. )
     *   temp(1,1)=bmiss

       elseif ( ichoice .eq. 10 ) then

c       Good 2011

        call XBTbiasgood(ixtype,depth,temp,maxlevel,
     *   maxcalc,numeach(1),numlevels(isoor),iyear,ixtype2,bmiss,
     *   ifix)
        if ( ifix .eq. 1 ) xfix=ichoice*xneg

       elseif ( ichoice .eq. 11 ) then

c      Hamon et al. 2012 not yet prepared

       call XBTbiashamon(ixtype,depth,temp,maxlevel,maxcalc,
     *numeach(1),numlevels(isoor),iyear,ixtype2,rlat,rlon,bmiss,ifix,
     * iplat)
        if ( ifix .eq. 1 ) xfix=ichoice*xneg

       elseif ( ichoice .eq. 12 ) then

c       Gouretski 2012 

        if ( xswitch .eq. 1. .and. ihanawaalready .eq. 0 ) then

         call timefromdepth(numlevels(isoor),t0,maxlevel,1,
     *    depth)
         call droprate_apply(acoeff,bcoeff,numlevels(isoor),depth,
     *    maxlevel,t0)
        endif

         call XBTbiasgourt12(ixtype,depth,temp,maxlevel,
     *    maxcalc,numeach(1),numlevels(isoor),iyear,ixtype2,bmiss,
     *    ifix,iplat)
        if ( ifix .eq. 1 ) xfix=ichoice*xneg

       elseif ( ichoice .eq. 13 ) then

c      Cowley et al 2012
c      iterat is the version of the corrections: current=3
        iterat=4
        if ( ishallow .ge. 0 .and. it5 .eq. 0 ) then
         call XBTbiascowlX(depth,temp,maxlevel,
     *    maxcalc,ixtype,ixtype2,iyear,numeach(1),
     *    numlevels(isoor),iterat,iplat)
         xfix=ichoice*xneg
        endif

       elseif ( ichoice .eq. 14 ) then

c       Cowley et al 2012 Lijing correction
        if ( ishallow .ge. 0 .and. it5 .eq. 0 ) then
         call XBTbiaslijing(depth,temp,maxlevel,
     *    maxcalc,ixtype,ixtype2,iyear,numeach(1),
     *    numlevels(isoor),bmiss,xswitch,iplat)
         xfix=ichoice*xneg
        endif

       elseif ( ichoice .eq. 15 ) then

c       Lijing et al 2012
c       iwrite writes info to screen when set to 1
        iwrite=0
        call XBTbiaslijing2(depth,temp,maxlevel,
     *   maxcalc,ixtype,ixtype2,iyear,numeach(1),
     *   numlevels(isoor),bmiss,iwrite,ifix,xswitch,
     *   iplat)
        if ( ifix .eq. 1 ) xfix=ichoice*xneg
c       write(6,*) 'xfix',ifix,xfix,xneg,ichoice

       endif

c     Reset second header 54
       if ( ireset54 .eq. 1 ) then
        temp(numtot2+54,numeach(1))= xfix 
        temp(1,numeach(1))=temp(1,numeach(1))+xno54
        if ( xfix .lt. 10. ) then
         isignif(numtot2+54,numeach(1))=1
        else
         isignif(numtot2+54,numeach(1))=2
        endif
       endif

c     Reset significant figures

      do 401 nn=1,numlevels(isoor)
401    call findsignif(isignif(nn,1),iprec(nn),temp(nn,1))

      endif

      return
      end


