ufo_gnssroonedvarcheck_eval_derivs_mod.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! (C) British Crown Copyright 2020 Met Office
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
!-------------------------------------------------------------------------------
 
!> Evaluate the 1st and 2nd deriv. of the cost function.
 
module ufo_gnssroonedvarcheck_eval_derivs_mod
 
use kinds, only: kind_real
use missing_values_mod, only: missing_value
 
private
public :: ops_gpsro_eval_derivs_ba
 
contains
 
SUBROUTINE ops_gpsro_eval_derivs_ba (Nstate,  &  ! size ot state vector
                                     Nobs,    &  ! no of obs
                                     x,       &  ! current est. of soln
                                     xb,      &  ! background vector
                                     yobs,    &  ! obs. vector
                                     ycalc,   &  ! y(x)
                                     bm1,     &  ! inverse .of bsck cov matrix
                                     om1,     &  ! inv. of obs+forw cov matrix
                                     kmat,    &  ! gradient matrix
                                     dj_dx,   &  ! -ve of first deriv. of cost function
                                     d2j_dx2,  & ! second deriv. of cost function.
                                     diag_d2j)   ! vector containing the diagonal values of the matrix above
 
 
IMPLICIT NONE
 
! Subroutine arguments:
INTEGER, INTENT(IN)         :: nstate
INTEGER, INTENT(IN)         :: nobs
REAL(kind_real), INTENT(IN)            :: x(:)
REAL(kind_real), INTENT(IN)            :: xb(:)
REAL(kind_real), INTENT(IN)            :: yobs(:)
REAL(kind_real), INTENT(IN)            :: ycalc(:)
REAL(kind_real), INTENT(IN)            :: bm1(:,:)
REAL(kind_real), INTENT(IN)            :: om1(:,:)
REAL(kind_real), INTENT(IN)            :: kmat(:,:)
REAL(kind_real), INTENT(OUT)           :: dj_dx(:)
REAL(kind_real), INTENT(OUT)           :: d2j_dx2(:,:)
REAL(kind_real), INTENT(OUT)           :: diag_d2j(:)
 
! Local declarations:
CHARACTER(len=*), PARAMETER :: routinename = "Ops_GPSRO_eval_derivs_BA"
INTEGER                     :: i
REAL(kind_real)                        :: dx(nstate)
REAL(kind_real)                        :: dy(nobs)
REAL(kind_real)                        :: bdx(nstate)
REAL(kind_real)                        :: ko(nstate,nobs)
 
!--------------------------------------------------------
! 1. Evaluate the 1st and 2nd deriv. of the cost function
!--------------------------------------------------------
 
! Deviation from background
 
dx(:) = x(:) - xb(:)
 
! Obs. meas-calc
 
dy(:) = yobs(:) - ycalc(:)
 
! If absolute difference is greater than 1 radian set difference to 0
 
WHERE (abs(dy(:)) > 1.0)
 
  dy(:) = 0.0
 
END WHERE
 
! calc. Bdx matrix   ie B^-1(x-xb)
 
bdx(:) = matmul(bm1(:,:), dx(:))
 
! K^T O^-1 matrix
 
ko(:,:) = matmul(transpose(kmat(:,:)), om1(:,:))
 
! Calculate -dJ_dx vector    -note the NEGATIVE sign
 
dj_dx(:) = matmul(ko(:,:), dy(:)) - bdx(:)
!print*, 'dJ_dx components'
!write(*,'(10E15.8)') dJ_dx(11), Bdx(11)
!write(*,'(10E15.8)') KO(11,:)
!write(*,'(10E15.8)') dy(:)
 
! d2J_dx2 MATRIX
 
d2j_dx2(:,:) = matmul(ko(:,:), kmat(:,:)) + bm1(:,:)
 
! Save the diagonal terms as a vector.
 
DO i = 1,nstate
 
  diag_d2j(i) = d2j_dx2(i,i)
 
END DO
 
END SUBROUTINE ops_gpsro_eval_derivs_ba
 
end module ufo_gnssroonedvarcheck_eval_derivs_mod