-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathcrsfld.f90
191 lines (191 loc) · 7.75 KB
/
crsfld.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
MODULE crsfld
USE crs
USE crsdom
USE crslbclnk
USE oce
USE dom_oce
USE sbc_oce
USE zdf_oce
USE ldftra
USE zdfddm
USE in_out_manager
USE iom
USE lbclnk
USE timing
IMPLICIT NONE
PRIVATE
PUBLIC :: crs_fld
CONTAINS
SUBROUTINE crs_fld(kt)
INTEGER, INTENT(IN) :: kt
INTEGER :: ji, jj, jk
REAL(KIND = wp) :: z2dcrsu, z2dcrsv
REAL(KIND = wp) :: zztmp
REAL(KIND = wp), DIMENSION(jpi, jpj, jpk) :: ze3t, ze3u, ze3v, ze3w
REAL(KIND = wp), DIMENSION(jpi, jpj, jpk) :: zt, zs, z3d
REAL(KIND = wp), DIMENSION(jpi_crs, jpj_crs, jpk) :: zt_crs, zs_crs
IF (ln_timing) CALL timing_start('crs_fld')
!$ACC KERNELS
ze3t(:, :, :) = e3t_n(:, :, :)
ze3u(:, :, :) = e3u_n(:, :, :)
ze3v(:, :, :) = e3v_n(:, :, :)
ze3w(:, :, :) = e3w_n(:, :, :)
!$ACC END KERNELS
IF (kt == nit000) THEN
!$ACC KERNELS
tsn_crs(:, :, :, :) = 0._wp
un_crs(:, :, :) = 0._wp
vn_crs(:, :, :) = 0._wp
wn_crs(:, :, :) = 0._wp
avs_crs(:, :, :) = 0._wp
hdivn_crs(:, :, :) = 0._wp
sshn_crs(:, :) = 0._wp
utau_crs(:, :) = 0._wp
vtau_crs(:, :) = 0._wp
wndm_crs(:, :) = 0._wp
qsr_crs(:, :) = 0._wp
emp_crs(:, :) = 0._wp
emp_b_crs(:, :) = 0._wp
rnf_crs(:, :) = 0._wp
fr_i_crs(:, :) = 0._wp
!$ACC END KERNELS
END IF
CALL iom_swap("nemo_crs")
!$ACC KERNELS
zt(:, :, :) = tsn(:, :, :, jp_tem)
zt_crs(:, :, :) = 0._wp
!$ACC END KERNELS
CALL crs_dom_ope(zt, 'VOL', 'T', tmask, zt_crs, p_e12 = e1e2t, p_e3 = ze3t, psgn = 1.0)
!$ACC KERNELS
tsn_crs(:, :, :, jp_tem) = zt_crs(:, :, :)
!$ACC END KERNELS
CALL iom_put("toce", tsn_crs(:, :, :, jp_tem))
CALL iom_put("sst", tsn_crs(:, :, 1, jp_tem))
!$ACC KERNELS
zs(:, :, :) = tsn(:, :, :, jp_sal)
zs_crs(:, :, :) = 0._wp
!$ACC END KERNELS
CALL crs_dom_ope(zs, 'VOL', 'T', tmask, zs_crs, p_e12 = e1e2t, p_e3 = ze3t, psgn = 1.0)
!$ACC KERNELS
tsn_crs(:, :, :, jp_sal) = zt_crs(:, :, :)
!$ACC END KERNELS
CALL iom_put("soce", tsn_crs(:, :, :, jp_sal))
CALL iom_put("sss", tsn_crs(:, :, 1, jp_sal))
CALL crs_dom_ope(un, 'SUM', 'U', umask, un_crs, p_e12 = e2u, p_e3 = ze3u, p_surf_crs = e2e3u_msk, psgn = - 1.0)
!$ACC KERNELS
zt(:, :, :) = 0._wp
zs(:, :, :) = 0._wp
zt_crs(:, :, :) = 0._wp
zs_crs(:, :, :) = 0._wp
DO jk = 1, jpkm1
DO jj = 2, jpjm1
DO ji = 2, jpim1
zt(ji, jj, jk) = un(ji, jj, jk) * 0.5 * (tsn(ji, jj, jk, jp_tem) + tsn(ji + 1, jj, jk, jp_tem))
zs(ji, jj, jk) = un(ji, jj, jk) * 0.5 * (tsn(ji, jj, jk, jp_sal) + tsn(ji + 1, jj, jk, jp_sal))
END DO
END DO
END DO
!$ACC END KERNELS
CALL crs_dom_ope(zt, 'SUM', 'U', umask, zt_crs, p_e12 = e2u, p_e3 = ze3u, p_surf_crs = e2e3u_msk, psgn = - 1.0)
CALL crs_dom_ope(zs, 'SUM', 'U', umask, zs_crs, p_e12 = e2u, p_e3 = ze3u, p_surf_crs = e2e3u_msk, psgn = - 1.0)
CALL iom_put("uoce", un_crs)
CALL iom_put("uocet", zt_crs)
CALL iom_put("uoces", zs_crs)
CALL crs_dom_ope(vn, 'SUM', 'V', vmask, vn_crs, p_e12 = e1v, p_e3 = ze3v, p_surf_crs = e1e3v_msk, psgn = - 1.0)
!$ACC KERNELS
zt(:, :, :) = 0._wp
zs(:, :, :) = 0._wp
zt_crs(:, :, :) = 0._wp
zs_crs(:, :, :) = 0._wp
DO jk = 1, jpkm1
DO jj = 2, jpjm1
DO ji = 2, jpim1
zt(ji, jj, jk) = vn(ji, jj, jk) * 0.5 * (tsn(ji, jj, jk, jp_tem) + tsn(ji, jj + 1, jk, jp_tem))
zs(ji, jj, jk) = vn(ji, jj, jk) * 0.5 * (tsn(ji, jj, jk, jp_sal) + tsn(ji, jj + 1, jk, jp_sal))
END DO
END DO
END DO
!$ACC END KERNELS
CALL crs_dom_ope(zt, 'SUM', 'V', vmask, zt_crs, p_e12 = e1v, p_e3 = ze3v, p_surf_crs = e1e3v_msk, psgn = - 1.0)
CALL crs_dom_ope(zs, 'SUM', 'V', vmask, zs_crs, p_e12 = e1v, p_e3 = ze3v, p_surf_crs = e1e3v_msk, psgn = - 1.0)
CALL iom_put("voce", vn_crs)
CALL iom_put("vocet", zt_crs)
CALL iom_put("voces", zs_crs)
IF (iom_use("eken")) THEN
!$ACC KERNELS
z3d(:, :, jk) = 0._wp
DO jk = 1, jpkm1
DO jj = 2, jpjm1
DO ji = 2, jpim1
zztmp = r1_e1e2t(ji, jj) / e3t_n(ji, jj, jk)
z3d(ji, jj, jk) = 0.25_wp * zztmp * (un(ji - 1, jj, jk) ** 2 * e2u(ji - 1, jj) * e3u_n(ji - 1, jj, jk) + un(ji, jj, jk) ** 2 * e2u(ji, jj) * e3u_n(ji, jj, jk) + vn(ji, jj - 1, jk) ** 2 * e1v(ji, jj - 1) * e3v_n(ji, jj - 1, jk) + vn(ji, jj, jk) ** 2 * e1v(ji, jj) * e3v_n(ji, jj, jk))
END DO
END DO
END DO
!$ACC END KERNELS
CALL lbc_lnk(z3d, 'T', 1.)
CALL crs_dom_ope(z3d, 'VOL', 'T', tmask, zt_crs, p_e12 = e1e2t, p_e3 = ze3t, psgn = 1.0)
CALL iom_put("eken", zt_crs)
END IF
!$ACC KERNELS
DO jk = 1, jpkm1
DO ji = 2, jpi_crsm1
DO jj = 2, jpj_crsm1
IF (tmask_crs(ji, jj, jk) > 0) THEN
z2dcrsu = (un_crs(ji, jj, jk) * crs_surfu_wgt(ji, jj, jk)) - (un_crs(ji - 1, jj, jk) * crs_surfu_wgt(ji - 1, jj, jk))
z2dcrsv = (vn_crs(ji, jj, jk) * crs_surfv_wgt(ji, jj, jk)) - (vn_crs(ji, jj - 1, jk) * crs_surfv_wgt(ji, jj - 1, jk))
hdivn_crs(ji, jj, jk) = (z2dcrsu + z2dcrsv) / crs_volt_wgt(ji, jj, jk)
END IF
END DO
END DO
END DO
!$ACC END KERNELS
CALL crs_lbc_lnk(hdivn_crs, 'T', 1.0)
CALL iom_put("hdiv", hdivn_crs)
IF (ln_crs_wn) THEN
CALL crs_dom_ope(wn, 'SUM', 'W', tmask, wn_crs, p_e12 = e1e2t, p_surf_crs = e1e2w_msk, psgn = 1.0)
ELSE
!$ACC KERNELS
wn_crs(:, :, jpk) = 0._wp
DO jk = jpkm1, 1, - 1
wn_crs(:, :, jk) = wn_crs(:, :, jk + 1) - e3t_crs(:, :, jk) * hdivn_crs(:, :, jk)
END DO
!$ACC END KERNELS
END IF
CALL iom_put("woce", wn_crs)
SELECT CASE (nn_crs_kz)
CASE (0)
CALL crs_dom_ope(avt, 'VOL', 'W', tmask, avt_crs, p_e12 = e1e2t, p_e3 = ze3w, psgn = 1.0)
CALL crs_dom_ope(avs, 'VOL', 'W', tmask, avs_crs, p_e12 = e1e2t, p_e3 = ze3w, psgn = 1.0)
CASE (1)
CALL crs_dom_ope(avt, 'MAX', 'W', tmask, avt_crs, p_e12 = e1e2t, p_e3 = ze3w, psgn = 1.0)
CALL crs_dom_ope(avs, 'MAX', 'W', tmask, avs_crs, p_e12 = e1e2t, p_e3 = ze3w, psgn = 1.0)
CASE (2)
CALL crs_dom_ope(avt, 'MIN', 'W', tmask, avt_crs, p_e12 = e1e2t, p_e3 = ze3w, psgn = 1.0)
CALL crs_dom_ope(avs, 'MIN', 'W', tmask, avs_crs, p_e12 = e1e2t, p_e3 = ze3w, psgn = 1.0)
END SELECT
CALL iom_put("avt", avt_crs)
CALL iom_put("avs", avs_crs)
CALL crs_dom_ope(sshn, 'VOL', 'T', tmask, sshn_crs, p_e12 = e1e2t, p_e3 = ze3t, psgn = 1.0)
CALL crs_dom_ope(utau, 'SUM', 'U', umask, utau_crs, p_e12 = e2u, p_surf_crs = e2u_crs, psgn = 1.0)
CALL crs_dom_ope(vtau, 'SUM', 'V', vmask, vtau_crs, p_e12 = e1v, p_surf_crs = e1v_crs, psgn = 1.0)
CALL crs_dom_ope(wndm, 'SUM', 'T', tmask, wndm_crs, p_e12 = e1e2t, p_surf_crs = e1e2t_crs, psgn = 1.0)
CALL crs_dom_ope(rnf, 'MAX', 'T', tmask, rnf_crs, psgn = 1.0)
CALL crs_dom_ope(qsr, 'SUM', 'T', tmask, qsr_crs, p_e12 = e1e2t, p_surf_crs = e1e2t_crs, psgn = 1.0)
CALL crs_dom_ope(emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12 = e1e2t, p_surf_crs = e1e2t_crs, psgn = 1.0)
CALL crs_dom_ope(emp, 'SUM', 'T', tmask, emp_crs, p_e12 = e1e2t, p_surf_crs = e1e2t_crs, psgn = 1.0)
CALL crs_dom_ope(sfx, 'SUM', 'T', tmask, sfx_crs, p_e12 = e1e2t, p_surf_crs = e1e2t_crs, psgn = 1.0)
CALL crs_dom_ope(fr_i, 'SUM', 'T', tmask, fr_i_crs, p_e12 = e1e2t, p_surf_crs = e1e2t_crs, psgn = 1.0)
CALL iom_put("ssh", sshn_crs)
CALL iom_put("utau", utau_crs)
CALL iom_put("vtau", vtau_crs)
CALL iom_put("wspd", wndm_crs)
CALL iom_put("runoffs", rnf_crs)
CALL iom_put("qsr", qsr_crs)
CALL iom_put("empmr", emp_crs)
CALL iom_put("saltflx", sfx_crs)
CALL iom_put("ice_cover", fr_i_crs)
CALL iom_swap("nemo")
IF (ln_timing) CALL timing_stop('crs_fld')
END SUBROUTINE crs_fld
END MODULE crsfld