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

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

trunk : upgrading to devel
File size: 5.3 KB
Line 
1   !--------------------------------------------------------------------------
2   !---------------------------- coriolis ----------------------------------
3   !
4   DO iq=1,nqdyn
5      DO l = ll_begin, ll_end
6         !DIR$ SIMD
7         DO ij=ij_begin_ext, ij_end_ext
8            Ftheta(ij+u_right,l) = .5*(theta(ij,l,iq)+theta(ij+t_right,l,iq))*hflux(ij+u_right,l)
9            Ftheta(ij+u_lup,l) = .5*(theta(ij,l,iq)+theta(ij+t_lup,l,iq))*hflux(ij+u_lup,l)
10            Ftheta(ij+u_ldown,l) = .5*(theta(ij,l,iq)+theta(ij+t_ldown,l,iq))*hflux(ij+u_ldown,l)
11         END DO
12      END DO
13      DO l = ll_begin, ll_end
14         !DIR$ SIMD
15         DO ij=ij_begin, ij_end
16            divF=0.
17            divF = divF + Ftheta(ij+u_rup,l)*ne_rup
18            divF = divF + Ftheta(ij+u_lup,l)*ne_lup
19            divF = divF + Ftheta(ij+u_left,l)*ne_left
20            divF = divF + Ftheta(ij+u_ldown,l)*ne_ldown
21            divF = divF + Ftheta(ij+u_rdown,l)*ne_rdown
22            divF = divF + Ftheta(ij+u_right,l)*ne_right
23            dtheta_rhodz(ij,l,iq) = -divF / Ai(ij)
24         END DO
25      END DO
26   END DO ! iq
27   !
28   DO l = ll_begin, ll_end
29      !DIR$ SIMD
30      DO ij=ij_begin, ij_end
31         divF=0.
32         divF = divF + hflux(ij+u_rup,l)*ne_rup
33         divF = divF + hflux(ij+u_lup,l)*ne_lup
34         divF = divF + hflux(ij+u_left,l)*ne_left
35         divF = divF + hflux(ij+u_ldown,l)*ne_ldown
36         divF = divF + hflux(ij+u_rdown,l)*ne_rdown
37         divF = divF + hflux(ij+u_right,l)*ne_right
38         convm(ij,l) = -divF / Ai(ij)
39      END DO
40   END DO
41   !
42   DO l = ll_begin, ll_end
43      !DIR$ SIMD
44      DO ij=ij_begin, ij_end
45         du_trisk=0.
46         du_trisk = du_trisk + wee(ij+u_right,1,1)*hflux(ij+u_rup,l)*(qu(ij+u_right,l)+qu(ij+u_rup,l))
47         du_trisk = du_trisk + wee(ij+u_right,2,1)*hflux(ij+u_lup,l)*(qu(ij+u_right,l)+qu(ij+u_lup,l))
48         du_trisk = du_trisk + wee(ij+u_right,3,1)*hflux(ij+u_left,l)*(qu(ij+u_right,l)+qu(ij+u_left,l))
49         du_trisk = du_trisk + wee(ij+u_right,4,1)*hflux(ij+u_ldown,l)*(qu(ij+u_right,l)+qu(ij+u_ldown,l))
50         du_trisk = du_trisk + wee(ij+u_right,5,1)*hflux(ij+u_rdown,l)*(qu(ij+u_right,l)+qu(ij+u_rdown,l))
51         du_trisk = du_trisk + wee(ij+u_right,1,2)*hflux(ij+t_right+u_ldown,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_ldown,l))
52         du_trisk = du_trisk + wee(ij+u_right,2,2)*hflux(ij+t_right+u_rdown,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_rdown,l))
53         du_trisk = du_trisk + wee(ij+u_right,3,2)*hflux(ij+t_right+u_right,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_right,l))
54         du_trisk = du_trisk + wee(ij+u_right,4,2)*hflux(ij+t_right+u_rup,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_rup,l))
55         du_trisk = du_trisk + wee(ij+u_right,5,2)*hflux(ij+t_right+u_lup,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_lup,l))
56         du(ij+u_right,l) = du(ij+u_right,l) + .5*du_trisk
57         du_trisk=0.
58         du_trisk = du_trisk + wee(ij+u_lup,1,1)*hflux(ij+u_left,l)*(qu(ij+u_lup,l)+qu(ij+u_left,l))
59         du_trisk = du_trisk + wee(ij+u_lup,2,1)*hflux(ij+u_ldown,l)*(qu(ij+u_lup,l)+qu(ij+u_ldown,l))
60         du_trisk = du_trisk + wee(ij+u_lup,3,1)*hflux(ij+u_rdown,l)*(qu(ij+u_lup,l)+qu(ij+u_rdown,l))
61         du_trisk = du_trisk + wee(ij+u_lup,4,1)*hflux(ij+u_right,l)*(qu(ij+u_lup,l)+qu(ij+u_right,l))
62         du_trisk = du_trisk + wee(ij+u_lup,5,1)*hflux(ij+u_rup,l)*(qu(ij+u_lup,l)+qu(ij+u_rup,l))
63         du_trisk = du_trisk + wee(ij+u_lup,1,2)*hflux(ij+t_lup+u_right,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_right,l))
64         du_trisk = du_trisk + wee(ij+u_lup,2,2)*hflux(ij+t_lup+u_rup,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_rup,l))
65         du_trisk = du_trisk + wee(ij+u_lup,3,2)*hflux(ij+t_lup+u_lup,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_lup,l))
66         du_trisk = du_trisk + wee(ij+u_lup,4,2)*hflux(ij+t_lup+u_left,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_left,l))
67         du_trisk = du_trisk + wee(ij+u_lup,5,2)*hflux(ij+t_lup+u_ldown,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_ldown,l))
68         du(ij+u_lup,l) = du(ij+u_lup,l) + .5*du_trisk
69         du_trisk=0.
70         du_trisk = du_trisk + wee(ij+u_ldown,1,1)*hflux(ij+u_rdown,l)*(qu(ij+u_ldown,l)+qu(ij+u_rdown,l))
71         du_trisk = du_trisk + wee(ij+u_ldown,2,1)*hflux(ij+u_right,l)*(qu(ij+u_ldown,l)+qu(ij+u_right,l))
72         du_trisk = du_trisk + wee(ij+u_ldown,3,1)*hflux(ij+u_rup,l)*(qu(ij+u_ldown,l)+qu(ij+u_rup,l))
73         du_trisk = du_trisk + wee(ij+u_ldown,4,1)*hflux(ij+u_lup,l)*(qu(ij+u_ldown,l)+qu(ij+u_lup,l))
74         du_trisk = du_trisk + wee(ij+u_ldown,5,1)*hflux(ij+u_left,l)*(qu(ij+u_ldown,l)+qu(ij+u_left,l))
75         du_trisk = du_trisk + wee(ij+u_ldown,1,2)*hflux(ij+t_ldown+u_lup,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_lup,l))
76         du_trisk = du_trisk + wee(ij+u_ldown,2,2)*hflux(ij+t_ldown+u_left,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_left,l))
77         du_trisk = du_trisk + wee(ij+u_ldown,3,2)*hflux(ij+t_ldown+u_ldown,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_ldown,l))
78         du_trisk = du_trisk + wee(ij+u_ldown,4,2)*hflux(ij+t_ldown+u_rdown,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_rdown,l))
79         du_trisk = du_trisk + wee(ij+u_ldown,5,2)*hflux(ij+t_ldown+u_right,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_right,l))
80         du(ij+u_ldown,l) = du(ij+u_ldown,l) + .5*du_trisk
81      END DO
82   END DO
83   !---------------------------- coriolis ----------------------------------
84   !--------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.