ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
rp_rho_eos_mod Module Reference

Functions/Subroutines

subroutine, public rp_rho_eos (ng, tile, model)
 
subroutine rp_rho_eos_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, rmask, z_r, tl_z_r, z_w, tl_z_w, t, tl_t, alpha, tl_alpha, beta, tl_beta, rho, tl_rho)
 

Function/Subroutine Documentation

◆ rp_rho_eos()

subroutine, public rp_rho_eos_mod::rp_rho_eos ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 47 of file rp_rho_eos.F.

48!***********************************************************************
49!
50 USE mod_param
51 USE mod_coupling
52 USE mod_grid
53 USE mod_mixing
54 USE mod_ocean
55 USE mod_stepping
56!
57! Imported variable declarations.
58!
59 integer, intent(in) :: ng, tile, model
60!
61! Local variable declarations.
62!
63 character (len=*), parameter :: MyFile = &
64 & __FILE__
65!
66# include "tile.h"
67!
68# ifdef PROFILE
69 CALL wclock_on (ng, model, 14, __line__, myfile)
70# endif
71 CALL rp_rho_eos_tile (ng, tile, model, &
72 & lbi, ubi, lbj, ubj, &
73 & imins, imaxs, jmins, jmaxs, &
74 & nrhs(ng), &
75# ifdef MASKING
76 & grid(ng) % rmask, &
77# endif
78# ifdef VAR_RHO_2D_NOT_YET
79 & grid(ng) % Hz, &
80 & grid(ng) % tl_Hz, &
81# endif
82 & grid(ng) % z_r, &
83 & grid(ng) % tl_z_r, &
84 & grid(ng) % z_w, &
85 & grid(ng) % tl_z_w, &
86 & ocean(ng) % t, &
87 & ocean(ng) % tl_t, &
88# ifdef VAR_RHO_2D_NOT_YET
89 & coupling(ng) % rhoA, &
90 & coupling(ng) % tl_rhoA, &
91 & coupling(ng) % rhoS, &
92 & coupling(ng) % tl_rhoS, &
93# endif
94# ifdef BV_FREQUENCY_NOT_YET
95 & mixing(ng) % tl_bvf, &
96# endif
97# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
98 defined bulk_fluxes
99 & mixing(ng) % alpha, &
100 & mixing(ng) % tl_alpha, &
101 & mixing(ng) % beta, &
102 & mixing(ng) % tl_beta, &
103# ifdef LMD_DDMIX_NOT_YET
104 & mixing(ng) % tl_alfaobeta, &
105# endif
106# endif
107# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
108 & ocean(ng) % tl_pden, &
109# endif
110 & ocean(ng) % rho, &
111 & ocean(ng) % tl_rho)
112# ifdef PROFILE
113 CALL wclock_off (ng, model, 14, __line__, myfile)
114# endif
115!
116 RETURN
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3

References mod_coupling::coupling, mod_grid::grid, mod_mixing::mixing, mod_stepping::nrhs, mod_ocean::ocean, rp_rho_eos_tile(), wclock_off(), and wclock_on().

Referenced by rp_initial(), and rp_main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ rp_rho_eos_tile()

subroutine rp_rho_eos_mod::rp_rho_eos_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nrhs,
real(r8), dimension(lbi:,lbj:), intent(in) rmask,
real(r8), dimension(lbi:,lbj:,:), intent(in) z_r,
real(r8), dimension(lbi:,lbj:,:), intent(in) tl_z_r,
real(r8), dimension(lbi:,lbj:,0:), intent(in) z_w,
real(r8), dimension(lbi:,lbj:,0:), intent(in) tl_z_w,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(in) t,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(in) tl_t,
real(r8), dimension(lbi:,lbj:), intent(inout) alpha,
real(r8), dimension(lbi:,lbj:), intent(out) tl_alpha,
real(r8), dimension(lbi:,lbj:), intent(inout) beta,
real(r8), dimension(lbi:,lbj:), intent(out) tl_beta,
real(r8), dimension(lbi:,lbj:,:), intent(out) rho,
real(r8), dimension(lbi:,lbj:,:), intent(out) tl_rho )
private

Definition at line 122 of file rp_rho_eos.F.

