-
Notifications
You must be signed in to change notification settings - Fork 1
/
icestp.f90
243 lines (243 loc) · 8.15 KB
/
icestp.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
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
MODULE icestp
USE oce
USE dom_oce
USE c1d
USE ice
USE ice1D
USE phycst
USE eosbn2
USE sbc_oce
USE sbc_ice
USE iceforcing
USE icedyn
USE icethd
USE icecor
USE iceupdate
USE icedia
USE icewri
USE icerst
USE icevar
USE icectl
USE iceistate
USE iceitd
USE icealb
USE bdy_oce, ONLY: ln_bdy
USE bdyice
USE in_out_manager
USE iom
USE lib_mpp
USE lib_fortran
USE timing
USE prtctl
IMPLICIT NONE
PRIVATE
PUBLIC :: ice_stp
PUBLIC :: ice_init
CONTAINS
SUBROUTINE ice_stp(kt, ksbc)
INTEGER, INTENT(IN) :: kt
INTEGER, INTENT(IN) :: ksbc
INTEGER :: jl
IF (ln_timing) CALL timing_start('ice_stp')
IF (MOD(kt - 1, nn_fsbc) == 0) THEN
!$ACC KERNELS
kt_ice = kt
u_oce(:, :) = ssu_m(:, :)
v_oce(:, :) = ssv_m(:, :)
!$ACC END KERNELS
CALL eos_fzp(sss_m(:, :), t_bo(:, :))
!$ACC KERNELS
t_bo(:, :) = (t_bo(:, :) + rt0) * tmask(:, :, 1) + rt0 * (1._wp - tmask(:, :, 1))
!$ACC END KERNELS
CALL store_fields
CALL ice_forcing_tau(kt, ksbc, utau_ice, vtau_ice)
CALL diag_set0
CALL ice_rst_opn(kt)
IF (ln_icedyn .AND. .NOT. lk_c1d) CALL ice_dyn(kt)
IF (ln_icethd .AND. ln_bdy) CALL bdy_ice(kt)
CALL ice_var_glo2eqv
CALL ice_var_agg(1)
CALL store_fields
CALL ice_forcing_flx(kt, ksbc)
IF (ln_icethd) CALL ice_thd(kt)
IF (ln_icethd) CALL ice_cor(kt, 2)
CALL ice_var_glo2eqv
CALL ice_var_agg(2)
CALL ice_update_flx(kt)
IF (ln_icediahsb) CALL ice_dia(kt)
CALL ice_wri(kt)
IF (lrst_ice) CALL ice_rst_write(kt)
IF (ln_icectl) CALL ice_ctl(kt)
END IF
IF (ln_icedyn) CALL ice_update_tau(kt, ub(:, :, 1), vb(:, :, 1))
IF (ln_timing) CALL timing_stop('ice_stp')
END SUBROUTINE ice_stp
SUBROUTINE ice_init
INTEGER :: ji, jj, ierr
IF (lwp) WRITE(numout, FMT = *)
IF (lwp) WRITE(numout, FMT = *) 'ice_init: Arrays allocation & Initialization off all routines & init state'
IF (lwp) WRITE(numout, FMT = *) '~~~~~~~~'
CALL ctl_opn(numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', - 1, numout, lwp)
CALL ctl_opn(numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', - 1, numout, lwp)
IF (lwm) CALL ctl_opn(numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', - 1, numout, lwp, 1)
CALL par_init
ierr = ice_alloc()
ierr = ierr + sbc_ice_alloc()
ierr = ierr + ice1D_alloc()
IF (lk_mpp) CALL mpp_sum(ierr)
IF (ierr /= 0) CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays')
CALL ice_itd_init
CALL ice_thd_init
IF (.NOT. ln_rstart) THEN
CALL ice_istate_init
CALL ice_istate
ELSE
CALL ice_rst_read
END IF
CALL ice_var_glo2eqv
CALL ice_var_agg(1)
CALL ice_forcing_init
CALL ice_dyn_init
CALL ice_update_init
CALL ice_alb_init
CALL ice_dia_init
!$ACC KERNELS
fr_i(:, :) = at_i(:, :)
tn_ice(:, :, :) = t_su(:, :, :)
!$ACC END KERNELS
WHERE (gphit(:, :) > 0._wp)
rn_amax_2d(:, :) = rn_amax_n
ELSEWHERE
rn_amax_2d(:, :) = rn_amax_s
END WHERE
IF (ln_rstart) CALL iom_close(numrir)
END SUBROUTINE ice_init
SUBROUTINE par_init
INTEGER :: ios
NAMELIST /nampar/ jpl, nlay_i, nlay_s, nn_virtual_itd, ln_icedyn, ln_icethd, rn_amax_n, rn_amax_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir
REWIND(UNIT = numnam_ice_ref)
READ(numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901)
901 IF (ios /= 0) CALL ctl_nam(ios, 'nampar in reference namelist', lwp)
REWIND(UNIT = numnam_ice_cfg)
READ(numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902)
902 IF (ios > 0) CALL ctl_nam(ios, 'nampar in configuration namelist', lwp)
IF (lwm) WRITE(numoni, nampar)
IF (lwp) THEN
WRITE(numout, FMT = *)
WRITE(numout, FMT = *) ' par_init: ice parameters shared among all the routines'
WRITE(numout, FMT = *) ' ~~~~~~~~'
WRITE(numout, FMT = *) ' Namelist nampar: '
WRITE(numout, FMT = *) ' number of ice categories jpl = ', jpl
WRITE(numout, FMT = *) ' number of ice layers nlay_i = ', nlay_i
WRITE(numout, FMT = *) ' number of snow layers nlay_s = ', nlay_s
WRITE(numout, FMT = *) ' virtual ITD param for jpl=1 (1-3) or not (0) nn_virtual_itd = ', nn_virtual_itd
WRITE(numout, FMT = *) ' Ice dynamics (T) or not (F) ln_icedyn = ', ln_icedyn
WRITE(numout, FMT = *) ' Ice thermodynamics (T) or not (F) ln_icethd = ', ln_icethd
WRITE(numout, FMT = *) ' maximum ice concentration for NH = ', rn_amax_n
WRITE(numout, FMT = *) ' maximum ice concentration for SH = ', rn_amax_s
END IF
IF (jpl > 1 .AND. nn_virtual_itd == 1) THEN
nn_virtual_itd = 0
IF (lwp) WRITE(numout, FMT = *)
IF (lwp) WRITE(numout, FMT = *) ' nn_virtual_itd forced to 0 as jpl>1, no need with multiple categories to emulate them'
END IF
IF (ln_cpl .AND. nn_cats_cpl /= 1 .AND. nn_cats_cpl /= jpl) THEN
CALL ctl_stop('STOP', 'par_init: in coupled mode, nn_cats_cpl should be either 1 or jpl')
END IF
IF (ln_bdy .AND. ln_icediachk) CALL ctl_warn('par_init: online conservation check does not work with BDY')
rdt_ice = REAL(nn_fsbc) * rdt
r1_rdtice = 1._wp / rdt_ice
IF (lwp) WRITE(numout, FMT = *)
IF (lwp) WRITE(numout, FMT = *) ' ice timestep rdt_ice = nn_fsbc*rdt = ', rdt_ice
r1_nlay_i = 1._wp / REAL(nlay_i, wp)
r1_nlay_s = 1._wp / REAL(nlay_s, wp)
END SUBROUTINE par_init
SUBROUTINE store_fields
INTEGER :: ji, jj, jl
!$ACC KERNELS
a_i_b(:, :, :) = a_i(:, :, :)
v_i_b(:, :, :) = v_i(:, :, :)
v_s_b(:, :, :) = v_s(:, :, :)
sv_i_b(:, :, :) = sv_i(:, :, :)
oa_i_b(:, :, :) = oa_i(:, :, :)
e_s_b(:, :, :, :) = e_s(:, :, :, :)
e_i_b(:, :, :, :) = e_i(:, :, :, :)
!$ACC END KERNELS
WHERE (a_i_b(:, :, :) >= epsi20)
h_i_b(:, :, :) = v_i_b(:, :, :) / a_i_b(:, :, :)
h_s_b(:, :, :) = v_s_b(:, :, :) / a_i_b(:, :, :)
ELSEWHERE
h_i_b(:, :, :) = 0._wp
h_s_b(:, :, :) = 0._wp
END WHERE
at_i_b(:, :) = SUM(a_i_b(:, :, :), dim = 3)
!$ACC KERNELS
u_ice_b(:, :) = u_ice(:, :)
v_ice_b(:, :) = v_ice(:, :)
!$ACC END KERNELS
END SUBROUTINE store_fields
SUBROUTINE diag_set0
INTEGER :: ji, jj
!$ACC KERNELS
sfx(:, :) = 0._wp
sfx_bri(:, :) = 0._wp
sfx_lam(:, :) = 0._wp
sfx_sni(:, :) = 0._wp
sfx_opw(:, :) = 0._wp
sfx_bog(:, :) = 0._wp
sfx_dyn(:, :) = 0._wp
sfx_bom(:, :) = 0._wp
sfx_sum(:, :) = 0._wp
sfx_res(:, :) = 0._wp
sfx_sub(:, :) = 0._wp
wfx_snw(:, :) = 0._wp
wfx_ice(:, :) = 0._wp
wfx_sni(:, :) = 0._wp
wfx_opw(:, :) = 0._wp
wfx_bog(:, :) = 0._wp
wfx_dyn(:, :) = 0._wp
wfx_bom(:, :) = 0._wp
wfx_sum(:, :) = 0._wp
wfx_res(:, :) = 0._wp
wfx_sub(:, :) = 0._wp
wfx_spr(:, :) = 0._wp
wfx_lam(:, :) = 0._wp
wfx_snw_dyn(:, :) = 0._wp
wfx_snw_sum(:, :) = 0._wp
wfx_snw_sub(:, :) = 0._wp
wfx_ice_sub(:, :) = 0._wp
wfx_snw_sni(:, :) = 0._wp
wfx_pnd(:, :) = 0._wp
hfx_thd(:, :) = 0._wp
hfx_snw(:, :) = 0._wp
hfx_opw(:, :) = 0._wp
hfx_bog(:, :) = 0._wp
hfx_dyn(:, :) = 0._wp
hfx_bom(:, :) = 0._wp
hfx_sum(:, :) = 0._wp
hfx_res(:, :) = 0._wp
hfx_sub(:, :) = 0._wp
hfx_spr(:, :) = 0._wp
hfx_dif(:, :) = 0._wp
hfx_err_rem(:, :) = 0._wp
hfx_err_dif(:, :) = 0._wp
wfx_err_sub(:, :) = 0._wp
afx_tot(:, :) = 0._wp
diag_heat(:, :) = 0._wp
diag_sice(:, :) = 0._wp
diag_vice(:, :) = 0._wp
diag_vsnw(:, :) = 0._wp
qcn_ice_bot(:, :, :) = 0._wp
qcn_ice_top(:, :, :) = 0._wp
t_si(:, :, :) = rt0
tau_icebfr(:, :) = 0._wp
cnd_ice(:, :, :) = 0._wp
qtr_ice_bot(:, :, :) = 0._wp
diag_trp_vi(:, :) = 0._wp
diag_trp_vs(:, :) = 0._wp
diag_trp_ei(:, :) = 0._wp
diag_trp_es(:, :) = 0._wp
diag_trp_sv(:, :) = 0._wp
!$ACC END KERNELS
END SUBROUTINE diag_set0
END MODULE icestp