residual_mod sourceΒΆ

 1module residual_mod
 2  ! MODULE residual_mod (prefix='res' category='1. High-level functionality')
 3  !
 4  !:Purpose: To compute OMA (= OMP - H dx) and its adjoint.
 5  !
 6  use obsSpaceData_mod
 7  implicit none
 8  save
 9  private
10
11  ! public procedures
12  public :: res_compute , res_computeAd
13
14contains
15
16  subroutine res_compute(obsSpaceData)
17    !
18    !:Purpose: Computes residual of observation - analysis from Hdx.
19    !          Takes as input OBS_WORK (observation increment Hdx) and 
20    !          OBS_OMP (innovation) and computes OBS_OMA (observation 
21    !          - analysis)
22    !
23    implicit none
24
25    ! Arguments:
26    type(struct_obs), intent(inout) :: obsSpaceData 
27
28    ! Locals:
29    integer :: index_body
30
31    !$OMP PARALLEL DO PRIVATE(index_body)
32    do index_body=1,obs_numbody(obsSpaceData)
33      if(obs_bodyElem_i(obsSpaceData,OBS_ASS,index_body) == obs_assimilated) then
34        call obs_bodySet_r(obsSpaceData,OBS_OMA,index_body, &
35             obs_bodyElem_r(obsSpaceData,OBS_OMP,index_body) &
36             -obs_bodyElem_r(obsSpaceData,OBS_WORK,index_body))
37      endif
38    enddo
39    !$OMP END PARALLEL DO
40
41  end subroutine res_compute
42
43  subroutine res_computeAd(obsSpaceData)
44    !
45    !:Purpose: Adjoint of computing residuals to observations.
46    !          OBS_WORK contains input and output.
47    !
48    implicit none
49
50    ! Arguments:
51    type(struct_obs), intent(inout) :: obsSpaceData
52
53    ! Locals:
54    integer :: index_body
55    
56    !$OMP PARALLEL DO PRIVATE(index_body)
57    do index_body=1,obs_numbody(obsSpaceData)
58      if(obs_bodyElem_i(obsSpaceData,OBS_ASS,index_body) == obs_assimilated) then
59        call obs_bodySet_r(obsSpaceData,OBS_WORK,index_body, &
60             -obs_bodyElem_r(obsSpaceData,OBS_WORK,index_body))
61      endif
62    enddo
63    !$OMP END PARALLEL DO
64
65  end subroutine res_computeAd
66
67end module residual_mod