27 use coupler_types_mod,
only : coupler_type_set_data, ind_csurf
30 implicit none ;
private
32 #include <MOM_memory.h>
34 public register_pseudo_salt_tracer, initialize_pseudo_salt_tracer
35 public pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state
36 public pseudo_salt_stock, pseudo_salt_tracer_end
40 type(time_type),
pointer :: time => null()
42 real,
pointer :: ps(:,:,:) => null()
44 real,
pointer :: diff(:,:,:) => null()
46 logical :: pseudo_salt_may_reinit = .true.
48 integer :: id_psd = -1
60 function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
74 character(len=40) :: mdl =
"pseudo_salt_tracer"
75 character(len=200) :: inputdir
76 character(len=48) :: var_name
77 character(len=3) :: name_tag
79 #include "version_variable.h"
80 real,
pointer :: tr_ptr(:,:,:) => null()
81 logical :: register_pseudo_salt_tracer
82 integer :: isd, ied, jsd, jed, nz, i, j
83 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
85 if (
associated(cs))
then
86 call mom_error(warning,
"register_pseudo_salt_tracer called with an "// &
87 "associated control structure.")
95 allocate(cs%ps(isd:ied,jsd:jed,nz)) ; cs%ps(:,:,:) = 0.0
96 allocate(cs%diff(isd:ied,jsd:jed,nz)) ; cs%diff(:,:,:) = 0.0
98 cs%tr_desc = var_desc(trim(
"pseudo_salt"),
"psu", &
99 "Pseudo salt passive tracer", caller=mdl)
101 tr_ptr => cs%ps(:,:,:)
102 call query_vardesc(cs%tr_desc, name=var_name, caller=
"register_pseudo_salt_tracer")
104 call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, name=
"pseudo_salt", &
105 longname=
"Pseudo salt passive tracer", units=
"psu", &
106 registry_diags=.true., restart_cs=restart_cs, &
107 mandatory=.not.cs%pseudo_salt_may_reinit)
110 cs%restart_CSp => restart_cs
111 register_pseudo_salt_tracer = .true.
113 end function register_pseudo_salt_tracer
116 subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, &
118 logical,
intent(in) :: restart
120 type(time_type),
target,
intent(in) :: day
123 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
125 type(
diag_ctrl),
target,
intent(in) :: diag
137 character(len=16) :: name
138 character(len=72) :: longname
139 character(len=48) :: units
140 character(len=48) :: flux_units
143 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
144 integer :: isdb, iedb, jsdb, jedb
146 if (.not.
associated(cs))
return
147 if (.not.
associated(cs%diff))
return
149 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
150 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
151 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
157 call query_vardesc(cs%tr_desc, name=name, caller=
"initialize_pseudo_salt_tracer")
158 if ((.not.restart) .or. (.not.
query_initialized(cs%ps, name, cs%restart_CSp)))
then
159 do k=1,nz ;
do j=jsd,jed ;
do i=isd,ied
160 cs%ps(i,j,k) = tv%S(i,j,k)
161 enddo ;
enddo ;
enddo
164 if (
associated(obc))
then
168 cs%id_psd = register_diag_field(
"ocean_model",
"pseudo_salt_diff", cs%diag%axesTL, &
169 day,
"Difference between pseudo salt passive tracer and salt tracer",
"psu")
171 end subroutine initialize_pseudo_salt_tracer
174 subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, &
175 evap_CFL_limit, minimum_forcing_depth)
178 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
180 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
182 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
186 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
190 type(
forcing),
intent(in) :: fluxes
192 real,
intent(in) :: dt
197 logical,
intent(in) :: debug
198 real,
optional,
intent(in) :: evap_cfl_limit
200 real,
optional,
intent(in) :: minimum_forcing_depth
210 real :: year, h_total, scale, htot, ih_limit
211 integer :: secs, days
212 integer :: i, j, k, is, ie, js, je, nz, k_max
213 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work
215 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
217 if (.not.
associated(cs))
return
218 if (.not.
associated(cs%diff))
return
221 call hchksum(tv%S,
"salt pre pseudo-salt vertdiff", g%HI)
222 call hchksum(cs%ps,
"pseudo_salt pre pseudo-salt vertdiff", g%HI)
226 if (
present(evap_cfl_limit) .and.
present(minimum_forcing_depth))
then
227 do k=1,nz ;
do j=js,je ;
do i=is,ie
228 h_work(i,j,k) = h_old(i,j,k)
229 enddo ;
enddo ;
enddo
230 call applytracerboundaryfluxesinout(g, gv, cs%ps, dt, fluxes, h_work, &
231 evap_cfl_limit, minimum_forcing_depth, out_flux_optional=fluxes%netSalt)
232 call tracer_vertdiff(h_work, ea, eb, dt, cs%ps, g, gv)
234 call tracer_vertdiff(h_old, ea, eb, dt, cs%ps, g, gv)
237 do k=1,nz ;
do j=js,je ;
do i=is,ie
238 cs%diff(i,j,k) = cs%ps(i,j,k)-tv%S(i,j,k)
239 enddo ;
enddo ;
enddo
242 call hchksum(tv%S,
"salt post pseudo-salt vertdiff", g%HI)
243 call hchksum(cs%ps,
"pseudo_salt post pseudo-salt vertdiff", g%HI)
246 if (cs%id_psd>0)
call post_data(cs%id_psd, cs%diff, cs%diag)
248 end subroutine pseudo_salt_tracer_column_physics
253 function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index)
256 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
257 real,
dimension(:),
intent(out) :: stocks
261 character(len=*),
dimension(:),
intent(out) :: names
262 character(len=*),
dimension(:),
intent(out) :: units
263 integer,
optional,
intent(in) :: stock_index
265 integer :: pseudo_salt_stock
272 integer :: i, j, k, is, ie, js, je, nz
273 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
275 pseudo_salt_stock = 0
276 if (.not.
associated(cs))
return
277 if (.not.
associated(cs%diff))
return
279 if (
present(stock_index))
then ;
if (stock_index > 0)
then
286 call query_vardesc(cs%tr_desc, name=names(1), units=units(1), caller=
"pseudo_salt_stock")
287 units(1) = trim(units(1))//
" kg"
289 do k=1,nz ;
do j=js,je ;
do i=is,ie
290 stocks(1) = stocks(1) + cs%diff(i,j,k) * &
291 (g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k))
292 enddo ;
enddo ;
enddo
293 stocks(1) = gv%H_to_kg_m2 * stocks(1)
295 pseudo_salt_stock = 1
297 end function pseudo_salt_stock
302 subroutine pseudo_salt_tracer_surface_state(sfc_state, h, G, CS)
304 type(
surface),
intent(inout) :: sfc_state
306 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
314 integer :: m, is, ie, js, je, isd, ied, jsd, jed
315 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
316 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
318 if (.not.
associated(cs))
return
322 end subroutine pseudo_salt_tracer_surface_state
325 subroutine pseudo_salt_tracer_end(CS)
330 if (
associated(cs))
then
331 if (
associated(cs%ps))
deallocate(cs%ps)
332 if (
associated(cs%diff))
deallocate(cs%diff)
335 end subroutine pseudo_salt_tracer_end