       subroutine run_biascor(mype,npe)
!***********************************************************************
!   prgmmr: pondeca           org: np20                date: 2008-02-26
!
! abstract:
! perform a bias update
!
! program history log:
!   2008-02-26  pondeca
!***********************************************************************

       use mpi
       implicit none

       character(60) cgrid
       include 'param.incl' 

!Declare passed variables
       integer(4),intent(in)::mype,npe

!Declare local  variables
       integer(4) is,ie,js,je
       integer(4) i,j,ij,n,nx,ny
       integer(4) jtime(6)
       integer(4) ierror

       character*2 clun
       character*4 cyyyy
       character*2 cmm,cdd,chh

       real(4),allocatable,dimension(:,:)::pinc,tinc,qinc, & 
                                           uinc,vinc,tdinc

       real(4),allocatable,dimension(:,:)::field,finc,bias

       real(4) ds
       real(4) pbiascor,tbiascor,qbiascor,ubiascor,vbiascor,tdbiascor
       real(4) gustbiascor,visbiascor,pblhbiascor
       real(4) rcoeff
       logical lpbiascor,ltbiascor,lqbiascor,lubiascor,lvbiascor,ltdbiascor
       logical lgustbiascor,lvisbiascor,lpblhbiascor
       logical lbiascor
       logical mkrjlists
       logical hwrfblend
       logical fexist

       namelist/gridname/cgrid,lbiascor,lpbiascor,pbiascor,ltbiascor,tbiascor, &
                         lqbiascor,qbiascor,lubiascor,ubiascor,lvbiascor,vbiascor, &
                              ltdbiascor,tdbiascor,lgustbiascor,gustbiascor,lvisbiascor,visbiascor, &
                              lpblhbiascor,pblhbiascor,mkrjlists,hwrfblend


       data cgrid/'conus'/
       data lbiascor/.false./
       data pbiascor/0.0/
       data tbiascor/0.0/
       data qbiascor/0.0/
       data ubiascor/0.0/
       data vbiascor/0.0/
       data tdbiascor/0.0/
       data gustbiascor/0.0/
       data visbiascor/0.0/
       data pblhbiascor/0.0/
!====================================================================
!==> get domain global dimensions (nx,ny)
!====================================================================
       open (55,file='gridname_input',form='formatted')
       read(55,gridname)
       close(55)

       if (mype==0) then
          print*,'in run_biascor: cgrid is =',trim(cgrid)
          print*,'in run_biascor: lbiascor=',lbiascor
          print*,'in run_biascor: pbiascor=',pbiascor
          print*,'in run_biascor: tbiascor=',tbiascor
          print*,'in run_biascor: qbiascor=',qbiascor
          print*,'in run_biascor: ubiascor=',ubiascor
          print*,'in run_biascor: vbiascor=',vbiascor
          print*,'in run_biascor: tdbiascor=',tdbiascor
          print*,'in run_biascor: gustbiascor=',gustbiascor
          print*,'in run_biascor: visbiascor=',visbiascor
          print*,'in run_biascor: pblhbiascor=',pblhbiascor
       endif

       if (.not.lbiascor) return

       call domain_dims(cgrid,nx,ny,ds)
       if (mype==0) print*,'in create_firstguess: nx,ny,ds=',nx,ny,ds
!====================================================================
!==>Divide up full horizontal domain into subdomains
!====================================================================

       call horiz_domain_partition(nx,ny,mype,npe,is,ie,js,je)

       print*,'in run_biascor: is,ie,js,je=',is,ie,js,je
!====================================================================
!==> allocate fields 
!====================================================================
       allocate ( pinc  (is:ie,js:je) )
       allocate ( tinc  (is:ie,js:je) )
       allocate ( qinc  (is:ie,js:je) )
       allocate ( uinc  (is:ie,js:je) )
       allocate ( vinc  (is:ie,js:je) )
       allocate ( tdinc (is:ie,js:je) )

       allocate(field(nx,ny))
       allocate(finc(nx,ny))
       allocate(bias(nx,ny))
