da_jo_and_grady_ships.inc
References to this file elsewhere.
1 subroutine da_jo_and_grady_ships(iv, re, jo, jo_grad_y)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 type (ob_type), intent(in) :: iv ! Innovation vector.
10 type (y_type), intent(in) :: re ! Residual vector.
11 type (y_type), intent(inout) :: jo_grad_y ! Grad_y(Jo)
12 type (jo_type), intent(inout):: jo ! Obs cost function.
13
14 integer :: n
15
16 jo % ships_u = 0.0
17 jo % ships_v = 0.0
18 jo % ships_t = 0.0
19 jo % ships_p = 0.0
20 jo % ships_q = 0.0
21
22 if (iv%num_ships > 0) then
23 do n=1, iv%num_ships
24 jo_grad_y%ships(n)%u = -re%ships(n)%u / &
25 (iv%ships(n)%u%error * iv%ships(n)%u%error)
26 jo_grad_y%ships(n)%v = -re%ships(n)%v / &
27 (iv%ships(n)%v%error * iv%ships(n)%v%error)
28 jo_grad_y%ships(n)%t = -re%ships(n)%t / &
29 (iv%ships(n)%t%error * iv%ships(n)%t%error)
30 jo_grad_y%ships(n)%p = -re%ships(n)%p / &
31 (iv%ships(n)%p%error * iv%ships(n)%p%error)
32 jo_grad_y%ships(n)%q = -re%ships(n)%q / &
33 (iv%ships(n)%q%error * iv%ships(n)%q%error)
34
35 if (iv%ships(n)%loc%proc_domain) then
36 jo % ships_u = jo % ships_u - re%ships(n)%u * jo_grad_y%ships(n)%u
37 jo % ships_v = jo % ships_v - re%ships(n)%v * jo_grad_y%ships(n)%v
38 jo % ships_t = jo % ships_t - re%ships(n)%t * jo_grad_y%ships(n)%t
39 jo % ships_p = jo % ships_p - re%ships(n)%p * jo_grad_y%ships(n)%p
40 jo % ships_q = jo % ships_q - re%ships(n)%q * jo_grad_y%ships(n)%q
41 end if
42 end do
43
44 jo % ships_u = 0.5 * jo % ships_u
45 jo % ships_v = 0.5 * jo % ships_v
46 jo % ships_t = 0.5 * jo % ships_t
47 jo % ships_p = 0.5 * jo % ships_p
48 jo % ships_q = 0.5 * jo % ships_q
49 end if
50
51 end subroutine da_jo_and_grady_ships
52
53