source: codes/icosagcm/devel/src/kernels_hex/coriolis.k90 @ 990

Last change on this file since 990 was 940, checked in by dubos, 5 years ago

devel : DySL for enstrophy-conserving scheme
File size: 8.2 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   SELECT CASE(caldyn_conserv)
43   CASE(conserv_energy) ! energy-conserving TRiSK
44      DO l = ll_begin, ll_end
45         !DIR$ SIMD
46         DO ij=ij_begin, ij_end
47            du_trisk=0.
48            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))
49            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))
50            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))
51            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))
52            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))
53            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))
54            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))
55            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))
56            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))
57            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))
58            du(ij+u_right,l) = du(ij+u_right,l) + .5*du_trisk
59            du_trisk=0.
60            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))
61            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))
62            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))
63            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))
64            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))
65            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))
66            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))
67            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))
68            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))
69            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))
70            du(ij+u_lup,l) = du(ij+u_lup,l) + .5*du_trisk
71            du_trisk=0.
72            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))
73            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))
74            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))
75            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))
76            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))
77            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))
78            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))
79            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))
80            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))
81            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))
82            du(ij+u_ldown,l) = du(ij+u_ldown,l) + .5*du_trisk
83         END DO
84      END DO
85   CASE(conserv_enstrophy) ! enstrophy-conserving TRiSK
86      DO l = ll_begin, ll_end
87         !DIR$ SIMD
88         DO ij=ij_begin, ij_end
89            du_trisk=0.
90            du_trisk = du_trisk + wee(ij+u_right,1,1)*hflux(ij+u_rup,l)
91            du_trisk = du_trisk + wee(ij+u_right,2,1)*hflux(ij+u_lup,l)
92            du_trisk = du_trisk + wee(ij+u_right,3,1)*hflux(ij+u_left,l)
93            du_trisk = du_trisk + wee(ij+u_right,4,1)*hflux(ij+u_ldown,l)
94            du_trisk = du_trisk + wee(ij+u_right,5,1)*hflux(ij+u_rdown,l)
95            du_trisk = du_trisk + wee(ij+u_right,1,2)*hflux(ij+t_right+u_ldown,l)
96            du_trisk = du_trisk + wee(ij+u_right,2,2)*hflux(ij+t_right+u_rdown,l)
97            du_trisk = du_trisk + wee(ij+u_right,3,2)*hflux(ij+t_right+u_right,l)
98            du_trisk = du_trisk + wee(ij+u_right,4,2)*hflux(ij+t_right+u_rup,l)
99            du_trisk = du_trisk + wee(ij+u_right,5,2)*hflux(ij+t_right+u_lup,l)
100            du(ij+u_right,l) = du(ij+u_right,l) + du_trisk*qu(ij+u_right,l)
101            du_trisk=0.
102            du_trisk = du_trisk + wee(ij+u_lup,1,1)*hflux(ij+u_left,l)
103            du_trisk = du_trisk + wee(ij+u_lup,2,1)*hflux(ij+u_ldown,l)
104            du_trisk = du_trisk + wee(ij+u_lup,3,1)*hflux(ij+u_rdown,l)
105            du_trisk = du_trisk + wee(ij+u_lup,4,1)*hflux(ij+u_right,l)
106            du_trisk = du_trisk + wee(ij+u_lup,5,1)*hflux(ij+u_rup,l)
107            du_trisk = du_trisk + wee(ij+u_lup,1,2)*hflux(ij+t_lup+u_right,l)
108            du_trisk = du_trisk + wee(ij+u_lup,2,2)*hflux(ij+t_lup+u_rup,l)
109            du_trisk = du_trisk + wee(ij+u_lup,3,2)*hflux(ij+t_lup+u_lup,l)
110            du_trisk = du_trisk + wee(ij+u_lup,4,2)*hflux(ij+t_lup+u_left,l)
111            du_trisk = du_trisk + wee(ij+u_lup,5,2)*hflux(ij+t_lup+u_ldown,l)
112            du(ij+u_lup,l) = du(ij+u_lup,l) + du_trisk*qu(ij+u_lup,l)
113            du_trisk=0.
114            du_trisk = du_trisk + wee(ij+u_ldown,1,1)*hflux(ij+u_rdown,l)
115            du_trisk = du_trisk + wee(ij+u_ldown,2,1)*hflux(ij+u_right,l)
116            du_trisk = du_trisk + wee(ij+u_ldown,3,1)*hflux(ij+u_rup,l)
117            du_trisk = du_trisk + wee(ij+u_ldown,4,1)*hflux(ij+u_lup,l)
118            du_trisk = du_trisk + wee(ij+u_ldown,5,1)*hflux(ij+u_left,l)
119            du_trisk = du_trisk + wee(ij+u_ldown,1,2)*hflux(ij+t_ldown+u_lup,l)
120            du_trisk = du_trisk + wee(ij+u_ldown,2,2)*hflux(ij+t_ldown+u_left,l)
121            du_trisk = du_trisk + wee(ij+u_ldown,3,2)*hflux(ij+t_ldown+u_ldown,l)
122            du_trisk = du_trisk + wee(ij+u_ldown,4,2)*hflux(ij+t_ldown+u_rdown,l)
123            du_trisk = du_trisk + wee(ij+u_ldown,5,2)*hflux(ij+t_ldown+u_right,l)
124            du(ij+u_ldown,l) = du(ij+u_ldown,l) + du_trisk*qu(ij+u_ldown,l)
125         END DO
126      END DO
127   END SELECT
128   !---------------------------- coriolis ----------------------------------
129   !--------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.