154!***********************************************************************
155!
156 USE mod_param
157 USE mod_eoscoef
158 USE mod_scalars
159# ifdef SEDIMENT_NOT_YET
160 USE mod_sediment
161# endif
162!
163 USE exchange_2d_mod
164 USE exchange_3d_mod
165# ifdef DISTRIBUTE
166 USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d
167# endif
168!
169! Imported variable declarations.
170!
171 integer, intent(in) :: ng, tile, model
172 integer, intent(in) :: LBi, UBi, LBj, UBj
173 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
174 integer, intent(in) :: nrhs
175!
176# ifdef ASSUMED_SHAPE
177# ifdef MASKING
178 real(r8), intent(in) :: rmask(LBi:,LBj:)
179# endif
180# ifdef VAR_RHO_2D_NOT_YET
181 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
182# endif
183 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
184 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
185 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
186# ifdef VAR_RHO_2D_NOT_YET
187 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
188# endif
189 real(r8), intent(in) :: tl_z_r(LBi:,LBj:,:)
190 real(r8), intent(in) :: tl_z_w(LBi:,LBj:,0:)
191 real(r8), intent(in) :: tl_t(LBi:,LBj:,:,:,:)
192# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
193 defined bulk_fluxes
194 real(r8), intent(inout) :: alpha(LBi:,LBj:)
195 real(r8), intent(inout) :: beta(LBi:,LBj:)
196# endif
197# ifdef VAR_RHO_2D_NOT_YET
198 real(r8), intent(out) :: rhoA(LBi:,LBj:)
199 real(r8), intent(out) :: rhoS(LBi:,LBj:)
200 real(r8), intent(out) :: tl_rhoA(LBi:,LBj:)
201 real(r8), intent(out) :: tl_rhoS(LBi:,LBj:)
202# endif
203# ifdef BV_FREQUENCY_NOT_YET
204 real(r8), intent(out) :: tl_bvf(LBi:,LBj:,0:)
205# endif
206# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
207 defined bulk_fluxes
208 real(r8), intent(out) :: tl_alpha(LBi:,LBj:)
209 real(r8), intent(out) :: tl_beta(LBi:,LBj:)
210# ifdef LMD_DDMIX_NOT_YET
211 real(r8), intent(out) :: tl_alfaobeta(LBi:,LBj:,0:)
212# endif
213# endif
214# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
215 real(r8), intent(out) :: tl_pden(LBi:,LBj:,:)
216# endif
217 real(r8), intent(out) :: rho(LBi:,LBj:,:)
218 real(r8), intent(out) :: tl_rho(LBi:,LBj:,:)
219# else
220# ifdef MASKING
221 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
222# endif
223# ifdef VAR_RHO_2D_NOT_YET
224 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
225# endif
226 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
227 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
228 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
229# ifdef VAR_RHO_2D_NOT_YET
230 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
231# endif
232 real(r8), intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
233 real(r8), intent(in) :: tl_z_w(LBi:UBi,LBj:UBj,0:N(ng))
234 real(r8), intent(in) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
235# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
236 defined bulk_fluxes
237 real(r8), intent(inout) :: alpha(LBi:UBi,LBj:UBj)
238 real(r8), intent(inout) :: beta(LBi:UBi,LBj:UBj)
239# endif
240# ifdef VAR_RHO_2D_NOT_YET
241 real(r8), intent(out) :: rhoA(LBi:UBi,LBj:UBj)
242 real(r8), intent(out) :: rhoS(LBi:UBi,LBj:UBj)
243 real(r8), intent(out) :: tl_rhoA(LBi:UBi,LBj:UBj)
244 real(r8), intent(out) :: tl_rhoS(LBi:UBi,LBj:UBj)
245# endif
246# ifdef BV_FREQUENCY_NOT_YET
247 real(r8), intent(out) :: tl_bvf(LBi:UBi,LBj:UBj,0:N(ng))
248# endif
249# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
250 defined bulk_fluxes
251 real(r8), intent(out) :: tl_alpha(LBi:UBi,LBj:UBj)
252 real(r8), intent(out) :: tl_beta(LBi:UBi,LBj:UBj)
253# ifdef LMD_DDMIX_NOT_YET
254 real(r8), intent(out) :: tl_alfaobeta(LBi:UBi,LBj:UBj,0:N(ng))
255# endif
256# endif
257# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
258 real(r8), intent(out) :: tl_pden(LBi:UBi,LBj:UBj,N(ng))
259# endif
260 real(r8), intent(out) :: rho(LBi:UBi,LBj:UBj,N(ng))
261 real(r8), intent(out) :: tl_rho(LBi:UBi,LBj:UBj,N(ng))
262# endif
263!
264! Local variable declarations.
265!
266 integer :: i, ised, itrc, j, k
267
268 real(r8) :: SedDen, Tp, Tpr10, Ts, Tt, sqrtTs
269 real(r8) :: tl_SedDen, tl_Tp, tl_Tpr10, tl_Ts, tl_Tt, tl_sqrtTs
270# ifdef BV_FREQUENCY_NOT_YET
271 real(r8) :: bulk_dn, bulk_up, den_dn, den_up
272 real(r8) :: tl_bulk_dn, tl_bulk_up, tl_den_dn, tl_den_up
273# endif
274 real(r8) :: cff, cff1, cff2, cff3
275 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3
276
277 real(r8), dimension(0:9) :: C
278 real(r8), dimension(0:9) :: tl_C
279# ifdef EOS_TDERIVATIVE
280 real(r8), dimension(0:9) :: dCdT(0:9)
281 real(r8), dimension(0:9) :: tl_dCdT(0:9)
282 real(r8), dimension(0:9) :: d2Cd2T(0:9)
283
284 real(r8), dimension(IminS:ImaxS,N(ng)) :: DbulkDS
285 real(r8), dimension(IminS:ImaxS,N(ng)) :: DbulkDT
286 real(r8), dimension(IminS:ImaxS,N(ng)) :: Dden1DS
287 real(r8), dimension(IminS:ImaxS,N(ng)) :: Dden1DT
288 real(r8), dimension(IminS:ImaxS,N(ng)) :: Scof
289 real(r8), dimension(IminS:ImaxS,N(ng)) :: Tcof
290 real(r8), dimension(IminS:ImaxS,N(ng)) :: wrk
291
292 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_DbulkDS
293 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_DbulkDT
294 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Dden1DS
295 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Dden1DT
296 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Scof
297 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Tcof
298 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_wrk
299# endif
300 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk
301 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk0
302 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk1
303 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk2
304 real(r8), dimension(IminS:ImaxS,N(ng)) :: den
305 real(r8), dimension(IminS:ImaxS,N(ng)) :: den1
306
307 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk
308 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk0
309 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk1
310 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk2
311 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_den
312 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_den1
313
314# include "set_bounds.h"
315!
316!=======================================================================
317! Nonlinear equation of state. Notice that this equation of state
318! is only valid for potential temperature range of -2C to 40C and
319! a salinity range of 0 PSU to 42 PSU.
320!=======================================================================
321!
322 DO j=jstrt,jendt
323 DO k=1,n(ng)
324 DO i=istrt,iendt
325!
326! Check temperature and salinity lower values. Assign depth to the
327! pressure.
328!
329 tt=max(-2.0_r8,t(i,j,k,nrhs,itemp))
330 tl_tt=(0.5_r8-sign(0.5_r8,-2.0_r8-t(i,j,k,nrhs,itemp)))* &
331 & tl_t(i,j,k,nrhs,itemp)- &
332# ifdef TL_IOMS
333 & 2.0_r8*(0.5_r8+sign(0.5_r8, &
334 & -2.0_r8-t(i,j,k,nrhs,itemp)))
335# endif
336# ifdef SALINITY
337 ts=max(0.0_r8,t(i,j,k,nrhs,isalt))
338 tl_ts=(0.5_r8-sign(0.5_r8,-t(i,j,k,nrhs,isalt)))* &
339 & tl_t(i,j,k,nrhs,isalt)
340 sqrtts=sqrt(ts)
341 IF (ts.ne.0.0_r8) THEN
342 tl_sqrtts=0.5_r8*(tl_ts/sqrtts)+ &
343# ifdef TL_IOMS
344 & 0.5_r8*sqrtts
345# endif
346 ELSE
347 tl_sqrtts=0.0_r8
348 END IF
349# else
350 ts=0.0_r8
351 tl_ts=0.0_r8
352 sqrtts=0.0_r8
353 tl_sqrtts=0.0_r8
354# endif
355 tp=z_r(i,j,k)
356 tl_tp=tl_z_r(i,j,k)
357 tpr10=0.1_r8*tp
358 tl_tpr10=0.1_r8*tl_tp
359!
360!-----------------------------------------------------------------------
361! Compute BASIC STATE and tangent linear density (kg/m3) at standard
362! one atmosphere pressure.
363!-----------------------------------------------------------------------
364!
365 c(0)=q00+tt*(q01+tt*(q02+tt*(q03+tt*(q04+tt*q05))))
366 c(1)=u00+tt*(u01+tt*(u02+tt*(u03+tt*u04)))
367 c(2)=v00+tt*(v01+tt*v02)
368# ifdef EOS_TDERIVATIVE
369!
370 dcdt(0)=q01+tt*(2.0_r8*q02+tt*(3.0_r8*q03+tt*(4.0_r8*q04+ &
371 & tt*5.0_r8*q05)))
372 dcdt(1)=u01+tt*(2.0_r8*u02+tt*(3.0_r8*u03+tt*4.0_r8*u04))
373 dcdt(2)=v01+tt*2.0_r8*v02
374# endif
375 tl_c(0)=tl_tt*dcdt(0)+ &
376# ifdef TL_IOMS
377 & q00-tt*tt*(q02+tt*(2.0_r8*q03+tt*(3.0_r8*q04+ &
378 & tt*4.0_r8*q05)))
379# endif
380 tl_c(1)=tl_tt*dcdt(1)+ &
381# ifdef TL_IOMS
382 & u00-tt*tt*(u02+tt*(2.0_r8*u03+tt*3.0_r8*u04))
383# endif
384 tl_c(2)=tl_tt*dcdt(2)+ &
385# ifdef TL_IOMS
386 & v00-v02*tt*tt
387# endif
388!
389 den1(i,k)=c(0)+ts*(c(1)+sqrtts*c(2)+ts*w00)
390 tl_den1(i,k)=tl_c(0)+ &
391 & tl_ts*(c(1)+sqrtts*c(2)+ts*w00)+ &
392 & ts*(tl_c(1)+tl_sqrtts*c(2)+ &
393 & sqrtts*tl_c(2)+tl_ts*w00)- &
394# ifdef TL_IOMS
395 & ts*(c(1)+2.0_r8*sqrtts*c(2)+ts*w00)
396# endif
397# ifdef EOS_TDERIVATIVE
398!
399! Compute d(den1)/d(S) and d(den1)/d(T) derivatives used in the
400! computation of thermal expansion and saline contraction
401! coefficients.
402!
403 d2cd2t(0)=2.0_r8*q02+tt*(6.0_r8*q03+tt*(12.0_r8*q04+ &
404 & tt*20.0_r8*q05))
405 d2cd2t(1)=2.0_r8*u02+tt*(6.0_r8*u03+tt*12.0_r8*u04)
406 d2cd2t(2)=2.0_r8*v02
407!
408 tl_dcdt(0)=tl_tt*d2cd2t(0)+ &
409# ifdef TL_IOMS
410 & q01-tt*tt*(3.0_r8*q03+tt*(8.0_r8*q04+ &
411 & tt*15.0_r8*q05*tt))
412# endif
413 tl_dcdt(1)=tl_tt*d2cd2t(1)+ &
414# ifdef TL_IOMS
415 & u01-tt*tt*(3.0_r8*u03+tt*8.0_r8*u04)
416# endif
417 tl_dcdt(2)=tl_tt*d2cd2t(2)+ &
418# ifdef TL_IOMS
419 & v01
420# endif
421!
422 dden1ds(i,k)=c(1)+1.5_r8*c(2)*sqrtts+2.0_r8*w00*ts
423 dden1dt(i,k)=dcdt(0)+ts*(dcdt(1)+sqrtts*dcdt(2))
424!
425 tl_dden1ds(i,k)=tl_c(1)+ &
426 & 1.5_r8*(tl_c(2)*sqrtts+ &
427 & c(2)*tl_sqrtts)+ &
428 & 2.0_r8*w00*tl_ts- &
429# ifdef TL_IOMS
430 & 1.5_r8*c(2)*sqrtts
431# endif
432 tl_dden1dt(i,k)=tl_dcdt(0)+ &
433 & tl_ts*(dcdt(1)+sqrtts*dcdt(2))+ &
434 & ts*(tl_dcdt(1)+tl_sqrtts*dcdt(2)+ &
435 & sqrtts*tl_dcdt(2))- &
436# ifdef TL_IOMS
437 & ts*(dcdt(1)+2.0_r8*sqrtts*dcdt(2))
438# endif
439# endif
440!
441!-----------------------------------------------------------------------
442! Compute BASIC STATE and tangent linear secant bulk modulus.
443!-----------------------------------------------------------------------
444!
445 c(3)=a00+tt*(a01+tt*(a02+tt*(a03+tt*a04)))
446 c(4)=b00+tt*(b01+tt*(b02+tt*b03))
447 c(5)=d00+tt*(d01+tt*d02)
448 c(6)=e00+tt*(e01+tt*(e02+tt*e03))
449 c(7)=f00+tt*(f01+tt*f02)
450 c(8)=g01+tt*(g02+tt*g03)
451 c(9)=h00+tt*(h01+tt*h02)
452# ifdef EOS_TDERIVATIVE
453!
454 dcdt(3)=a01+tt*(2.0_r8*a02+tt*(3.0_r8*a03+tt*4.0_r8*a04))
455 dcdt(4)=b01+tt*(2.0_r8*b02+tt*3.0_r8*b03)
456 dcdt(5)=d01+tt*2.0_r8*d02
457 dcdt(6)=e01+tt*(2.0_r8*e02+tt*3.0_r8*e03)
458 dcdt(7)=f01+tt*2.0_r8*f02
459 dcdt(8)=g02+tt*2.0_r8*g03
460 dcdt(9)=h01+tt*2.0_r8*h02
461# endif
462!
463 tl_c(3)=tl_tt*dcdt(3)+ &
464# ifdef TL_IOMS
465 & a00-tt*tt*(a02+tt*(2.0_r8*a03+tt*3.0_r8*a04))
466# endif
467 tl_c(4)=tl_tt*dcdt(4)+ &
468# ifdef TL_IOMS
469 & b00-tt*tt*(b02+tt*2.0_r8*b03)
470# endif
471 tl_c(5)=tl_tt*dcdt(5)+ &
472# ifdef TL_IOMS
473 & d00-tt*tt*d02
474# endif
475 tl_c(6)=tl_tt*dcdt(6)+ &
476# ifdef TL_IOMS
477 & e00-tt*tt*(e02+tt*2.0_r8*e03)
478# endif
479 tl_c(7)=tl_tt*dcdt(7)+ &
480# ifdef TL_IOMS
481 & f00-tt*tt*f02
482# endif
483 tl_c(8)=tl_tt*dcdt(8)+ &
484# ifdef TL_IOMS
485 & g01-tt*tt*g03
486# endif
487 tl_c(9)=tl_tt*dcdt(9)+ &
488# ifdef TL_IOMS
489 & h00-tt*tt*h02
490# endif
491!
492 bulk0(i,k)=c(3)+ts*(c(4)+sqrtts*c(5))
493 bulk1(i,k)=c(6)+ts*(c(7)+sqrtts*g00)
494 bulk2(i,k)=c(8)+ts*c(9)
495 bulk(i,k)=bulk0(i,k)-tp*(bulk1(i,k)-tp*bulk2(i,k))
496!
497 tl_bulk0(i,k)=tl_c(3)+ &
498 & tl_ts*(c(4)+sqrtts*c(5))+ &
499 & ts*(tl_c(4)+tl_sqrtts*c(5)+ &
500 & sqrtts*tl_c(5))- &
501# ifdef TL_IOMS
502 & ts*(c(4)+2.0_r8*sqrtts*c(5))
503# endif
504 tl_bulk1(i,k)=tl_c(6)+ &
505 & tl_ts*(c(7)+sqrtts*g00)+ &
506 & ts*(tl_c(7)+tl_sqrtts*g00)- &
507# ifdef TL_IOMS
508 & ts*(c(7)+sqrtts*g00)
509# endif
510 tl_bulk2(i,k)=tl_c(8)+tl_ts*c(9)+ts*tl_c(9)- &
511# ifdef TL_IOMS
512 & ts*c(9)
513# endif
514 tl_bulk(i,k)=tl_bulk0(i,k)- &
515 & tl_tp*(bulk1(i,k)-tp*bulk2(i,k))- &
516 & tp*(tl_bulk1(i,k)- &
517 & tl_tp*bulk2(i,k)- &
518 & tp*tl_bulk2(i,k))+ &
519# ifdef TL_IOMS
520 & tp*(bulk1(i,k)-2.0_r8*tp*bulk2(i,k))
521# endif
522
523# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
524 defined bulk_fluxes
525!
526! Compute d(bulk)/d(S) and d(bulk)/d(T) derivatives used
527! in the computation of thermal expansion and saline contraction
528! coefficients.
529!
530 d2cd2t(3)=2.0_r8*a02+tt*(6.0_r8*a03+tt*12.0_r8*a04)
531 d2cd2t(4)=2.0_r8*b02+tt*6.0_r8*b03
532 d2cd2t(5)=2.0_r8*d02
533 d2cd2t(6)=2.0_r8*e02+tt*6.0_r8*e03
534 d2cd2t(7)=2.0_r8*f02
535 d2cd2t(8)=2.0_r8*g03
536 d2cd2t(9)=2.0_r8*h02
537!
538 tl_dcdt(3)=tl_tt*d2cd2t(3)+ &
539# ifdef TL_IOMS
540 & a01-tt*tt*(3.0_r8*a03+tt*8.0_r8*a04)
541# endif
542 tl_dcdt(4)=tl_tt*d2cd2t(4)+ &
543# ifdef TL_IOMS
544 & b01-tt*tt*3.0_r8*b03
545# endif
546 tl_dcdt(5)=tl_tt*d2cd2t(5)+ &
547# ifdef TL_IOMS
548 & d01
549# endif
550 tl_dcdt(6)=tl_tt*d2cd2t(6)+ &
551# ifdef TL_IOMS
552 & e01-tt*tt*3.0_r8*e03
553# endif
554 tl_dcdt(7)=tl_tt*d2cd2t(7)+ &
555# ifdef TL_IOMS
556 & f01
557# endif
558 tl_dcdt(8)=tl_tt*d2cd2t(8)+ &
559# ifdef TL_IOMS
560 & g02
561# endif
562 tl_dcdt(9)=tl_tt*d2cd2t(9)+ &
563# ifdef TL_IOMS
564 & h01
565# endif
566!
567 dbulkds(i,k)=c(4)+sqrtts*1.5_r8*c(5)- &
568 & tp*(c(7)+sqrtts*1.5_r8*g00-tp*c(9))
569 dbulkdt(i,k)=dcdt(3)+ts*(dcdt(4)+sqrtts*dcdt(5))- &
570 & tp*(dcdt(6)+ts*dcdt(7)- &
571 & tp*(dcdt(8)+ts*dcdt(9)))
572!
573 tl_dbulkds(i,k)=tl_c(4)+ &
574 & 1.5_r8*(tl_sqrtts*c(5)+ &
575 & sqrtts*tl_c(5))- &
576 & tl_tp*(c(7)+sqrtts*1.5_r8*g00- &
577 & tp*c(9))- &
578 & tp*(tl_c(7)+tl_sqrtts*1.5_r8*g00- &
579 & tl_tp*c(9)-tp*tl_c(9))- &
580# ifdef TL_IOMS
581 & sqrtts*1.5_r8*c(5)+ &
582 & tp*(c(7)+sqrtts*1.5_r8*g00-2.0_r8*tp*c(9))
583# endif
584 tl_dbulkdt(i,k)=tl_dcdt(3)+ &
585 & tl_ts*(dcdt(4)+sqrtts*dcdt(5))+ &
586 & ts*(tl_dcdt(4)+tl_sqrtts*dcdt(5)+ &
587 & sqrtts*tl_dcdt(5))- &
588 & tl_tp*(dcdt(6)+ts*dcdt(7)- &
589 & tp*(dcdt(8)+ts*dcdt(9)))- &
590 & tp*(tl_dcdt(6)+tl_ts*dcdt(7)+ts*tl_dcdt(7)- &
591 & tl_tp*(dcdt(8)+ts*dcdt(9))- &
592 & tp*(tl_dcdt(8)+tl_ts*dcdt(9)+ &
593 & ts*tl_dcdt(9)))- &
594# ifdef TL_IOMS
595 & ts*(dcdt(4)+2.0_r8*sqrtts*dcdt(5))+ &
596 & tp*(dcdt(6)+2.0_r8*ts*dcdt(7)- &
597 & tp*(2.0_r8*dcdt(8)+ &
598 & 3.0_r8*ts*dcdt(9)))
599# endif
600# endif
601!
602!-----------------------------------------------------------------------
603! Compute local "in situ" density anomaly (kg/m3 - 1000).
604!-----------------------------------------------------------------------
605!
606 cff=1.0_r8/(bulk(i,k)+tpr10)
607 tl_cff=-cff*cff*(tl_bulk(i,k)+tl_tpr10)+ &
608# ifdef TL_IOMS
609 & 2.0_r8*cff
610# endif
611 den(i,k)=den1(i,k)*bulk(i,k)*cff
612 tl_den(i,k)=tl_den1(i,k)*bulk(i,k)*cff+ &
613 & den1(i,k)*(tl_bulk(i,k)*cff+ &
614 & bulk(i,k)*tl_cff)- &
615# ifdef TL_IOMS
616 & 2.0_r8*den(i,k)
617# endif
618# if defined SEDIMENT_NOT_YET && defined SED_DENS_NOT_YET
619 sedden=0.0_r8
620 tl_sedden=0.0_r8
621 DO ised=1,nst
622 itrc=idsed(ised)
623 cff1=1.0_r8/srho(ised,ng)
624 sedden=sedden+ &
625 & t(i,j,k,nrhs,itrc)* &
626 & (srho(ised,ng)-den(i,k))*cff1
627 tl_sedden=tl_sedden+ &
628 & (tl_t(i,j,k,nrhs,itrc)* &
629 & (srho(ised,ng)-den(i,k))- &
630 & t(i,j,k,nrhs,itrc)* &
631 & tl_den(i,k))*cff1+ &
632# ifdef TL_IOMS
633 & t(i,j,k,nrhs,itrc)*den(i,k)*cff1
634# endif
635 END DO
636 den(i,k)=den(i,k)+sedden
637 tl_den(i,k)=tl_den(i,k)+tl_sedden
638# endif
639 den(i,k)=den(i,k)-1000.0_r8
640# ifdef TL_IOMS
641 tl_den(i,k)=tl_den(i,k)-1000.0_r8
642# endif
643# ifdef MASKING
644 den(i,k)=den(i,k)*rmask(i,j)
645 tl_den(i,k)=tl_den(i,k)*rmask(i,j)
646# endif
647 END DO
648 END DO
649
650# ifdef VAR_RHO_2D_NOT_YET
651!
652!-----------------------------------------------------------------------
653! Compute vertical averaged density (rhoA) and density perturbation
654! (rhoS) used in barotropic pressure gradient.
655!-----------------------------------------------------------------------
656!
657 DO i=istrt,iendt
658 cff1=den(i,n(ng))*hz(i,j,n(ng))
659 tl_cff1=tl_den(i,n(ng))*hz(i,j,n(ng))+ &
660 & den(i,n(ng))*tl_hz(i,j,n(ng))- &
661# ifdef TL_IOMS
662 & cff1
663# endif
664 rhos(i,j)=0.5_r8*cff1*hz(i,j,n(ng))
665 tl_rhos(i,j)=0.5_r8*(tl_cff1*hz(i,j,n(ng))+ &
666 & cff1*tl_hz(i,j,n(ng)))- &
667# ifdef TL_IOMS
668 & rhos(i,j)
669# endif
670 rhoa(i,j)=cff1
671 tl_rhoa(i,j)=tl_cff1
672 END DO
673 DO k=n(ng)-1,1,-1
674 DO i=istrt,iendt
675 cff1=den(i,k)*hz(i,j,k)
676 tl_cff1=tl_den(i,k)*hz(i,j,k)+ &
677 & den(i,k)*tl_hz(i,j,k)- &
678# ifdef TL_IOMS
679 & cff1
680# endif
681 rhos(i,j)=rhos(i,j)+hz(i,j,k)*(rhoa(i,j)+0.5_r8*cff1)
682 tl_rhos(i,j)=tl_rhos(i,j)+ &
683 & tl_hz(i,j,k)*(rhoa(i,j)+0.5_r8*cff1)+ &
684 & hz(i,j,k)*(tl_rhoa(i,j)+0.5_r8*tl_cff1)- &
685# ifdef TL_IOMS
686 & hz(i,j,k)*(rhoa(i,j)+0.5_r8*cff1)
687# endif
688 rhoa(i,j)=rhoa(i,j)+cff1
689 tl_rhoa(i,j)=tl_rhoa(i,j)+tl_cff1
690 END DO
691 END DO
692 cff2=1.0_r8/rho0
693 DO i=istrt,iendt
694 cff1=1.0_r8/(z_w(i,j,n(ng))-z_w(i,j,0))
695 tl_cff1=-cff1*cff1*(tl_z_w(i,j,n(ng))-tl_z_w(i,j,0))+ &
696# ifdef TL_IOMS
697 & 2.0_r8*cff1
698# endif
699!
700! Here we reverse the order of the NL and TL operations since an
701! intermeridiate value of rhoA and rhoS is needed because they are
702! recursive.
703!
704 tl_rhoa(i,j)=cff2*(tl_cff1*rhoa(i,j)+cff1*tl_rhoa(i,j))
705 rhoa(i,j)=cff2*cff1*rhoa(i,j)
706# ifdef TL_IOMS
707 tl_rhoa(i,j)=tl_rhoa(i,j)-rhoa(i,j)
708# endif
709 tl_rhos(i,j)=2.0_r8*cff2* &
710 & cff1*(2.0_r8*tl_cff1*rhos(i,j)+ &
711 & cff1*tl_rhos(i,j))
712 rhos(i,j)=2.0_r8*cff1*cff1*cff2*rhos(i,j)
713# ifdef TL_IOMS
714 tl_rhos(i,j)=tl_rhos(i,j)-2.0_r8*rhos(i,j)
715# endif
716 END DO
717# endif
718
719# if defined BV_FREQUENCY_NOT_YET
720!
721!-----------------------------------------------------------------------
722! Compute Brunt-Vaisala frequency (1/s2) at horizontal RHO-points
723! and vertical W-points:
724!
725! bvf = - g/rho d(rho)/d(z).
726!
727! The density anomaly difference is computed by lowering/rising the
728! water parcel above/below adiabatically at W-point depth "z_w".
729!-----------------------------------------------------------------------
730!
731 DO k=1,n(ng)-1
732 DO i=istrt,iendt
733 bulk_up=bulk0(i,k+1)- &
734 & z_w(i,j,k)*(bulk1(i,k+1)- &
735 & bulk2(i,k+1)*z_w(i,j,k))
736 tl_bulk_up=tl_bulk0(i,k+1)- &
737 & tl_z_w(i,j,k)*(bulk1(i,k+1)- &
738 & bulk2(i,k+1)*z_w(i,j,k))- &
739 & z_w(i,j,k)*(tl_bulk1(i,k+1)- &
740 & tl_bulk2(i,k+1)*z_w(i,j,k)- &
741 & bulk2(i,k+1)*tl_z_w(i,j,k))+ &
742# ifdef TL_IOMS
743 & z_w(i,j,k)*(bulk1(i,k+1)- &
744 & 2.0_r8*bulk2(i,k+1)*z_w(i,j,k))
745# endif
746 bulk_dn=bulk0(i,k )- &
747 & z_w(i,j,k)*(bulk1(i,k )- &
748 & bulk2(i,k )*z_w(i,j,k))
749 tl_bulk_dn=tl_bulk0(i,k )- &
750 & tl_z_w(i,j,k)*(bulk1(i,k )- &
751 & bulk2(i,k )*z_w(i,j,k))- &
752 & z_w(i,j,k)*(tl_bulk1(i,k )- &
753 & tl_bulk2(i,k )*z_w(i,j,k)- &
754 & bulk2(i,k )*tl_z_w(i,j,k))+ &
755# ifdef TL_IOMS
756 & z_w(i,j,k)*(bulk1(i,k )- &
757 & 2.0_r8*bulk2(i,k )*z_w(i,j,k))
758# endif
759 cff1=1.0_r8/(bulk_up+0.1_r8*z_w(i,j,k))
760 cff2=1.0_r8/(bulk_dn+0.1_r8*z_w(i,j,k))
761 tl_cff1=-cff1*cff1*(tl_bulk_up+0.1_r8*tl_z_w(i,j,k))+ &
762# ifdef TL_IOMS
763 & 2.0_r8*cff1
764# endif
765 tl_cff2=-cff2*cff2*(tl_bulk_dn+0.1_r8*tl_z_w(i,j,k))+ &
766# ifdef TL_IOMS
767 & 2.0_r8*cff2
768# endif
769 den_up=cff1*(den1(i,k+1)*bulk_up)
770 den_dn=cff2*(den1(i,k )*bulk_dn)
771 tl_den_up=tl_cff1*(den1(i,k+1)*bulk_up)+ &
772 & cff1*(tl_den1(i,k+1)*bulk_up+ &
773 & den1(i,k+1)*tl_bulk_up)- &
774# ifdef TL_IOMS
775 & 2.0_r8*den_up
776# endif
777 tl_den_dn=tl_cff2*(den1(i,k )*bulk_dn)+ &
778 & cff2*(tl_den1(i,k )*bulk_dn+ &
779 & den1(i,k )*tl_bulk_dn)- &
780# ifdef TL_IOMS
781 & 2.0_r8*den_dn
782# endif
783!^ bvf(i,j,k)=-g*(den_up-den_dn)/ &
784!^ & (0.5_r8*(den_up+den_dn)* &
785!^ & (z_r(i,j,k+1)-z_r(i,j,k)))
786!^
787 cff3=1.0_r8/(0.5_r8*(den_up+den_dn)* &
788 & (z_r(i,j,k+1)-z_r(i,j,k)))
789 tl_cff3=-cff3*cff3* &
790 & 0.5_r8*((tl_den_up+tl_den_dn)* &
791 & (z_r(i,j,k+1)-z_r(i,j,k))+ &
792 & (den_up+den_dn)* &
793 & (tl_z_r(i,j,k+1)-tl_z_r(i,j,k)))+ &
794# ifdef TL_IOMS
795 & 3.0_r8*cff3
796# endif
797 tl_bvf(i,j,k)=-g*((tl_den_up-tl_den_dn)*cff3+ &
798 & (den_up-den_dn)*tl_cff3)+ &
799# ifdef TL_IOMS
800 & 2.0_r8*g*(den_up-den_dn)*cff3
801# endif
802 END DO
803 END DO
804 DO i=istrt,iendt
805!^ bvf(i,j,0)=0.0_r8
806!^
807 tl_bvf(i,j,0)=0.0_r8
808!^ bvf(i,j,N(ng))=0.0_r8
809!^
810 tl_bvf(i,j,n(ng))=0.0_r8
811 END DO
812# endif
813
814# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
815 defined bulk_fluxes
816!
817!-----------------------------------------------------------------------
818! Compute thermal expansion (1/Celsius) and saline contraction
819! (1/PSU) coefficients.
820!-----------------------------------------------------------------------
821!
822# ifdef LMD_DDMIX_NOT_YET
823 DO k=1,n(ng)
824# else
825 DO k=n(ng),n(ng)
826# endif
827 DO i=istrt,iendt
828 tpr10=0.1_r8*z_r(i,j,k)
829 tl_tpr10=0.1_r8*tl_z_r(i,j,k)
830!
831! Compute thermal expansion and saline contraction coefficients.
832!
833 cff=bulk(i,k)+tpr10
834 tl_cff=tl_bulk(i,k)+tl_tpr10
835 cff1=tpr10*den1(i,k)
836 tl_cff1=tl_tpr10*den1(i,k)+tpr10*tl_den1(i,k)- &
837# ifdef TL_IOMS
838 & cff1
839# endif
840 cff2=bulk(i,k)*cff
841 tl_cff2=tl_bulk(i,k)*cff+bulk(i,k)*tl_cff- &
842# ifdef TL_IOMS
843 & cff2
844# endif
845 wrk(i,k)=(den(i,k)+1000.0_r8)*cff*cff
846 tl_wrk(i,k)=cff*(cff*tl_den(i,k)+ &
847 & 2.0_r8*tl_cff*(den(i,k)+1000.0_r8))- &
848# ifdef TL_IOMS
849 & cff*cff*(2.0_r8*den(i,k)+1000.0_r8)
850# endif
851 tcof(i,k)=-(dbulkdt(i,k)*cff1+ &
852 & dden1dt(i,k)*cff2)
853 tl_tcof(i,k)=-(tl_dbulkdt(i,k)*cff1+ &
854 & dbulkdt(i,k)*tl_cff1+ &
855 & tl_dden1dt(i,k)*cff2+ &
856 & dden1dt(i,k)*tl_cff2)- &
857# ifdef TL_IOMS
858 & tcof(i,k)
859# endif
860 scof(i,k)= (dbulkds(i,k)*cff1+ &
861 & dden1ds(i,k)*cff2)
862 tl_scof(i,k)= (tl_dbulkds(i,k)*cff1+ &
863 & dbulkds(i,k)*tl_cff1+ &
864 & tl_dden1ds(i,k)*cff2+ &
865 & dden1ds(i,k)*tl_cff2)- &
866# ifdef TL_IOMS
867 & scof(i,k)
868# endif
869# ifdef LMD_DDMIX_NOT_YET
870!^ alfaobeta(i,j,k)=Tcof(i,k)/Scof(i,k)
871!^
872 tl_alfaobeta(i,j,k)=(tl_tcof(i,k)*scof(i,k)- &
873 & tcof(i,k)*tl_scof(i,k))/ &
874 & (scof(i,k)*scof(i,k))+ &
875# ifdef TL_IOMS
876 & tcof(i,k)/scof(i,k)
877# endif
878# endif
879 END DO
880 IF (k.eq.n(ng)) THEN
881 DO i=istrt,iendt
882 cff=1.0_r8/wrk(i,n(ng))
883 tl_cff=-cff*cff*tl_wrk(i,n(ng))+ &
884# ifdef TL_IOMS
885 & 2.0_r8*cff
886# endif
887 alpha(i,j)=cff*tcof(i,n(ng))
888 tl_alpha(i,j)=tl_cff*tcof(i,n(ng))+cff*tl_tcof(i,n(ng))- &
889# ifdef TL_IOMS
890 & alpha(i,j)
891# endif
892 beta(i,j)=cff*scof(i,n(ng))
893 tl_beta(i,j)=tl_cff*scof(i,n(ng))+cff*tl_scof(i,n(ng))- &
894# ifdef TL_IOMS
895 & beta(i,j)
896# endif
897 END DO
898 END IF
899 END DO
900# endif
901!
902!-----------------------------------------------------------------------
903! Load "in situ" density anomaly (kg/m3 - 1000) and potential
904! density anomaly (kg/m3 - 1000) referenced to the surface into global
905! arrays. Notice that this is done in a separate (i,k) DO-loops to
906! facilitate the adjoint.
907!-----------------------------------------------------------------------
908!
909 DO k=1,n(ng)
910 DO i=istrt,iendt
911 rho(i,j,k)=den(i,k)
912 tl_rho(i,j,k)=tl_den(i,k)
913# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
914!^ pden(i,j,k)=(den1(i,k)-1000.0_r8) ! This gives a fatal
915!^ ! result in 4D-Var
916 tl_pden(i,j,k)=tl_den1(i,k)- &
917# ifdef TL_IOMS
918 & 1000.0_r8 ! posterior error...
919# endif
920# ifdef MASKING
921!^ pden(i,j,k)=pden(i,k)*rmask(i,j)
922!^
923 tl_pden(i,j,k)=tl_pden(i,k)*rmask(i,j)
924# endif
925# endif
926 END DO
927 END DO
928 END DO
929!
930!-----------------------------------------------------------------------
931! Exchange boundary data.
932!-----------------------------------------------------------------------
933!
934 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
935 CALL exchange_r3d_tile (ng, tile, &
936 & lbi, ubi, lbj, ubj, 1, n(ng), &
937 & rho)
938 CALL exchange_r3d_tile (ng, tile, &
939 & lbi, ubi, lbj, ubj, 1, n(ng), &
940 & tl_rho)
941
942# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
943!^ CALL exchange_r3d_tile (ng, tile, &
944!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
945!^ & pden)
946!^
947 CALL exchange_r3d_tile (ng, tile, &
948 & lbi, ubi, lbj, ubj, 1, n(ng), &
949 & tl_pden)
950# endif
951
952# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
953 defined bulk_fluxes_not_yet
954# ifdef LMD_DDMIX_NOT_YET
955!^ CALL exchange_w3d_tile (ng, tile, &
956!^ & LBi, UBi, LBj, UBj, 0, N(ng), &
957!^ & alfaobeta)
958!^
959 CALL exchange_w3d_tile (ng, tile, &
960 & lbi, ubi, lbj, ubj, 0, n(ng), &
961 & tl_alfaobeta)
962# endif
963 CALL exchange_r2d_tile (ng, tile, &
964 & lbi, ubi, lbj, ubj, &
965 & alpha)
966 CALL exchange_r2d_tile (ng, tile, &
967 & lbi, ubi, lbj, ubj, &
968 & tl_alpha)
969 CALL exchange_r2d_tile (ng, tile, &
970 & lbi, ubi, lbj, ubj, &
971 & beta)
972 CALL exchange_r2d_tile (ng, tile, &
973 & lbi, ubi, lbj, ubj, &
974 & tl_beta)
975# endif
976
977# ifdef VAR_RHO_2D_NOT_YET
978 CALL exchange_r2d_tile (ng, tile, &
979 & lbi, ubi, lbj, ubj, &
980 & rhoa)
981 CALL exchange_r2d_tile (ng, tile, &
982 & lbi, ubi, lbj, ubj, &
983 & tl_rhoa)
984 CALL exchange_r2d_tile (ng, tile, &
985 & lbi, ubi, lbj, ubj, &
986 & rhos)
987 CALL exchange_r2d_tile (ng, tile, &
988 & lbi, ubi, lbj, ubj, &
989 & tl_rhos)
990# endif
991
992# ifdef BV_FREQUENCY_NOT_YET
993!^ CALL exchange_w3d_tile (ng, tile, &
994!^ & LBi, UBi, LBj, UBj, 0, N(ng), &
995!^ & bvf)
996!^
997 CALL exchange_w3d_tile (ng, tile, &
998 & lbi, ubi, lbj, ubj, 0, n(ng), &
999 & tl_bvf)
1000# endif
1001 END IF
1002
1003# ifdef DISTRIBUTE
1004!
1005 CALL mp_exchange3d (ng, tile, model, 1, &
1006 & lbi, ubi, lbj, ubj, 1, n(ng), &
1007 & nghostpoints, &
1008 & ewperiodic(ng), nsperiodic(ng), &
1009 & rho)
1010 CALL mp_exchange3d (ng, tile, model, 1, &
1011 & lbi, ubi, lbj, ubj, 1, n(ng), &
1012 & nghostpoints, &
1013 & ewperiodic(ng), nsperiodic(ng), &
1014 & tl_rho)
1015
1016# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
1017!^ CALL mp_exchange3d (ng, tile, model, 1, &
1018!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
1019!^ & NghostPoints, &
1020!^ & EWperiodic(ng), NSperiodic(ng), &
1021!^ & pden)
1022!^
1023 CALL mp_exchange3d (ng, tile, model, 1, &
1024 & lbi, ubi, lbj, ubj, 1, n(ng), &
1025 & nghostpoints, &
1026 & ewperiodic(ng), nsperiodic(ng), &
1027 & tl_pden)
1028# endif
1029
1030# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
1031 defined bulk_fluxes
1032# ifdef LMD_DDMIX_NOT_YET
1033!^ CALL mp_exchange3d (ng, tile, model, 1, &
1034!^ & LBi, UBi, LBj, UBj, 0, N(ng), &
1035!^ & NghostPoints, &
1036!^ & EWperiodic(ng), NSperiodic(ng), &
1037!^ & alfaobeta)
1038!^
1039 CALL mp_exchange3d (ng, tile, model, 1, &
1040 & lbi, ubi, lbj, ubj, 0, n(ng), &
1041 & nghostpoints, &
1042 & ewperiodic(ng), nsperiodic(ng), &
1043 & tl_alfaobeta)
1044# endif
1045 CALL mp_exchange2d (ng, tile, model, 2, &
1046 & lbi, ubi, lbj, ubj, &
1047 & nghostpoints, &
1048 & ewperiodic(ng), nsperiodic(ng), &
1049 & alpha, beta)
1050 CALL mp_exchange2d (ng, tile, model, 2, &
1051 & lbi, ubi, lbj, ubj, &
1052 & nghostpoints, &
1053 & ewperiodic(ng), nsperiodic(ng), &
1054 & tl_alpha, tl_beta)
1055# endif
1056
1057# ifdef VAR_RHO_2D_NOT_YET
1058 CALL mp_exchange2d (ng, tile, model, 2, &
1059 & lbi, ubi, lbj, ubj, &
1060 & nghostpoints, &
1061 & ewperiodic(ng), nsperiodic(ng), &
1062 & rhoa, rhos)
1063 CALL mp_exchange2d (ng, tile, model, 2, &
1064 & lbi, ubi, lbj, ubj, &
1065 & nghostpoints, &
1066 & ewperiodic(ng), nsperiodic(ng), &
1067 & tl_rhoa, tl_rhos)
1068# endif
1069
1070# ifdef BV_FREQUENCY_NOT_YET
1071!^ CALL mp_exchange3d (ng, tile, model, 1, &
1072!^ & LBi, UBi, LBj, UBj, 0, N(ng), &
1073!^ & NghostPoints, &
1074!^ & EWperiodic(ng), NSperiodic(ng), &
1075!^ & bvf)
1076!^
1077 CALL mp_exchange3d (ng, tile, model, 1, &
1078 & lbi, ubi, lbj, ubj, 0, n(ng), &
1079 & nghostpoints, &
1080 & ewperiodic(ng), nsperiodic(ng), &
1081 & tl_bvf)
1082# endif
1083# endif
1084!
1085 RETURN
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
exchange_3d_mod
Definition exchange_3d.F:2
exchange_3d_mod::exchange_r3d_tile
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:283
exchange_3d_mod::exchange_w3d_tile
subroutine exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:920
mod_eoscoef
Definition mod_eoscoef.F:2
mod_eoscoef::b03
real(r8), parameter b03
Definition mod_eoscoef.F:32
mod_eoscoef::e02
real(r8), parameter e02
Definition mod_eoscoef.F:38
mod_eoscoef::h02
real(r8), parameter h02
Definition mod_eoscoef.F:49
mod_eoscoef::q03
real(r8), parameter q03
Definition mod_eoscoef.F:53
mod_eoscoef::a03
real(r8), parameter a03
Definition mod_eoscoef.F:27
mod_eoscoef::q04
real(r8), parameter q04
Definition mod_eoscoef.F:54
mod_eoscoef::q05
real(r8), parameter q05
Definition mod_eoscoef.F:55
mod_eoscoef::u01
real(r8), parameter u01
Definition mod_eoscoef.F:57
mod_eoscoef::f00
real(r8), parameter f00
Definition mod_eoscoef.F:40
mod_eoscoef::v01
real(r8), parameter v01
Definition mod_eoscoef.F:62
mod_eoscoef::g01
real(r8), parameter g01
Definition mod_eoscoef.F:44
mod_eoscoef::a04
real(r8), parameter a04
Definition mod_eoscoef.F:28
mod_eoscoef::f01
real(r8), parameter f01
Definition mod_eoscoef.F:41
mod_eoscoef::g00
real(r8), parameter g00
Definition mod_eoscoef.F:43
mod_eoscoef::u02
real(r8), parameter u02
Definition mod_eoscoef.F:58
mod_eoscoef::d01
real(r8), parameter d01
Definition mod_eoscoef.F:34
mod_eoscoef::w00
real(r8), parameter w00
Definition mod_eoscoef.F:64
mod_eoscoef::b00
real(r8), parameter b00
Definition mod_eoscoef.F:29
mod_eoscoef::u03
real(r8), parameter u03
Definition mod_eoscoef.F:59
mod_eoscoef::d00
real(r8), parameter d00
Definition mod_eoscoef.F:33
mod_eoscoef::d02
real(r8), parameter d02
Definition mod_eoscoef.F:35
mod_eoscoef::g03
real(r8), parameter g03
Definition mod_eoscoef.F:46
mod_eoscoef::b01
real(r8), parameter b01
Definition mod_eoscoef.F:30
mod_eoscoef::u04
real(r8), parameter u04
Definition mod_eoscoef.F:60
mod_eoscoef::u00
real(r8), parameter u00
Definition mod_eoscoef.F:56
mod_eoscoef::v02
real(r8), parameter v02
Definition mod_eoscoef.F:63
mod_eoscoef::q01
real(r8), parameter q01
Definition mod_eoscoef.F:51
mod_eoscoef::e00
real(r8), parameter e00
Definition mod_eoscoef.F:36
mod_eoscoef::h00
real(r8), parameter h00
Definition mod_eoscoef.F:47
mod_eoscoef::g02
real(r8), parameter g02
Definition mod_eoscoef.F:45
mod_eoscoef::e03
real(r8), parameter e03
Definition mod_eoscoef.F:39
mod_eoscoef::a00
real(r8), parameter a00
Definition mod_eoscoef.F:24
mod_eoscoef::a01
real(r8), parameter a01
Definition mod_eoscoef.F:25
mod_eoscoef::a02
real(r8), parameter a02
Definition mod_eoscoef.F:26
mod_eoscoef::b02
real(r8), parameter b02
Definition mod_eoscoef.F:31
mod_eoscoef::h01
real(r8), parameter h01
Definition mod_eoscoef.F:48
mod_eoscoef::e01
real(r8), parameter e01
Definition mod_eoscoef.F:37
mod_eoscoef::f02
real(r8), parameter f02
Definition mod_eoscoef.F:42
mod_eoscoef::v00
real(r8), parameter v00
Definition mod_eoscoef.F:61
mod_eoscoef::q02
real(r8), parameter q02
Definition mod_eoscoef.F:52
mod_eoscoef::q00
real(r8), parameter q00
Definition mod_eoscoef.F:50
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::nst
integer nst
Definition mod_param.F:521
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::g
real(dp) g
Definition mod_scalars.F:464
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787
mod_sediment
Definition sediment_mod.h:1
mod_sediment::srho
real(r8), dimension(:,:), allocatable srho
Definition sediment_mod.h:174
mod_sediment::idsed
integer, dimension(:), allocatable idsed
Definition sediment_mod.h:88
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037

