program costf_now

! **********************************************************************
! *              .      .    .
! * PROGRAM:    costf_now
! * PRGMMR:     M. ZUPANSKI     ORG: CIRA/CSU   DATE: 2003-09-10
! *
! * ABSTRACT:   CURRENT OBSERVATIONAL COST FUNCTION
! *             Calculate the observational cost function for given obs types and obs times
! *
! *    INPUT:   res = R**(-1/2)*(y-Hx) (Quality Controlled)
! *
! * PROGRAM LOG:
! *
! * 09/10/2003    ..... M. ZUPANSKI:
! *
! **********************************************************************
      integer,parameter :: ires=21          !! obs residual

      real cost_now,cost_norm

      integer mdata

      character*6 OTYPE
      character*13 DATE

      real,dimension(:),allocatable :: res

!===========================================================

     call getenv("OBSTYPE",OTYPE)
     call getenv("r3ddate",DATE)

     write(*,*) "FOR OBSTYPE ",OTYPE," DATE IS ",DATE
!
!     READ THE NUMBER OF ONE-TIME-LEVEL OBSERVATIONS 
!
      REWIND ires
      READ(ires) mdata
      allocate(res(1:mdata))
      READ(ires) res

!
!   PROCESS COST-FUNCTION
!
          cost_now=0.0
          do i=1,mdata
          cost_now=cost_now+0.5*res(i)*res(i)
          end do

!---- get normalized cost function (J_obs/N_obs) ------------------------
!     (used only for printout purposes)
!
        cost_norm = 0.0
 
        IF(mdata.GT.0) THEN
        cost_norm = cost_now / mdata  
        ENDIF

      write(*,*) "=========================================="
      WRITE(*,*) "== CURRENT ",OTYPE," COST FUNCTION AT ",DATE
      write(*,*) "NUM_",OTYPE,"=  ",mdata
      WRITE(*,8801) cost_now,cost_norm
      write(*,*) "=========================================="

      write(3,*) "=========================================="
      WRITE(3,*) "== CURRENT ",OTYPE," COST FUNCTION AT ",DATE
      write(3,*) "NUM_",OTYPE,"=  ",mdata
      WRITE(3,8801) cost_now,cost_norm
      write(3,*) "=========================================="

 8801 FORMAT('OBSERVATIONAL COST-FUNCTION',E15.7,F15.5/)

stop
end