ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
tl_frc_adjust_mod Module Reference

Functions/Subroutines

subroutine, public tl_frc_adjust (ng, tile, linp)
 
subroutine tl_frc_adjust_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, tl_ustr, tl_vstr, tl_sustr, tl_svstr, tl_tflux, tl_stflx, linp)
 

Function/Subroutine Documentation

◆ tl_frc_adjust()

subroutine, public tl_frc_adjust_mod::tl_frc_adjust ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) linp )

Definition at line 33 of file tl_frc_adjust.F.

34!***********************************************************************
35!
36 USE mod_param
37 USE mod_forces
38!
39! Imported variable declarations.
40!
41 integer, intent(in) :: ng, tile, Linp
42!
43! Local variable declarations.
44!
45 character (len=*), parameter :: MyFile = &
46 & __FILE__
47!
48# include "tile.h"
49!
50# ifdef PROFILE
51 CALL wclock_on (ng, itlm, 7, __line__, myfile)
52# endif
53 CALL tl_frc_adjust_tile (ng, tile, &
54 & lbi, ubi, lbj, ubj, &
55 & imins, imaxs, jmins, jmaxs, &
56# ifdef ADJUST_WSTRESS
57 & forces(ng) % tl_ustr, &
58 & forces(ng) % tl_vstr, &
59 & forces(ng) % tl_sustr, &
60 & forces(ng) % tl_svstr, &
61# endif
62# if defined ADJUST_STFLUX && defined SOLVE3D
63 & forces(ng) % tl_tflux, &
64 & forces(ng) % tl_stflx, &
65# endif
66 & linp)
67# ifdef PROFILE
68 CALL wclock_off (ng, itlm, 7, __line__, myfile)
69# endif
70!
71 RETURN
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_param
Definition mod_param.F:2
mod_param::itlm
integer, parameter itlm
Definition mod_param.F:663
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3

References mod_forces::forces, mod_param::itlm, tl_frc_adjust_tile(), wclock_off(), and wclock_on().

Referenced by tl_main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ tl_frc_adjust_tile()

subroutine tl_frc_adjust_mod::tl_frc_adjust_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) tl_ustr,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) tl_vstr,
real(r8), dimension(lbi:,lbj:), intent(inout) tl_sustr,
real(r8), dimension(lbi:,lbj:), intent(inout) tl_svstr,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) tl_tflux,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_stflx,
integer, intent(in) linp )
private

Definition at line 75 of file tl_frc_adjust.F.

