ROMS
Loading...
Searching...
No Matches
ADfromTL.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE adfromtl_mod
3
4#if defined SP4DVAR
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This routine initializes the adjoint state with the TL state !
14! !
15!=======================================================================
16!
17 implicit none
18
19 PRIVATE
20 PUBLIC :: adfromtl
21
22 CONTAINS
23!
24!***********************************************************************
25 SUBROUTINE adfromtl (ng, tile)
26!***********************************************************************
27!
28 USE mod_param
29 USE mod_clima
30 USE mod_grid
31 USE mod_ocean
32 USE mod_stepping
33!
34! Imported variable declarations.
35!
36 integer, intent(in) :: ng, tile
37!
38! Local variable declarations.
39!
40# include "tile.h"
41!
42 CALL adfromtl_tile (ng, tile, &
43 & lbi, ubi, lbj, ubj, &
44 & imins, imaxs, jmins, jmaxs, &
45 & lold(ng), knew(ng), &
46# ifdef SOLVE3D
47 & nstp(ng), &
48# endif
49# ifdef MASKING
50 & grid(ng) % rmask, &
51 & grid(ng) % umask, &
52 & grid(ng) % vmask, &
53# endif
54# ifdef SOLVE3D
55 & ocean(ng) % tl_u, &
56 & ocean(ng) % tl_v, &
57 & ocean(ng) % tl_t, &
58# endif
59# ifndef SOLVE3D
60 & ocean(ng) % tl_ubar, &
61 & ocean(ng) % tl_vbar, &
62# endif
63 & ocean(ng) % tl_zeta, &
64# ifdef SOLVE3D
65 & ocean(ng) % ad_u, &
66 & ocean(ng) % ad_v, &
67 & ocean(ng) % ad_t, &
68# endif
69# ifndef SOLVE3D
70 & ocean(ng) % ad_ubar, &
71 & ocean(ng) % ad_vbar, &
72# endif
73 & ocean(ng) % ad_zeta)
74
75 RETURN
76 END SUBROUTINE adfromtl
77!
78!***********************************************************************
79 SUBROUTINE adfromtl_tile (ng, tile, &
80 & LBi, UBi, LBj, UBj, &
81 & IminS, ImaxS, JminS, JmaxS, &
82 & Linp, kout, &
83# ifdef SOLVE3D
84 & nout, &
85# endif
86# ifdef MASKING
87 & rmask, umask, vmask, &
88# endif
89# ifdef SOLVE3D
90 & tl_u, tl_v, tl_t, &
91# endif
92# ifndef SOLVE3D
93 & tl_ubar, tl_vbar, &
94# endif
95 & tl_zeta, &
96# ifdef SOLVE3D
97 & ad_u, ad_v, ad_t, &
98# endif
99# ifndef SOLVE3D
100 & ad_ubar, ad_vbar, &
101# endif
102 & ad_zeta)
103!***********************************************************************
104!
105 USE mod_param
106 USE mod_ncparam
107 USE mod_scalars
108!
109! Imported variable declarations.
110!
111 integer, intent(in) :: ng, tile
112 integer, intent(in) :: LBi, UBi, LBj, UBj
113 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
114 integer, intent(in) :: kout, Linp
115# ifdef SOLVE3D
116 integer, intent(in) :: nout
117# endif
118!
119# ifdef ASSUMED_SHAPE
120# ifdef MASKING
121 real(r8), intent(in) :: rmask(LBi:,LBj:)
122 real(r8), intent(in) :: umask(LBi:,LBj:)
123 real(r8), intent(in) :: vmask(LBi:,LBj:)
124# endif
125# ifdef SOLVE3D
126 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
127 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
128 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
129# endif
130# ifndef SOLVE3D
131 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
132 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
133# endif
134 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
135# ifdef SOLVE3D
136 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
137 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
138 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
139# endif
140# ifndef SOLVE3D
141 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
142 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
143# endif
144 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
145# else
146# ifdef MASKING
147 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
148 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
149 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
150# endif
151# ifdef SOLVE3D
152 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
153 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
154 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
155# endif
156# ifndef SOLVE3D
157 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
158 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
159# endif
160 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
161# ifdef SOLVE3D
162 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
163 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
164 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
165# endif
166# ifndef SOLVE3D
167 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
168 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
169# endif
170 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
171# endif
172!
173! Local variable declarations.
174!
175 integer :: i, itrc, j, k
176
177# include "set_bounds.h"
178!
179!------------------------------------------------------------------------
180! Initialize adjoint using the TL state in record 1.
181!------------------------------------------------------------------------
182!
183! Free-surface.
184!
185 DO j=jstrr,jendr
186 DO i=istrr,iendr
187 ad_zeta(i,j,kout)=tl_zeta(i,j,linp)
188#ifdef MASKING
189 ad_zeta(i,j,kout)=ad_zeta(i,j,kout)*rmask(i,j)
190#endif
191 END DO
192 END DO
193#ifndef SOLVE3D
194!
195! 2D Momentum.
196!
197 DO j=jstrr,jendr
198 DO i=istr,iendr
199 ad_ubar(i,j,kout)=tl_ubar(i,j,linp)
200#ifdef MASKING
201 ad_ubar(i,j,kout)=ad_ubar(i,j,kout)*umask(i,j)
202#endif
203 END DO
204 END DO
205!
206 DO j=jstr,jendr
207 DO i=istrr,iendr
208 ad_vbar(i,j,kout)=tl_vbar(i,j,linp)
209#ifdef MASKING
210 ad_vbar(i,j,kout)=ad_vbar(i,j,kout)*vmask(i,j)
211#endif
212 END DO
213 END DO
214#endif
215# ifdef SOLVE3D
216!
217! 3D Momentum.
218!
219 DO k=1,n(ng)
220 DO j=jstrr,jendr
221 DO i=istr,iendr
222 ad_u(i,j,k,nout)=tl_u(i,j,k,linp)
223#ifdef MASKING
224 ad_u(i,j,k,nout)=ad_u(i,j,k,nout)*umask(i,j)
225#endif
226 END DO
227 END DO
228 END DO
229!
230 DO k=1,n(ng)
231 DO j=jstr,jendr
232 DO i=istrr,iendr
233 ad_v(i,j,k,nout)=tl_v(i,j,k,linp)
234#ifdef MASKING
235 ad_v(i,j,k,nout)=ad_v(i,j,k,nout)*vmask(i,j)
236#endif
237 END DO
238 END DO
239 END DO
240!
241! Tracers.
242!
243 DO itrc=1,nt(ng)
244 DO k=1,n(ng)
245 DO j=jstrr,jendr
246 DO i=istrr,iendr
247 ad_t(i,j,k,nout,itrc)=tl_t(i,j,k,linp,itrc)
248#ifdef MASKING
249 ad_t(i,j,k,nout,itrc)=ad_t(i,j,k,nout,itrc)*rmask(i,j)
250#endif
251 END DO
252 END DO
253 END DO
254 END DO
255# endif
256
257 RETURN
258 END SUBROUTINE adfromtl_tile
259#endif
260 END MODULE adfromtl_mod
adfromtl_mod
Definition ADfromTL.F:2
adfromtl_mod::adfromtl
subroutine, public adfromtl(ng, tile)
Definition ADfromTL.F:26
adfromtl_mod::adfromtl_tile
subroutine adfromtl_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, linp, kout, nout, rmask, umask, vmask, tl_u, tl_v, tl_t, tl_zeta, ad_u, ad_v, ad_t, ad_zeta)
Definition ADfromTL.F:103
mod_clima
Definition mod_clima.F:2
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ncparam
Definition mod_ncparam.F:2
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_scalars
Definition mod_scalars.F:2
mod_stepping
Definition mod_stepping.F:2
mod_stepping::lold
integer, dimension(:), allocatable lold
Definition mod_stepping.F:107
mod_stepping::knew
integer, dimension(:), allocatable knew
Definition mod_stepping.F:64
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71