ROMS
Loading...
Searching...
No Matches
uv_rotate.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE uv_rotate_mod
3!
4!git $Id$
5!=======================================================================
6! Copyright (c) 2002-2025 The ROMS Group !
7! Licensed under a MIT/X style license !
8! See License_ROMS.md Hernan G. Arango !
9!=======================================================================
10! !
11! These routines average momentum component to RHO-points and then !
12! rotates from (XI,ETA) coordinates to geographical Eastward and !
13! Northward directions. !
14! !
15!=======================================================================
16!
17 implicit none
18!
19 PRIVATE
20 PUBLIC :: uv_rotate2d
21#ifdef SOLVE3D
22 PUBLIC :: uv_rotate3d
23#endif
24!
25 CONTAINS
26!
27!***********************************************************************
28 SUBROUTINE uv_rotate2d (ng, tile, add, Lboundary, &
29 & LBi, UBi, LBj, UBj, &
30 & CosAngler, SinAngler, &
31#ifdef MASKING
32 & rmask_full, &
33#endif
34 & Uinp, Vinp, Uout, Vout)
35!***********************************************************************
36!
37 USE mod_param
38 USE mod_scalars
39!
40 USE exchange_2d_mod, ONLY : exchange_r2d_tile
41#ifdef DISTRIBUTE
42 USE mp_exchange_mod, ONLY : mp_exchange2d
43#endif
44!
45! Imported variable declarations.
46!
47 logical, intent(in) :: add, lboundary
48
49 integer, intent(in) :: ng, tile
50 integer, intent(in) :: lbi, ubi, lbj, ubj
51!
52#ifdef ASSUMED_SHAPE
53 real(r8), intent(in) :: cosangler(lbi:,lbj:)
54 real(r8), intent(in) :: sinangler(lbi:,lbj:)
55# ifdef MASKING
56 real(r8), intent(in) :: rmask_full(lbi:,lbj:)
57# endif
58 real(r8), intent(in) :: uinp(lbi:,lbj:)
59 real(r8), intent(in) :: vinp(lbi:,lbj:)
60
61 real(r8), intent(inout) :: uout(lbi:,lbj:)
62 real(r8), intent(inout) :: vout(lbi:,lbj:)
63#else
64 real(r8), intent(in) :: cosangler(lbi:ubi,lbj:ubj)
65 real(r8), intent(in) :: sinangler(lbi:ubi,lbj:ubj)
66# ifdef MASKING
67 real(r8), intent(in) :: rmask_full(lbi:ubi,lbj:ubj)
68# endif
69 real(r8), intent(in) :: uinp(lbi:ubi,lbj:ubj)
70 real(r8), intent(in) :: vinp(lbi:ubi,lbj:ubj)
71
72 real(r8), intent(inout) :: uout(lbi:ubi,lbj:ubj)
73 real(r8), intent(inout) :: vout(lbi:ubi,lbj:ubj)
74#endif
75!
76! Local variable declarations.
77!
78 integer :: i, j
79
80 real(r8) :: urho, vrho
81
82# include "set_bounds.h"
83!
84!-----------------------------------------------------------------------
85! Rotate 2D vector components to Eastward and Northward directions.
86!-----------------------------------------------------------------------
87!
88 IF (add) THEN
89 DO j=jstr,jend
90 DO i=istr,iend
91 urho=0.5_r8*(uinp(i,j)+uinp(i+1,j))
92 vrho=0.5_r8*(vinp(i,j)+vinp(i,j+1))
93 uout(i,j)=uout(i,j)+ &
94 & urho*cosangler(i,j)- &
95 & vrho*sinangler(i,j)
96 vout(i,j)=vout(i,j)+ &
97 & vrho*cosangler(i,j)+ &
98 & urho*sinangler(i,j)
99#ifdef MASKING
100 uout(i,j)=uout(i,j)*rmask_full(i,j)
101 vout(i,j)=vout(i,j)*rmask_full(i,j)
102#endif
103 END DO
104 END DO
105 ELSE
106 DO j=jstr,jend
107 DO i=istr,iend
108 urho=0.5_r8*(uinp(i,j)+uinp(i+1,j))
109 vrho=0.5_r8*(vinp(i,j)+vinp(i,j+1))
110 uout(i,j)=urho*cosangler(i,j)- &
111 & vrho*sinangler(i,j)
112 vout(i,j)=vrho*cosangler(i,j)+ &
113 & urho*sinangler(i,j)
114#ifdef MASKING
115 uout(i,j)=uout(i,j)*rmask_full(i,j)
116 vout(i,j)=vout(i,j)*rmask_full(i,j)
117#endif
118 END DO
119 END DO
120 END IF
121!
122! Exchange boundary data, if applicable.
123!
124 IF (lboundary) THEN
125 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
126 CALL exchange_r2d_tile (ng, tile, &
127 & lbi, ubi, lbj, ubj, &
128 & uout)
129 CALL exchange_r2d_tile (ng, tile, &
130 & lbi, ubi, lbj, ubj, &
131 & vout)
132#ifdef DISTRIBUTE
133 CALL mp_exchange2d (ng, tile, inlm, 2, &
134 & lbi, ubi, lbj, ubj, &
135 & nghostpoints, &
136 & ewperiodic(ng), nsperiodic(ng), &
137 & uout, vout)
138#endif
139 END IF
140 END IF
141
142 RETURN
143 END SUBROUTINE uv_rotate2d
144
145#ifdef SOLVE3D
146!
147!***********************************************************************
148 SUBROUTINE uv_rotate3d (ng, tile, add, Lboundary, &
149 & LBi, UBi, LBj, UBj, LBk, UBk, &
150 & CosAngler, SinAngler, &
151# ifdef MASKING
152 & rmask_full, &
153# endif
154 & Uinp, Vinp, Uout, Vout)
155!***********************************************************************
156!
157 USE mod_param
158 USE mod_scalars
159!
160 USE exchange_3d_mod, ONLY : exchange_r3d_tile
161# ifdef DISTRIBUTE
162 USE mp_exchange_mod, ONLY : mp_exchange3d
163# endif
164!
165! Imported variable declarations.
166!
167 logical, intent(in) :: add, lboundary
168
169 integer, intent(in) :: ng, tile
170 integer, intent(in) :: lbi, ubi, lbj, ubj, lbk, ubk
171!
172# ifdef ASSUMED_SHAPE
173 real(r8), intent(in) :: cosangler(lbi:,lbj:)
174 real(r8), intent(in) :: sinangler(lbi:,lbj:)
175# ifdef MASKING
176 real(r8), intent(in) :: rmask_full(lbi:,lbj:)
177# endif
178 real(r8), intent(in) :: uinp(lbi:,lbj:,lbk:)
179 real(r8), intent(in) :: vinp(lbi:,lbj:,lbk:)
180
181 real(r8), intent(inout) :: uout(lbi:,lbj:,lbk:)
182 real(r8), intent(inout) :: vout(lbi:,lbj:,lbk:)
183# else
184 real(r8), intent(in) :: cosangler(lbi:ubi,lbj:ubj)
185 real(r8), intent(in) :: sinangler(lbi:ubi,lbj:ubj)
186# ifdef MASKING
187 real(r8), intent(in) :: rmask_full(lbi:ubi,lbj:ubj)
188# endif
189 real(r8), intent(in) :: uinp(lbi:ubi,lbj:ubj,lbk:ubk)
190 real(r8), intent(in) :: vinp(lbi:ubi,lbj:ubj,lbk:ubk)
191
192 real(r8), intent(inout) :: uout(lbi:ubi,lbj:ubj,lbk:ubk)
193 real(r8), intent(inout) :: vout(lbi:ubi,lbj:ubj,lbk:ubk)
194# endif
195!
196! Local variable declarations.
197!
198 integer :: i, j, k
199
200 real(r8) :: urho, vrho
201
202# include "set_bounds.h"
203!
204!-----------------------------------------------------------------------
205! Rotate 3D vector components to Eastward and Northward directions.
206!-----------------------------------------------------------------------
207!
208 IF (add) THEN
209 DO k=lbk,ubk
210 DO j=jstr,jend
211 DO i=istr,iend
212 urho=0.5_r8*(uinp(i,j,k)+uinp(i+1,j,k))
213 vrho=0.5_r8*(vinp(i,j,k)+vinp(i,j+1,k))
214 uout(i,j,k)=uout(i,j,k)+ &
215 & urho*cosangler(i,j)- &
216 & vrho*sinangler(i,j)
217 vout(i,j,k)=vout(i,j,k)+ &
218 & vrho*cosangler(i,j)+ &
219 & urho*sinangler(i,j)
220# ifdef MASKING
221 uout(i,j,k)=uout(i,j,k)*rmask_full(i,j)
222 vout(i,j,k)=vout(i,j,k)*rmask_full(i,j)
223# endif
224 END DO
225 END DO
226 END DO
227 ELSE
228 DO k=lbk,ubk
229 DO j=jstr,jend
230 DO i=istr,iend
231 urho=0.5_r8*(uinp(i,j,k)+uinp(i+1,j,k))
232 vrho=0.5_r8*(vinp(i,j,k)+vinp(i,j+1,k))
233 uout(i,j,k)=urho*cosangler(i,j)- &
234 & vrho*sinangler(i,j)
235 vout(i,j,k)=vrho*cosangler(i,j)+ &
236 & urho*sinangler(i,j)
237# ifdef MASKING
238 uout(i,j,k)=uout(i,j,k)*rmask_full(i,j)
239 vout(i,j,k)=vout(i,j,k)*rmask_full(i,j)
240# endif
241 END DO
242 END DO
243 END DO
244 END IF
245!
246! Exchange boundary data.
247!
248 IF (lboundary) THEN
249 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
250 CALL exchange_r3d_tile (ng, tile, &
251 & lbi, ubi, lbj, ubj, lbk, ubk, &
252 & uout)
253 CALL exchange_r3d_tile (ng, tile, &
254 & lbi, ubi, lbj, ubj, lbk, ubk, &
255 & vout)
256# ifdef DISTRIBUTE
257 CALL mp_exchange3d (ng, tile, inlm, 2, &
258 & lbi, ubi, lbj, ubj, lbk, ubk, &
259 & nghostpoints, &
260 & ewperiodic(ng), nsperiodic(ng), &
261 & uout, vout)
262# endif
263 END IF
264 END IF
265
266 RETURN
267 END SUBROUTINE uv_rotate3d
268#endif
269 END MODULE uv_rotate_mod
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
exchange_3d_mod
Definition exchange_3d.F:2
exchange_3d_mod::exchange_r3d_tile
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:283
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037
uv_rotate_mod
Definition uv_rotate.F:2
uv_rotate_mod::uv_rotate3d
subroutine, public uv_rotate3d(ng, tile, add, lboundary, lbi, ubi, lbj, ubj, lbk, ubk, cosangler, sinangler, rmask_full, uinp, vinp, uout, vout)
Definition uv_rotate.F:155
uv_rotate_mod::uv_rotate2d
subroutine, public uv_rotate2d(ng, tile, add, lboundary, lbi, ubi, lbj, ubj, cosangler, sinangler, rmask_full, uinp, vinp, uout, vout)
Definition uv_rotate.F:35