1 | MODULE compute_pvort_only_mod |
---|
2 | USE grid_param, ONLY : llm |
---|
3 | IMPLICIT NONE |
---|
4 | PRIVATE |
---|
5 | |
---|
6 | #include "../unstructured/unstructured.h90" |
---|
7 | |
---|
8 | PUBLIC :: compute_pvort_only_hex, compute_pvort_only_unst |
---|
9 | |
---|
10 | CONTAINS |
---|
11 | |
---|
12 | SUBROUTINE check_interface |
---|
13 | USE compute_caldyn_mod |
---|
14 | compute_pvort_only => compute_pvort_only_unst |
---|
15 | compute_pvort_only => compute_pvort_only_hex |
---|
16 | END SUBROUTINE check_interface |
---|
17 | |
---|
18 | #if BEGIN_DYSL |
---|
19 | |
---|
20 | KERNEL(pvort_only) |
---|
21 | FORALL_CELLS_EXT() |
---|
22 | ON_DUAL |
---|
23 | etav = 0.d0 |
---|
24 | FORALL_EDGES |
---|
25 | etav = etav + SIGN*u(EDGE) |
---|
26 | END_BLOCK |
---|
27 | hv=0. |
---|
28 | FORALL_VERTICES |
---|
29 | hv = hv + RIV2*rhodz(VERTEX) |
---|
30 | END_BLOCK |
---|
31 | qv(DUAL_CELL) = (etav + FV*AV )/(hv*AV) |
---|
32 | END_BLOCK |
---|
33 | END_BLOCK |
---|
34 | |
---|
35 | FORALL_CELLS() |
---|
36 | ON_EDGES |
---|
37 | qu(EDGE)=0.5d0*(qv(VERTEX1)+qv(VERTEX2)) |
---|
38 | END_BLOCK |
---|
39 | END_BLOCK |
---|
40 | END_BLOCK |
---|
41 | |
---|
42 | #endif END_DYSL |
---|
43 | |
---|
44 | SUBROUTINE compute_pvort_only_unst(u,rhodz,qu,qv, hv_) |
---|
45 | USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT |
---|
46 | USE data_unstructured_mod, ONLY : enter_trace, exit_trace, & |
---|
47 | id_pvort_only, primal_num, dual_num, edge_num, & |
---|
48 | dual_deg, dual_edge, dual_ne, dual_vertex, up, down, Av, fv, Riv2 |
---|
49 | FIELD_MASS :: rhodz |
---|
50 | FIELD_U :: u,qu |
---|
51 | FIELD_Z :: qv, hv_ |
---|
52 | DECLARE_INDICES |
---|
53 | DECLARE_EDGES |
---|
54 | DECLARE_VERTICES |
---|
55 | NUM :: etav, hv |
---|
56 | START_TRACE(id_pvort_only, 1,1,2) ! primal, dual, edge |
---|
57 | #include "../kernels_unst/pvort_only.k90" |
---|
58 | STOP_TRACE |
---|
59 | END SUBROUTINE compute_pvort_only_unst |
---|
60 | |
---|
61 | SUBROUTINE compute_pvort_only_hex(u,rhodz,qu,qv,hv_) |
---|
62 | USE icosa |
---|
63 | USE trace, ONLY : trace_start, trace_end |
---|
64 | USE caldyn_vars_mod, ONLY : dysl_pvort_only |
---|
65 | USE omp_para, ONLY : ll_begin, ll_end |
---|
66 | REAL(rstd),INTENT(IN) :: u(iim*3*jjm,llm) |
---|
67 | REAL(rstd),INTENT(INOUT) :: rhodz(iim*jjm,llm) |
---|
68 | REAL(rstd),INTENT(OUT) :: qu(iim*3*jjm,llm) |
---|
69 | REAL(rstd),INTENT(OUT) :: qv(iim*2*jjm,llm) |
---|
70 | REAL(rstd),INTENT(OUT) :: hv_(iim*2*jjm,llm) |
---|
71 | |
---|
72 | INTEGER :: ij,l |
---|
73 | REAL(rstd) :: etav,hv,radius_m2 |
---|
74 | |
---|
75 | CALL trace_start("compute_pvort_only") |
---|
76 | !!! Compute shallow-water potential vorticity |
---|
77 | IF(dysl_pvort_only) THEN |
---|
78 | #include "../kernels_hex/pvort_only.k90" |
---|
79 | ELSE |
---|
80 | |
---|
81 | radius_m2=radius**(-2) |
---|
82 | DO l = ll_begin,ll_end |
---|
83 | !DIR$ SIMD |
---|
84 | DO ij=ij_begin_ext,ij_end_ext |
---|
85 | etav= 1./Av(ij+z_up)*( ne_rup * u(ij+u_rup,l) & |
---|
86 | + ne_left * u(ij+t_rup+u_left,l) & |
---|
87 | - ne_lup * u(ij+u_lup,l) ) |
---|
88 | hv = Riv2(ij,vup) * rhodz(ij,l) & |
---|
89 | + Riv2(ij+t_rup,vldown) * rhodz(ij+t_rup,l) & |
---|
90 | + Riv2(ij+t_lup,vrdown) * rhodz(ij+t_lup,l) |
---|
91 | qv(ij+z_up,l) = ( etav+fv(ij+z_up) )/hv |
---|
92 | hv_(ij+z_up,l) = hv |
---|
93 | |
---|
94 | etav = 1./Av(ij+z_down)*( ne_ldown * u(ij+u_ldown,l) & |
---|
95 | + ne_right * u(ij+t_ldown+u_right,l) & |
---|
96 | - ne_rdown * u(ij+u_rdown,l) ) |
---|
97 | hv = Riv2(ij,vdown) * rhodz(ij,l) & |
---|
98 | + Riv2(ij+t_ldown,vrup) * rhodz(ij+t_ldown,l) & |
---|
99 | + Riv2(ij+t_rdown,vlup) * rhodz(ij+t_rdown,l) |
---|
100 | qv(ij+z_down,l) =( etav+fv(ij+z_down) )/hv |
---|
101 | hv_(ij+z_down,l) = hv |
---|
102 | ENDDO |
---|
103 | |
---|
104 | !DIR$ SIMD |
---|
105 | DO ij=ij_begin,ij_end |
---|
106 | qu(ij+u_right,l) = 0.5*(qv(ij+z_rdown,l)+qv(ij+z_rup,l)) |
---|
107 | qu(ij+u_lup,l) = 0.5*(qv(ij+z_up,l)+qv(ij+z_lup,l)) |
---|
108 | qu(ij+u_ldown,l) = 0.5*(qv(ij+z_ldown,l)+qv(ij+z_down,l)) |
---|
109 | END DO |
---|
110 | |
---|
111 | ENDDO |
---|
112 | |
---|
113 | END IF ! dysl |
---|
114 | CALL trace_end("compute_pvort_only") |
---|
115 | |
---|
116 | END SUBROUTINE compute_pvort_only_hex |
---|
117 | |
---|
118 | END MODULE compute_pvort_only_mod |
---|
119 | |
---|