source: codes/icosagcm/trunk/src/kernels/pvort_only.k90 @ 580

Last change on this file since 580 was 580, checked in by dubos, 7 years ago

trunk : upgrading to devel
File size: 1.5 KB
Line 
1   !--------------------------------------------------------------------------
2   !---------------------------- pvort_only ----------------------------------
3   DO l = ll_begin, ll_end
4      !DIR$ SIMD
5      DO ij=ij_begin_ext, ij_end_ext
6         etav = 0.d0
7         etav = etav + ne_rup*u(ij+u_rup,l)
8         etav = etav + ne_left*u(ij+t_rup+u_left,l)
9         etav = etav + (-ne_lup)*u(ij+u_lup,l)
10         hv=0.
11         hv = hv + Riv2(ij,vup)*rhodz(ij,l)
12         hv = hv + Riv2(ij+t_rup,vldown)*rhodz(ij+t_rup,l)
13         hv = hv + Riv2(ij+t_lup,vrdown)*rhodz(ij+t_lup,l)
14         qv(ij+z_up,l) = (etav + fv(ij+z_up)*Av(ij+z_up) )/(hv*Av(ij+z_up))
15         etav = 0.d0
16         etav = etav + (-ne_rdown)*u(ij+u_rdown,l)
17         etav = etav + ne_right*u(ij+t_ldown+u_right,l)
18         etav = etav + ne_ldown*u(ij+u_ldown,l)
19         hv=0.
20         hv = hv + Riv2(ij,vdown)*rhodz(ij,l)
21         hv = hv + Riv2(ij+t_ldown,vrup)*rhodz(ij+t_ldown,l)
22         hv = hv + Riv2(ij+t_rdown,vlup)*rhodz(ij+t_rdown,l)
23         qv(ij+z_down,l) = (etav + fv(ij+z_down)*Av(ij+z_down) )/(hv*Av(ij+z_down))
24      END DO
25   END DO
26   DO l = ll_begin, ll_end
27      !DIR$ SIMD
28      DO ij=ij_begin, ij_end
29         qu(ij+u_right,l)=0.5d0*(qv(ij+z_rdown,l)+qv(ij+z_rup,l))
30         qu(ij+u_lup,l)=0.5d0*(qv(ij+z_up,l)+qv(ij+z_lup,l))
31         qu(ij+u_ldown,l)=0.5d0*(qv(ij+z_ldown,l)+qv(ij+z_down,l))
32      END DO
33   END DO
34   !---------------------------- pvort_only ----------------------------------
35   !--------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.