!====================================================================

       call fetch_anlincs(jtime,pinc,tinc,qinc,uinc,vinc,tdinc, &
                          is,ie,js,je,nx,ny,mype)


       write(cyyyy,"(i4.4)") jtime(1)
       write(cmm,"(i2.2)")   jtime(2)
       write(cdd,"(i2.2)")   jtime(3)
       write(chh,"(i2.2)")   jtime(4)

       if (mype==0) &
       open (30,file='rtma_biascor_out.dat_'//cyyyy//cmm//cdd//chh,form='unformatted') !output file


       inquire(file='rtma_biascor_in.dat',exist=fexist)

       if(fexist) then 
           open (20,file='rtma_biascor_in.dat',form='unformatted')
         else
           if (mype==0) print*,'in run_biascor: lacking input bias file. assume zero input bias'
       endif

       do n=1,6         !order is: p,t,q,u,v,td

          bias=0.
          if (fexist) read(20) bias

          field=0.

          if (n==1) then;  field (is:ie,js:je) = pinc  (is:ie,js:je) ; rcoeff=pbiascor ; endif
          if (n==2) then;  field (is:ie,js:je) = tinc  (is:ie,js:je) ; rcoeff=tbiascor ; endif
          if (n==3) then;  field (is:ie,js:je) = qinc  (is:ie,js:je) ; rcoeff=qbiascor ; endif
          if (n==4) then;  field (is:ie,js:je) = uinc  (is:ie,js:je) ; rcoeff=ubiascor ; endif
          if (n==5) then;  field (is:ie,js:je) = vinc  (is:ie,js:je) ; rcoeff=vbiascor ; endif
          if (n==6) then;  field (is:ie,js:je) = tdinc (is:ie,js:je) ; rcoeff=tdbiascor; endif

          call mpi_allreduce(field,finc,nx*ny,mpi_real4,mpi_sum,mpi_comm_world,ierror)

          bias = (1.-rcoeff)*bias + rcoeff*finc

          if (mype==0) then
            write(30) bias

            if (n==1) then
              print*,'in run_biascor: pinc,min,max=',minval(finc),maxval(finc)
              print*,'in run_biascor: bias_psfcgrid,min,max=',minval(bias),maxval(bias)
              print*,'**************************************************************'
            endif

            if (n==2) then
              print*,'in run_biascor: tinc,min,max=',minval(finc),maxval(finc)
              print*,'in run_biascor: bias_tgrid,min,max=',minval(bias),maxval(bias)
              print*,'**************************************************************'
            endif

            if (n==3) then
              print*,'in run_biascor: qinc,min,max=',minval(finc),maxval(finc)
              print*,'in run_biascor: bias_qgrid,min,max=',minval(bias),maxval(bias)
              print*,'**************************************************************'
            endif

            if (n==4) then
              print*,'in run_biascor: uinc,min,max=',minval(finc),maxval(finc)
              print*,'in run_biascor: bias_ugrid,min,max=',minval(bias),maxval(bias)
              print*,'**************************************************************'
            endif

            if (n==5) then
              print*,'in run_biascor: vinc,min,max=',minval(finc),maxval(finc)
              print*,'in run_biascor: bias_vgrid,min,max=',minval(bias),maxval(bias)
              print*,'**************************************************************'
            endif

            if (n==6) then
              print*,'in run_biascor: tdinc,min,max=',minval(finc),maxval(finc)
              print*,'in run_biascor: bias_tdgrid,min,max=',minval(bias),maxval(bias)
              print*,'**************************************************************'
            endif
          endif
       enddo

       if (mype==0) then
          if(fexist) close(20)
          close(30)
       endif

       deallocate(qinc)
       deallocate(pinc)
       deallocate(uinc)
       deallocate(vinc)
       deallocate(tinc)
       deallocate(tdinc)
       deallocate(field)
       deallocate(finc)
       deallocate(bias)
end subroutine run_biascor
!************************************************************
