source: trunk/Roms_agrif/step3d_uv1.F

Last change on this file was 3, checked in by pinsard, 17 years ago

add Roms_agrif level (forgot in changeset:2)

File size: 1.5 KB
Line 
1!
2! $Id: step3d_uv1.F,v 1.2 2003/12/17 13:56:07 pmarches Exp $
3!
4#include "cppdefs.h"
5#ifdef SOLVE3D
6      subroutine step3d_uv1 (tile)
7      implicit none
8      integer tile, trd, omp_get_thread_num
9# include "param.h"
10# include "private_scratch.h"
11# include "compute_tile_bounds.h"
12      trd=omp_get_thread_num()
13      call step3d_uv1_tile (Istr,Iend,Jstr,Jend,  A3d(1,1,trd),
14     &                               A3d(1,2,trd), A2d(1,1,trd))
15      return
16      end
17
18      subroutine step3d_uv1_tile (Istr,Iend,Jstr,Jend, ru,rv,DC)
19      implicit none
20      integer Istr,Iend,Jstr,Jend, i,j,k
21# include "param.h"
22      real ru(PRIVATE_2D_SCRATCH_ARRAY,N),
23     &     rv(PRIVATE_2D_SCRATCH_ARRAY,N),
24     &     DC(PRIVATE_1D_SCRATCH_ARRAY,0:N),  cff
25# include "grid.h"
26# include "ocean3d.h"
27# include "scalars.h"
28!
29# include "compute_auxiliary_bounds.h"
30!
31      cff=0.25*dt
32      do j=Jstr,Jend
33        do i=IstrU,Iend
34          DC(i,0)=cff*(pm(i,j)+pm(i-1,j))*(pn(i,j)+pn(i-1,j))
35        enddo
36        do k=1,N
37          do i=IstrU,Iend
38            u(i,j,k,nnew)=u(i,j,k,nnew)+DC(i,0)*ru(i,j,k)
39          enddo
40        enddo
41        if (j.ge.JstrV) then
42          do i=Istr,Iend
43            DC(i,0)=cff*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
44          enddo
45          do k=1,N
46            do i=Istr,Iend
47              v(i,j,k,nnew)=v(i,j,k,nnew)+DC(i,0)*rv(i,j,k)
48            enddo
49          enddo
50        endif
51      enddo 
52#else
53      subroutine step3d_uv1_empty
54#endif
55      return
56      end
Note: See TracBrowser for help on using the repository browser.