86!***********************************************************************
87!
88 USE mod_param
89 USE mod_scalars
90!
91! Imported variable declarations.
92!
93 integer, intent(in) :: ng, tile
94 integer, intent(in) :: LBi, UBi, LBj, UBj
95 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
96 integer, intent(in) :: Linp
97!
98# ifdef ASSUMED_SHAPE
99# ifdef ADJUST_WSTRESS
100 real(r8), intent(in) :: tl_ustr(LBi:,LBj:,:,:)
101 real(r8), intent(in) :: tl_vstr(LBi:,LBj:,:,:)
102# endif
103# if defined ADJUST_STFLUX && defined SOLVE3D
104 real(r8), intent(inout) :: tl_tflux(LBi:,LBj:,:,:,:)
105# endif
106# ifdef ADJUST_WSTRESS
107 real(r8), intent(inout) :: tl_sustr(LBi:,LBj:)
108 real(r8), intent(inout) :: tl_svstr(LBi:,LBj:)
109# endif
110# if defined ADJUST_STFLUX && defined SOLVE3D
111 real(r8), intent(inout) :: tl_stflx(LBi:,LBj:,:)
112# endif
113# else
114# ifdef ADJUST_WSTRESS
115 real(r8), intent(in) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
116 real(r8), intent(in) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
117# endif
118# if defined ADJUST_STFLUX && defined SOLVE3D
119 real(r8), intent(in) :: tl_tflux(LBi:UBi,LBj:UBj, &
120 & Nfrec(ng),2,NT(ng))
121# endif
122# ifdef ADJUST_WSTRESS
123 real(r8), intent(inout) :: tl_sustr(LBi:UBi,LBj:UBj)
124 real(r8), intent(inout) :: tl_svstr(LBi:UBi,LBj:UBj)
125# endif
126# if defined ADJUST_STFLUX && defined SOLVE3D
127 real(r8), intent(inout) :: tl_stflx(LBi:UBi,LBj:UBj,NT(ng))
128# endif
129# endif
130!
131! Local variable declarations.
132!
133 integer :: i, it1, it2, j
134# ifdef SOLVE3D
135 integer :: itrc
136# endif
137 real(r8) :: fac, fac1, fac2
138
139# include "set_bounds.h"
140!
141!-----------------------------------------------------------------------
142! Adjust tangent linear surface forcing fields with 4DVar increments.
143!-----------------------------------------------------------------------
144!
145! Set time records and interpolation factor, if any.
146!
147 IF (nfrec(ng).eq.1) THEN
148 it1=1
149 it2=1
150 fac1=1.0_r8
151 fac2=0.0_r8
152 ELSE
153# ifdef GENERIC_DSTART
154 it1=max(0,(iic(ng)-ntstart(ng))/nsff(ng))+1
155# else
156 it1=max(0,(iic(ng)-1)/nsff(ng))+1
157# endif
158 it2=min(it1+1,nfrec(ng))
159 fac1=sf_time(it2,ng)-(time(ng)+dt(ng))
160 fac2=(time(ng)+dt(ng))-sf_time(it1,ng)
161 fac=1.0_r8/(fac1+fac2)
162 fac1=fac*fac1
163 fac2=fac*fac2
164 END IF
165
166# ifdef ADJUST_WSTRESS
167!
168! Adjust surface wind stress. Interpolate between surface forcing
169! increments, if appropriate.
170!
171 DO j=jstrr,jendr
172 DO i=istr,iendr
173 tl_sustr(i,j)=fac1*tl_ustr(i,j,it1,linp)+ &
174 & fac2*tl_ustr(i,j,it2,linp)
175 END DO
176 END DO
177 DO j=jstr,jendr
178 DO i=istrr,iendr
179 tl_svstr(i,j)=fac1*tl_vstr(i,j,it1,linp)+ &
180 & fac2*tl_vstr(i,j,it2,linp)
181 END DO
182 END DO
183# endif
184# if defined ADJUST_STFLUX && defined SOLVE3D
185!
186! Adjust surface tracer fluxes. Interpolate between surface forcing
187! increments, if appropriate.
188!
189 IF (lstflux(itemp,ng)) THEN
190# ifdef QCORRECTION
191 DO j=jstrr,jendr
192 DO i=istrr,iendr
193 tl_stflx(i,j,itemp)=tl_stflx(i,j,itemp)+ &
194 & fac1*tl_tflux(i,j,it1,linp,itemp)+ &
195 & fac2*tl_tflux(i,j,it2,linp,itemp)
196 END DO
197 END DO
198# else
199 DO j=jstrr,jendr
200 DO i=istrr,iendr
201 tl_stflx(i,j,itemp)=fac1*tl_tflux(i,j,it1,linp,itemp)+ &
202 & fac2*tl_tflux(i,j,it2,linp,itemp)
203 END DO
204 END DO
205# endif
206 END IF
207
208# ifdef SALINITY
209 IF (lstflux(isalt,ng)) THEN
210 DO j=jstrr,jendr
211 DO i=istrr,iendr
212 tl_stflx(i,j,isalt)=tl_stflx(i,j,isalt)+ &
213 & fac1*tl_tflux(i,j,it1,linp,isalt)+ &
214 & fac2*tl_tflux(i,j,it2,linp,isalt)
215 END DO
216 END DO
217 END IF
218# endif
219
220 DO itrc=nat+1,nt(ng)
221 IF (lstflux(itrc,ng)) THEN
222 DO j=jstrr,jendr
223 DO i=istrr,iendr
224 tl_stflx(i,j,itrc)=fac1*tl_tflux(i,j,it1,linp,itrc)+ &
225 & fac2*tl_tflux(i,j,it2,linp,itrc)
226 END DO
227 END DO
228 END IF
229 END DO
230# endif
231!
232 RETURN
mod_param::nat
integer nat
Definition mod_param.F:499
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_scalars
Definition mod_scalars.F:2
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::lstflux
logical, dimension(:,:), allocatable lstflux
Definition mod_scalars.F:1156
mod_scalars::nfrec
integer, dimension(:), allocatable nfrec
Definition mod_scalars.F:1148
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::nsff
integer, dimension(:), allocatable nsff
Definition mod_scalars.F:1147
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_scalars::sf_time
real(dp), dimension(:,:), allocatable sf_time
Definition mod_scalars.F:1162

References mod_scalars::dt, mod_scalars::iic, mod_scalars::isalt, mod_scalars::itemp, mod_scalars::lstflux, mod_param::nat, mod_scalars::nsff, mod_scalars::ntstart, mod_scalars::sf_time, and mod_scalars::time.

Referenced by tl_frc_adjust().

Here is the caller graph for this function: