source: codes/icosagcm/devel/src/kernels_unst/curl_laplacian.k90 @ 792

Last change on this file since 792 was 792, checked in by jisesh, 6 years ago

devel/unstructured : added kernel for curl curl ; used by Baroclinic_3D_ullrich

File size: 2.0 KB
Line 
1   !--------------------------------------------------------------------------
2   !---------------------------- curl_laplacian ----------------------------------
3   !$OMP DO SCHEDULE(STATIC)
4   DO ij = 1, dual_num
5      ! this VLOOP iterates over dual cell edges
6      SELECT CASE(dual_deg(ij))
7      CASE(3)
8         edge1 = dual_edge(1,ij)
9         edge2 = dual_edge(2,ij)
10         edge3 = dual_edge(3,ij)
11         sign1 = dual_ne(1,ij)
12         sign2 = dual_ne(2,ij)
13         sign3 = dual_ne(3,ij)
14         !DIR$ SIMD
15         DO l = 1, llm
16            etav = 0.d0
17            etav = etav + sign1*u(l,edge1)
18            etav = etav + sign2*u(l,edge2)
19            etav = etav + sign3*u(l,edge3)
20            qv(l,ij) = etav/Av(ij)
21         END DO
22      CASE(4)
23         edge1 = dual_edge(1,ij)
24         edge2 = dual_edge(2,ij)
25         edge3 = dual_edge(3,ij)
26         edge4 = dual_edge(4,ij)
27         sign1 = dual_ne(1,ij)
28         sign2 = dual_ne(2,ij)
29         sign3 = dual_ne(3,ij)
30         sign4 = dual_ne(4,ij)
31         !DIR$ SIMD
32         DO l = 1, llm
33            etav = 0.d0
34            etav = etav + sign1*u(l,edge1)
35            etav = etav + sign2*u(l,edge2)
36            etav = etav + sign3*u(l,edge3)
37            etav = etav + sign4*u(l,edge4)
38            qv(l,ij) = etav/Av(ij)
39         END DO
40      CASE DEFAULT
41         !DIR$ SIMD
42         DO l = 1, llm
43            etav = 0.d0
44            DO iedge = 1, dual_deg(ij)
45               edge = dual_edge(iedge,ij)
46               etav = etav + dual_ne(iedge,ij)*u(l,edge)
47            END DO
48            qv(l,ij) = etav/Av(ij)
49         END DO
50      END SELECT
51   END DO
52   !$OMP END DO
53   !$OMP DO SCHEDULE(STATIC)
54   DO edge = 1, edge_num
55      ij_up = up(edge)
56      ij_down = down(edge)
57      !DIR$ SIMD
58      DO l = 1, llm
59         curlcurl(l,edge) = 1.*(qv(l,ij_down)-qv(l,ij_up))*(1./le_de(edge))
60      END DO
61   END DO
62   !$OMP END DO
63   !---------------------------- curl_laplacian ----------------------------------
64   !--------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.