1 |
|
C $Header$ |
2 |
|
C $Name$ |
3 |
|
|
4 |
#include "CTRL_CPPOPTIONS.h" |
#include "CTRL_CPPOPTIONS.h" |
5 |
#ifdef ALLOW_OBCS |
#ifdef ALLOW_OBCS |
109 |
|
|
110 |
if (optimcycle .ge. 0) then |
if (optimcycle .ge. 0) then |
111 |
ilobcsw=ilnblnk( xx_obcsw_file ) |
ilobcsw=ilnblnk( xx_obcsw_file ) |
112 |
write(fnameobcsw(1:80),'(2a,i10.10)') |
write(fnameobcsw(1:80),'(2a,i10.10)') |
113 |
& xx_obcsw_file(1:ilobcsw), '.', optimcycle |
& xx_obcsw_file(1:ilobcsw), '.', optimcycle |
114 |
endif |
endif |
115 |
|
|
122 |
|
|
123 |
do iobcs = 1,nobcs |
do iobcs = 1,nobcs |
124 |
if ( obcswfirst ) then |
if ( obcswfirst ) then |
125 |
call active_read_yz_loc( fnameobcsw, tmpfldyz, |
call active_read_yz( fnameobcsw, tmpfldyz, |
126 |
& (obcswcount0-1)*nobcs+iobcs, |
& (obcswcount0-1)*nobcs+iobcs, |
127 |
& doglobalread, ladinit, optimcycle, |
& doglobalread, ladinit, optimcycle, |
128 |
& mythid, xx_obcsw_dummy ) |
& mythid, xx_obcsw_dummy ) |
129 |
|
|
130 |
if ( optimcycle .gt. 0) then |
#ifdef ALLOW_CTRL_OBCS_BALANCE |
131 |
|
|
132 |
|
if ( optimcycle .gt. 0) then |
133 |
if (iobcs .eq. 3) then |
if (iobcs .eq. 3) then |
134 |
cgg Special attention is needed for the normal velocity. |
cgg Special attention is needed for the normal velocity. |
135 |
cgg For the north, this is the v velocity, iobcs = 4. |
cgg For the north, this is the v velocity, iobcs = 4. |
146 |
|
|
147 |
do k = 1,Nr |
do k = 1,Nr |
148 |
cgg If cells are not full, this should be modified with hFac. |
cgg If cells are not full, this should be modified with hFac. |
149 |
cgg |
cgg |
150 |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
151 |
cgg surface level. This velocity is not independent; it must |
cgg surface level. This velocity is not independent; it must |
152 |
cgg exactly balance the volume flux, since we are dealing with |
cgg exactly balance the volume flux, since we are dealing with |
153 |
cgg the baroclinic velocity structure.. |
cgg the baroclinic velocity structure.. |
154 |
utop = tmpfldyz(j,k,bi,bj)* |
utop = tmpfldyz(j,k,bi,bj)* |
155 |
& maskW(i+ip1,j,k,bi,bj) * delR(k) + utop |
& maskW(i+ip1,j,k,bi,bj) * delR(k) + utop |
156 |
cgg Add the barotropic velocity component. |
cgg Add the barotropic velocity component. |
157 |
if (maskW(i+ip1,j,k,bi,bj) .ne. 0.) then |
if (maskW(i+ip1,j,k,bi,bj) .ne. 0.) then |
158 |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
159 |
endif |
endif |
160 |
enddo |
enddo |
161 |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
162 |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
163 |
& - utop / delR(1) |
& - utop / delR(1) |
164 |
enddo |
enddo |
165 |
enddo |
enddo |
181 |
|
|
182 |
do k = 1,Nr |
do k = 1,Nr |
183 |
cgg If cells are not full, this should be modified with hFac. |
cgg If cells are not full, this should be modified with hFac. |
184 |
cgg |
cgg |
185 |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
186 |
cgg surface level. This velocity is not independent; it must |
cgg surface level. This velocity is not independent; it must |
187 |
cgg exactly balance the volume flux, since we are dealing with |
cgg exactly balance the volume flux, since we are dealing with |
188 |
cgg the baroclinic velocity structure.. |
cgg the baroclinic velocity structure.. |
189 |
utop = tmpfldyz(j,k,bi,bj)* |
utop = tmpfldyz(j,k,bi,bj)* |
190 |
& maskS(i,j,k,bi,bj) * delR(k) + utop |
& maskS(i,j,k,bi,bj) * delR(k) + utop |
191 |
cgg Add the barotropic velocity component. |
cgg Add the barotropic velocity component. |
192 |
if (maskS(i,j,k,bi,bj) .ne. 0.) then |
if (maskS(i,j,k,bi,bj) .ne. 0.) then |
193 |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
194 |
endif |
endif |
195 |
enddo |
enddo |
196 |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
197 |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
198 |
& - utop / delR(1) |
& - utop / delR(1) |
199 |
enddo |
enddo |
200 |
enddo |
enddo |
202 |
endif |
endif |
203 |
endif |
endif |
204 |
|
|
205 |
|
#endif /* ALLOW_CTRL_OBCS_BALANCE */ |
206 |
|
|
207 |
do bj = jtlo,jthi |
do bj = jtlo,jthi |
208 |
do bi = itlo,ithi |
do bi = itlo,ithi |
209 |
do k = 1,nr |
do k = 1,nr |
217 |
endif |
endif |
218 |
|
|
219 |
if ( (obcswfirst) .or. (obcswchanged)) then |
if ( (obcswfirst) .or. (obcswchanged)) then |
|
|
|
|
cgg( This is a terribly long way to do it. However, the dimensions do not exactly |
|
|
cgg match up. I will blame Fortran for the ugliness. |
|
220 |
|
|
221 |
do bj = jtlo,jthi |
do bj = jtlo,jthi |
222 |
do bi = itlo,ithi |
do bi = itlo,ithi |
223 |
do k = 1,nr |
do k = 1,nr |
224 |
do j = jmin,jmax |
do j = jmin,jmax |
225 |
tmpfldyz(j,k,bi,bj) = xx_obcsw1(j,k,bi,bj,iobcs) |
xx_obcsw0(j,k,bi,bj,iobcs) = xx_obcsw1(j,k,bi,bj,iobcs) |
226 |
enddo |
tmpfldyz (j,k,bi,bj) = 0. _d 0 |
227 |
enddo |
enddo |
228 |
enddo |
enddo |
229 |
|
enddo |
230 |
enddo |
enddo |
231 |
|
|
232 |
call exf_swapffields_yz( tmpfldyz2, tmpfldyz, mythid) |
call active_read_yz( fnameobcsw, tmpfldyz, |
|
|
|
|
do bj = jtlo,jthi |
|
|
do bi = itlo,ithi |
|
|
do k = 1,nr |
|
|
do j = jmin,jmax |
|
|
xx_obcsw0(j,k,bi,bj,iobcs) = tmpfldyz2(j,k,bi,bj) |
|
|
enddo |
|
|
enddo |
|
|
enddo |
|
|
enddo |
|
|
|
|
|
call active_read_yz_loc( fnameobcsw, tmpfldyz, |
|
233 |
& (obcswcount1-1)*nobcs+iobcs, |
& (obcswcount1-1)*nobcs+iobcs, |
234 |
& doglobalread, ladinit, optimcycle, |
& doglobalread, ladinit, optimcycle, |
235 |
& mythid, xx_obcsw_dummy ) |
& mythid, xx_obcsw_dummy ) |
236 |
|
|
237 |
if ( optimcycle .gt. 0) then |
#ifdef ALLOW_CTRL_OBCS_BALANCE |
238 |
|
|
239 |
|
if ( optimcycle .gt. 0) then |
240 |
if (iobcs .eq. 3) then |
if (iobcs .eq. 3) then |
241 |
cgg Special attention is needed for the normal velocity. |
cgg Special attention is needed for the normal velocity. |
242 |
cgg For the north, this is the v velocity, iobcs = 4. |
cgg For the north, this is the v velocity, iobcs = 4. |
253 |
|
|
254 |
do k = 1,Nr |
do k = 1,Nr |
255 |
cgg If cells are not full, this should be modified with hFac. |
cgg If cells are not full, this should be modified with hFac. |
256 |
cgg |
cgg |
257 |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
258 |
cgg surface level. This velocity is not independent; it must |
cgg surface level. This velocity is not independent; it must |
259 |
cgg exactly balance the volume flux, since we are dealing with |
cgg exactly balance the volume flux, since we are dealing with |
260 |
cgg the baroclinic velocity structure.. |
cgg the baroclinic velocity structure.. |
261 |
utop = tmpfldyz(j,k,bi,bj)* |
utop = tmpfldyz(j,k,bi,bj)* |
262 |
& maskW(i+ip1,j,k,bi,bj) * delR(k) + utop |
& maskW(i+ip1,j,k,bi,bj) * delR(k) + utop |
263 |
cgg Add the barotropic velocity component. |
cgg Add the barotropic velocity component. |
264 |
if (maskW(i+ip1,j,k,bi,bj) .ne. 0.) then |
if (maskW(i+ip1,j,k,bi,bj) .ne. 0.) then |
265 |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
266 |
endif |
endif |
267 |
enddo |
enddo |
268 |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
269 |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
270 |
& - utop / delR(1) |
& - utop / delR(1) |
271 |
enddo |
enddo |
272 |
enddo |
enddo |
288 |
|
|
289 |
do k = 1,Nr |
do k = 1,Nr |
290 |
cgg If cells are not full, this should be modified with hFac. |
cgg If cells are not full, this should be modified with hFac. |
291 |
cgg |
cgg |
292 |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
cgg The xx field (tmpfldxz) does not contain the velocity at the |
293 |
cgg surface level. This velocity is not independent; it must |
cgg surface level. This velocity is not independent; it must |
294 |
cgg exactly balance the volume flux, since we are dealing with |
cgg exactly balance the volume flux, since we are dealing with |
295 |
cgg the baroclinic velocity structure.. |
cgg the baroclinic velocity structure.. |
296 |
utop = tmpfldyz(j,k,bi,bj)* |
utop = tmpfldyz(j,k,bi,bj)* |
297 |
& maskS(i,j,k,bi,bj) * delR(k) + utop |
& maskS(i,j,k,bi,bj) * delR(k) + utop |
298 |
cgg Add the barotropic velocity component. |
cgg Add the barotropic velocity component. |
299 |
if (maskS(i,j,k,bi,bj) .ne. 0.) then |
if (maskS(i,j,k,bi,bj) .ne. 0.) then |
300 |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
tmpfldyz(j,k,bi,bj) = tmpfldyz(j,k,bi,bj)+ ubaro |
301 |
endif |
endif |
302 |
enddo |
enddo |
303 |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
cgg Compute the baroclinic velocity at level 1. Should balance flux. |
304 |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
tmpfldyz(j,1,bi,bj) = tmpfldyz(j,1,bi,bj) |
305 |
& - utop / delR(1) |
& - utop / delR(1) |
306 |
enddo |
enddo |
307 |
enddo |
enddo |
309 |
endif |
endif |
310 |
endif |
endif |
311 |
|
|
312 |
|
#endif /* ALLOW_CTRL_OBCS_BALANCE */ |
313 |
|
|
314 |
do bj = jtlo,jthi |
do bj = jtlo,jthi |
315 |
do bi = itlo,ithi |
do bi = itlo,ithi |
316 |
do k = 1,nr |
do k = 1,nr |