References mod_eoscoef::a00, mod_eoscoef::a01, mod_eoscoef::a02, mod_eoscoef::a03, mod_eoscoef::a04, mod_eoscoef::b00, mod_eoscoef::b01, mod_eoscoef::b02, mod_eoscoef::b03, mod_eoscoef::d00, mod_eoscoef::d01, mod_eoscoef::d02, mod_eoscoef::e00, mod_eoscoef::e01, mod_eoscoef::e02, mod_eoscoef::e03, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), exchange_3d_mod::exchange_r3d_tile(), exchange_3d_mod::exchange_w3d_tile(), mod_eoscoef::f00, mod_eoscoef::f01, mod_eoscoef::f02, mod_scalars::g, mod_eoscoef::g00, mod_eoscoef::g01, mod_eoscoef::g02, mod_eoscoef::g03, mod_scalars::gorho0, mod_eoscoef::h00, mod_eoscoef::h01, mod_eoscoef::h02, mod_sediment::idsed, mod_scalars::isalt, mod_scalars::itemp, mp_exchange_mod::mp_exchange2d(), mp_exchange_mod::mp_exchange3d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::nst, mod_eoscoef::q00, mod_eoscoef::q01, mod_eoscoef::q02, mod_eoscoef::q03, mod_eoscoef::q04, mod_eoscoef::q05, mod_scalars::r0, mod_scalars::rho0, mod_scalars::s0, mod_scalars::scoef, mod_sediment::srho, mod_scalars::t0, mod_scalars::tcoef, mod_eoscoef::u00, mod_eoscoef::u01, mod_eoscoef::u02, mod_eoscoef::u03, mod_eoscoef::u04, mod_eoscoef::v00, mod_eoscoef::v01, mod_eoscoef::v02, and mod_eoscoef::w00.

Referenced by rp_rho_eos().

Here is the call graph for this function:
Here is the caller graph for this function: