Ticket #9: cost_grad.F

File cost_grad.F, 8.2 KB (added by m.hadfield, 18 years ago)
Line 
1#include "cppdefs.h"
2 MODULE cost_grad_mod
3#if defined IS4DVAR || defined IS4DVAR_OLD
4!
5!svn $Id: cost_grad.F 8 2007-02-06 19:00:29Z arango $
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2007 The ROMS/TOMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.txt !
10!=======================================================================
11! !
12! This routine computes the total cost function gradient by adding !
13! background and observations contributions in v-space: !
14! !
15! GRADv(J) = GRADv(Jb) + GRADv(Jo) (1) !
16! !
17! GRADv(J) = deltaV + B^(T/2) GRADx(Jo) (2) !
18! !
19! GRADv(J) = deltaV + W^(-1/2) L^(T/2) G S (3) !
20! !
21! where !
22! !
23! deltaV Increment vector (TLM solution) in v-space !
24! B Background-error covariance matrix !
25! S Background-error standard deviations !
26! G Normalization coefficients matrix !
27! L Self-adjoint filtering (diffusion) operators !
28! W Grid cell area or volume metric !
29! !
30! The last term in (3) is the result of the adjoint convolution. !
31! !
32!=======================================================================
33!
34 implicit none
35
36 PRIVATE
37 PUBLIC cost_grad
38
39 CONTAINS
40!
41!***********************************************************************
42 SUBROUTINE cost_grad (ng, tile, Linp, Lout)
43!***********************************************************************
44!
45 USE mod_param
46 USE mod_ocean
47!
48! Imported variable declarations.
49!
50 integer, intent(in) :: ng, tile, Linp, Lout
51!
52! Local variable declarations.
53!
54# include "tile.h"
55!
56 CALL cost_grad_tile (ng, Istr, Iend, Jstr, Jend, &
57 & LBi, UBi, LBj, UBj, &
58 & Linp, Lout, &
59# ifdef SOLVE3D
60 & OCEAN(ng) % tl_t, &
61 & OCEAN(ng) % tl_u, &
62 & OCEAN(ng) % tl_v, &
63# else
64 & OCEAN(ng) % tl_ubar, &
65 & OCEAN(ng) % tl_vbar, &
66# endif
67 & OCEAN(ng) % tl_zeta, &
68# ifdef SOLVE3D
69 & OCEAN(ng) % ad_t, &
70 & OCEAN(ng) % ad_u, &
71 & OCEAN(ng) % ad_v, &
72# else
73 & OCEAN(ng) % ad_ubar, &
74 & OCEAN(ng) % ad_vbar, &
75# endif
76 & OCEAN(ng) % ad_zeta)
77 RETURN
78 END SUBROUTINE cost_grad
79!
80!***********************************************************************
81 SUBROUTINE cost_grad_tile (ng, Istr, Iend, Jstr, Jend, &
82 & LBi, UBi, LBj, UBj, &
83 & Linp, Lout, &
84# ifdef SOLVE3D
85 & tl_t, tl_u, tl_v, &
86# else
87 & tl_ubar, tl_vbar, &
88# endif
89 & tl_zeta, &
90# ifdef SOLVE3D
91 & ad_t, ad_u, ad_v, &
92# else
93 & ad_ubar, ad_vbar, &
94# endif
95 & ad_zeta)
96!***********************************************************************
97!
98 USE mod_param
99!
100! Imported variable declarations.
101!
102 integer, intent(in) :: ng, Iend, Istr, Jend, Jstr
103 integer, intent(in) :: LBi, UBi, LBj, UBj
104 integer, intent(in) :: Linp, Lout
105!
106# ifdef ASSUMED_SHAPE
107# ifdef SOLVE3D
108 real(r8), intent(in) :: tl_t(LBi:,LBj:,:,:,:)
109 real(r8), intent(in) :: tl_u(LBi:,LBj:,:,:)
110 real(r8), intent(in) :: tl_v(LBi:,LBj:,:,:)
111# else
112 real(r8), intent(in) :: tl_ubar(LBi:,LBj:,:)
113 real(r8), intent(in) :: tl_vbar(LBi:,LBj:,:)
114# endif
115 real(r8), intent(in) :: tl_zeta(LBi:,LBj:,:)
116# ifdef SOLVE3D
117 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
118 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
119 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
120# else
121 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
122 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
123# endif
124 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
125# else
126# ifdef SOLVE3D
127 real(r8), intent(in) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
128 real(r8), intent(in) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
129 real(r8), intent(in) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
130# else
131 real(r8), intent(in) :: tl_ubar(LBi:UBi,LBj:UBj,3)
132 real(r8), intent(in) :: tl_vbar(LBi:UBi,LBj:UBj,3)
133# endif
134 real(r8), intent(in) :: tl_zeta(LBi:UBi,LBj:UBj,3)
135# ifdef SOLVE3D
136 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
137 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
138 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
139# else
140 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,3)
141 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,3)
142# endif
143 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,3)
144# endif
145!
146! Local variable declarations.
147!
148 integer :: IstrR, IendR, JstrR, JendR, IstrU, JstrV
149 integer :: i, j
150# ifdef SOLVE3D
151 integer :: itrc, k
152# endif
153
154# include "set_bounds.h"
155!
156!-----------------------------------------------------------------------
157! Compute total cost function gradient: add background (Jb) and
158! observation contributions (Jo). Over-write observation values
159! with total.
160!-----------------------------------------------------------------------
161!
162! Free-surface gradient norm.
163!
164 DO j=JstrR,JendR
165 DO i=IstrR,IendR
166 ad_zeta(i,j,Lout)=tl_zeta(i,j,Linp)+ &
167 & ad_zeta(i,j,Lout)
168 END DO
169 END DO
170
171# if !defined SOLVE3D
172!
173! 2D momentum gradient norm.
174!
175 DO j=JstrR,JendR
176 DO i=Istr,IendR
177 ad_ubar(i,j,Lout)=tl_ubar(i,j,Linp)+ &
178 & ad_ubar(i,j,Lout)
179 END DO
180 END DO
181 DO j=Jstr,JendR
182 DO i=IstrR,IendR
183 ad_vbar(i,j,Lout)=tl_vbar(i,j,Linp)+ &
184 & ad_vbar(i,j,Lout)
185 END DO
186 END DO
187# else
188!
189! 3D momentum gradient norm.
190!
191 DO k=1,N(ng)
192 DO j=JstrR,JendR
193 DO i=Istr,IendR
194 ad_u(i,j,k,Lout)=tl_u(i,j,k,Linp)+ &
195 & ad_u(i,j,k,Lout)
196 END DO
197 END DO
198 DO j=Jstr,JendR
199 DO i=IstrR,IendR
200 ad_v(i,j,k,Lout)=tl_v(i,j,k,Linp)+ &
201 & ad_v(i,j,k,Lout)
202 END DO
203 END DO
204 END DO
205!
206! Tracers gradient norm.
207!
208 DO itrc=1,NT(ng)
209 DO k=1,N(ng)
210 DO j=JstrR,JendR
211 DO i=IstrR,IendR
212 ad_t(i,j,k,Lout,itrc)=tl_t(i,j,k,Linp,itrc)+ &
213 & ad_t(i,j,k,Lout,itrc)
214 END DO
215 END DO
216 END DO
217 END DO
218# endif
219
220 RETURN
221 END SUBROUTINE cost_grad_tile
222#endif
223 END MODULE cost_grad_mod