ROMS
Loading...
Searching...
No Matches
tl_forcing.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE tl_forcing_mod
3
4#if defined TANGENT && (defined WEAK_CONSTRAINT || defined FORCING_SV)
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group Emanuele Di Lorenzo !
9! Licensed under a MIT/X style license Andrew M. Moore !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This routine is used to force the tangent linear state equations. !
14! !
15!=======================================================================
16!
17 implicit none
18!
19 PRIVATE
20 PUBLIC :: tl_forcing
21!
22 CONTAINS
23!
24!***********************************************************************
25 SUBROUTINE tl_forcing (ng, tile, Kfrc, Nfrc)
26!***********************************************************************
27!
28 USE mod_param
29 USE mod_ocean
30# ifdef SOLVE3D
31 USE mod_coupling
32# endif
33!
34! Imported variable declarations.
35!
36 integer, intent(in) :: ng, tile, kfrc, nfrc
37!
38! Local variable declarations.
39!
40# include "tile.h"
41!
42 CALL tl_forcing_tile (ng, tile, &
43 & lbi, ubi, lbj, ubj, &
44 & imins, imaxs, jmins, jmaxs, &
45 & kfrc, nfrc, &
46# ifdef SOLVE3D
47 & ocean(ng) % f_t, &
48 & ocean(ng) % f_u, &
49 & ocean(ng) % f_v, &
50# endif
51 & ocean(ng) % f_ubar, &
52 & ocean(ng) % f_vbar, &
53 & ocean(ng) % f_zeta, &
54# ifdef SOLVE3D
55 & ocean(ng) % tl_t, &
56 & ocean(ng) % tl_u, &
57 & ocean(ng) % tl_v, &
58# endif
59 & ocean(ng) % tl_ubar, &
60 & ocean(ng) % tl_vbar, &
61# ifdef SOLVE3D
62 & coupling(ng) % tl_Zt_avg1, &
63# endif
64 & ocean(ng) % tl_zeta)
65
66 RETURN
67 END SUBROUTINE tl_forcing
68!
69!***********************************************************************
70 SUBROUTINE tl_forcing_tile (ng, tile, &
71 & LBi, UBi, LBj, UBj, &
72 & IminS, ImaxS, JminS, JmaxS, &
73 & Kfrc, Nfrc, &
74# ifdef SOLVE3D
75 & f_t, f_u, f_v, &
76# endif
77 & f_ubar, f_vbar, &
78 & f_zeta, &
79# ifdef SOLVE3D
80 & tl_t, tl_u, tl_v, &
81# endif
82 & tl_ubar, tl_vbar, &
83# ifdef SOLVE3D
84 & tl_Zt_avg1, &
85# endif
86 & tl_zeta)
87!***********************************************************************
88!
89 USE mod_param
90 USE mod_parallel
91 USE mod_iounits
92 USE mod_scalars
93!
94! Imported variable declarations.
95!
96 integer, intent(in) :: ng, tile
97 integer, intent(in) :: LBi, UBi, LBj, UBj
98 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
99 integer, intent(in) :: Kfrc
100 integer, intent(in) :: Nfrc
101!
102# ifdef ASSUMED_SHAPE
103# ifdef SOLVE3D
104 real(r8), intent(in) :: f_t(LBi:,LBj:,:,:)
105 real(r8), intent(in) :: f_u(LBi:,LBj:,:)
106 real(r8), intent(in) :: f_v(LBi:,LBj:,:)
107# endif
108 real(r8), intent(in) :: f_ubar(LBi:,LBj:)
109 real(r8), intent(in) :: f_vbar(LBi:,LBj:)
110 real(r8), intent(in) :: f_zeta(LBi:,LBj:)
111# ifdef SOLVE3D
112 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
113 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
114 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
115# endif
116 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
117 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
118# ifdef SOLVE3D
119 real(r8), intent(inout) :: tl_Zt_avg1(LBi:,LBj:)
120# endif
121 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
122# else
123# ifdef SOLVE3D
124 real(r8), intent(in) :: f_t(LBi:UBi,LBj:UBj,N(ng),NT(ng))
125 real(r8), intent(in) :: f_u(LBi:UBi,LBj:UBj,N(ng))
126 real(r8), intent(in) :: f_v(LBi:UBi,LBj:UBj,N(ng))
127# endif
128 real(r8), intent(in) :: f_ubar(LBi:UBi,LBj:UBj)
129 real(r8), intent(in) :: f_vbar(LBi:UBi,LBj:UBj)
130 real(r8), intent(in) :: f_zeta(LBi:UBi,LBj:UBj)
131# ifdef SOLVE3D
132 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
133 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
134 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
135# endif
136 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
137 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
138# ifdef SOLVE3D
139 real(r8), intent(inout) :: tl_Zt_avg1(LBi:UBi,LBj:UBj)
140# endif
141 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
142# endif
143!
144! Local variable declarations.
145!
146 integer :: i, j
147# ifdef SOLVE3D
148 integer :: itrc, k
149# endif
150
151# include "set_bounds.h"
152!
153!-----------------------------------------------------------------------
154! Add given forcing to tangent linear state.
155!-----------------------------------------------------------------------
156!
157# ifdef WEAK_CONSTRAINT
158 IF (domain(ng)%SouthWest_Corner(tile)) THEN
159 IF (master) THEN
160 IF (frequentimpulse(ng)) THEN
161 IF (iic(ng).eq.ntstart(ng)) THEN
162 WRITE (stdout,10)
163 10 FORMAT (3x,'TL_FORCING - adding weak-constraint ', &
164 & 'forcing at each time-step.')
165 END IF
166 ELSE
167 WRITE (stdout,20) time_code(ng)
168 20 FORMAT (3x,'TL_FORCING - added weak-constraint forcing,', &
169 & t62,'t = ', a)
170 END IF
171 END IF
172 END IF
173# endif
174!
175! Tangent linear free-surface. The two different cases in the
176! case of SOLVE3D are due to the fact that tl_ini_fields is
177! also called on the first timestep. tl_forcing MUST be called
178! before tl_ini_fields.
179!
180# ifdef FORCING_SV
181# ifdef SOLVE3D
182 DO j=jstrr,jendr
183 DO i=istrr,iendr
184 tl_zt_avg1(i,j)=tl_zt_avg1(i,j)+f_zeta(i,j)
185 END DO
186 END DO
187# else
188 DO j=jstrr,jendr
189 DO i=istrr,iendr
190 tl_zeta(i,j,kfrc)=tl_zeta(i,j,kfrc)+f_zeta(i,j)
191 END DO
192 END DO
193# endif
194# else
195# ifdef SOLVE3D
196 IF(iic(ng).eq.ntstart(ng)) THEN
197 DO j=jstrr,jendr
198 DO i=istrr,iendr
199 tl_zeta(i,j,kfrc)=tl_zeta(i,j,kfrc)+f_zeta(i,j)
200 END DO
201 END DO
202 ELSE
203 DO j=jstrr,jendr
204 DO i=istrr,iendr
205 tl_zt_avg1(i,j)=tl_zt_avg1(i,j)+f_zeta(i,j)
206 END DO
207 END DO
208 END IF
209# else
210 DO j=jstrr,jendr
211 DO i=istrr,iendr
212 tl_zeta(i,j,kfrc)=tl_zeta(i,j,kfrc)+f_zeta(i,j)
213 END DO
214 END DO
215# endif
216# endif
217
218# ifndef SOLVE3D
219!
220! Tangent linear 2D momentum.
221!
222 DO j=jstrr,jendr
223 DO i=istr,iendr
224 tl_ubar(i,j,kfrc)=tl_ubar(i,j,kfrc)+f_ubar(i,j)
225 END DO
226 END DO
227!
228 DO j=jstr,jendr
229 DO i=istrr,iendr
230 tl_vbar(i,j,kfrc)=tl_vbar(i,j,kfrc)+f_vbar(i,j)
231 END DO
232 END DO
233
234# else
235!
236! Tangent linear 3D momentum.
237!
238 DO k=1,n(ng)
239 DO j=jstrr,jendr
240 DO i=istr,iendr
241 tl_u(i,j,k,nfrc)=tl_u(i,j,k,nfrc)+f_u(i,j,k)
242 END DO
243 END DO
244 DO j=jstr,jendr
245 DO i=istrr,iendr
246 tl_v(i,j,k,nfrc)=tl_v(i,j,k,nfrc)+f_v(i,j,k)
247 END DO
248 END DO
249 END DO
250!
251! Tangent linear tracers.
252!
253 DO itrc=1,nt(ng)
254 DO k=1,n(ng)
255 DO j=jstrr,jendr
256 DO i=istrr,iendr
257 tl_t(i,j,k,nfrc,itrc)=tl_t(i,j,k,nfrc,itrc)+ &
258 & f_t(i,j,k,itrc)
259 END DO
260 END DO
261 END DO
262 END DO
263# endif
264
265 RETURN
266 END SUBROUTINE tl_forcing_tile
267#endif
268 END MODULE tl_forcing_mod
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_iounits
Definition mod_iounits.F:2
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_scalars
Definition mod_scalars.F:2
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::frequentimpulse
logical, dimension(:), allocatable frequentimpulse
Definition mod_scalars.F:1271
mod_scalars::time_code
character(len=22), dimension(:), allocatable time_code
Definition mod_scalars.F:292
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
tl_forcing_mod
Definition tl_forcing.F:2
tl_forcing_mod::tl_forcing
subroutine, public tl_forcing(ng, tile, kfrc, nfrc)
Definition tl_forcing.F:26
tl_forcing_mod::tl_forcing_tile
subroutine tl_forcing_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kfrc, nfrc, f_t, f_u, f_v, f_ubar, f_vbar, f_zeta, tl_t, tl_u, tl_v, tl_ubar, tl_vbar, tl_zt_avg1, tl_zeta)
Definition tl_forcing.F:87