A Modular Arbitrary-Order Ocean-Atmosphere Model -- Stochastic implementation
Data Types | Functions/Subroutines | Variables
inprod_analytic Module Reference

Inner products between the truncated set of basis functions for the ocean and atmosphere streamfunction fields. These are partly calculated using the analytical expressions from Cehelsky, P., & Tung, K. K. : Theories of multiple equilibria and weather regimes-A critical reexamination. Part II: Baroclinic two-layer models. Journal of the atmospheric sciences, 44(21), 3282-3303, 1987. More...

Data Types

type  atm_tensors
 Type holding the atmospheric inner products tensors. More...
 
type  atm_wavenum
 Atmospheric bloc specification type. More...
 
type  ocean_tensors
 Type holding the oceanic inner products tensors. More...
 
type  ocean_wavenum
 Oceanic bloc specification type. More...
 

Functions/Subroutines

real(kind=8) function b1 (Pi, Pj, Pk)
 Cehelsky & Tung Helper functions. More...
 
real(kind=8) function b2 (Pi, Pj, Pk)
 Cehelsky & Tung Helper functions. More...
 
real(kind=8) function delta (r)
 Integer Dirac delta function. More...
 
real(kind=8) function flambda (r)
 "Odd or even" function More...
 
real(kind=8) function s1 (Pj, Pk, Mj, Hk)
 Cehelsky & Tung Helper functions. More...
 
real(kind=8) function s2 (Pj, Pk, Mj, Hk)
 Cehelsky & Tung Helper functions. More...
 
real(kind=8) function s3 (Pj, Pk, Hj, Hk)
 Cehelsky & Tung Helper functions. More...
 
real(kind=8) function s4 (Pj, Pk, Hj, Hk)
 Cehelsky & Tung Helper functions. More...
 
real(kind=8) function calculate_a (i, j)
 Eigenvalues of the Laplacian (atmospheric) More...
 
real(kind=8) function calculate_b (i, j, k)
 Streamfunction advection terms (atmospheric) More...
 
real(kind=8) function calculate_c_atm (i, j)
 Beta term for the atmosphere. More...
 
real(kind=8) function calculate_d (i, j)
 Forcing of the ocean on the atmosphere. More...
 
real(kind=8) function calculate_g (i, j, k)
 Temperature advection terms (atmospheric) More...
 
real(kind=8) function calculate_s (i, j)
 Forcing (thermal) of the ocean on the atmosphere. More...
 
real(kind=8) function calculate_k (i, j)
 Forcing of the atmosphere on the ocean. More...
 
real(kind=8) function calculate_m (i, j)
 Forcing of the ocean fields on the ocean. More...
 
real(kind=8) function calculate_n (i, j)
 Beta term for the ocean. More...
 
real(kind=8) function calculate_o (i, j, k)
 Temperature advection term (passive scalar) More...
 
real(kind=8) function calculate_c_oc (i, j, k)
 Streamfunction advection terms (oceanic) More...
 
real(kind=8) function calculate_w (i, j)
 Short-wave radiative forcing of the ocean. More...
 
subroutine, public init_inprod
 Initialisation of the inner product. More...
 

Variables

type(atm_wavenum), dimension(:), allocatable, public awavenum
 Atmospheric blocs specification. More...
 
type(ocean_wavenum), dimension(:), allocatable, public owavenum
 Oceanic blocs specification. More...
 
type(atm_tensors), public atmos
 Atmospheric tensors. More...
 
type(ocean_tensors), public ocean
 Oceanic tensors. More...
 

Detailed Description

Inner products between the truncated set of basis functions for the ocean and atmosphere streamfunction fields. These are partly calculated using the analytical expressions from Cehelsky, P., & Tung, K. K. : Theories of multiple equilibria and weather regimes-A critical reexamination. Part II: Baroclinic two-layer models. Journal of the atmospheric sciences, 44(21), 3282-3303, 1987.

Remarks
Generated Fortran90/95 code from inprod_analytic.lua

Function/Subroutine Documentation

real(kind=8) function inprod_analytic::b1 ( integer  Pi,
integer  Pj,
integer  Pk 
)
private

Cehelsky & Tung Helper functions.

Definition at line 100 of file inprod_analytic.f90.

100  INTEGER :: pi,pj,pk
101  b1 = (pk + pj) / REAL(pi)
real(kind=8) function inprod_analytic::b2 ( integer  Pi,
integer  Pj,
integer  Pk 
)
private

Cehelsky & Tung Helper functions.

Definition at line 106 of file inprod_analytic.f90.

106  INTEGER :: pi,pj,pk
107  b2 = (pk - pj) / REAL(pi)
real(kind=8) function inprod_analytic::calculate_a ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Eigenvalues of the Laplacian (atmospheric)

\( a_{i,j} = (F_i, \nabla^2 F_j)\) .

Definition at line 164 of file inprod_analytic.f90.

164  INTEGER, INTENT(IN) :: i,j
165  TYPE(atm_wavenum) :: ti
166 
167  calculate_a = 0.d0
168  IF (i==j) THEN
169  ti = awavenum(i)
170  calculate_a = -(n**2) * ti%Nx**2 - ti%Ny**2
171  END IF
real(kind=8) function inprod_analytic::calculate_b ( integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  k 
)
private

Streamfunction advection terms (atmospheric)

\( b_{i,j,k} = (F_i, J(F_j, \nabla^2 F_k))\) .

Definition at line 178 of file inprod_analytic.f90.

178  INTEGER, INTENT(IN) :: i,j,k
179 
180  calculate_b = calculate_a(k,k) * calculate_g(i,j,k)
181 
real(kind=8) function inprod_analytic::calculate_c_atm ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Beta term for the atmosphere.

\( c_{i,j} = (F_i, \partial_x F_j)\) .

Definition at line 188 of file inprod_analytic.f90.

188  INTEGER, INTENT(IN) :: i,j
189  TYPE(atm_wavenum) :: ti, tj
190 
191  ti = awavenum(i)
192  tj = awavenum(j)
193  calculate_c_atm = 0.d0
194  IF ((ti%typ == "K") .AND. (tj%typ == "L")) THEN
195  calculate_c_atm = n * ti%M * delta(ti%M - tj%H) * delta(ti%P - tj%P)
196  ELSE IF ((ti%typ == "L") .AND. (tj%typ == "K")) THEN
197  ti = awavenum(j)
198  tj = awavenum(i)
199  calculate_c_atm = - n * ti%M * delta(ti%M - tj%H) * delta(ti%P - tj%P)
200  END IF
201 
real(kind=8) function inprod_analytic::calculate_c_oc ( integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  k 
)
private

Streamfunction advection terms (oceanic)

\( C_{i,j,k} = (\eta_i, J(\eta_j,\nabla^2 \eta_k))\) .

Definition at line 412 of file inprod_analytic.f90.

412  INTEGER, INTENT(IN) :: i,j,k
413 
414  calculate_c_oc = calculate_m(k,k) * calculate_o(i,j,k)
415 
real(kind=8) function inprod_analytic::calculate_d ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Forcing of the ocean on the atmosphere.

\( d_{i,j} = (F_i, \nabla^2 \eta_j)\) .

Definition at line 208 of file inprod_analytic.f90.

208  INTEGER, INTENT(IN) :: i,j
209 
210  calculate_d=calculate_s(i,j) * calculate_m(j,j)
211 
real(kind=8) function inprod_analytic::calculate_g ( integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  k 
)
private

Temperature advection terms (atmospheric)

\( g_{i,j,k} = (F_i, J(F_j, F_k))\) .

Definition at line 218 of file inprod_analytic.f90.

218  INTEGER, INTENT(IN) :: i,j,k
219  TYPE(atm_wavenum) :: ti,tj,tk
220  REAL(KIND=8) :: val,vb1, vb2, vs1, vs2, vs3, vs4
221  INTEGER, DIMENSION(3) :: a,b
222  INTEGER, DIMENSION(3,3) :: w
223  CHARACTER, DIMENSION(3) :: s
224  INTEGER :: par
225 
226  ti = awavenum(i)
227  tj = awavenum(j)
228  tk = awavenum(k)
229 
230  a(1)=i
231  a(2)=j
232  a(3)=k
233 
234  val=0.d0
235 
236  IF ((ti%typ == "L") .AND. (tj%typ == "L") .AND. (tk%typ == "L")) THEN
237 
238  CALL piksrt(3,a,par)
239 
240  ti = awavenum(a(1))
241  tj = awavenum(a(2))
242  tk = awavenum(a(3))
243 
244  vs3 = s3(tj%P,tk%P,tj%H,tk%H)
245  vs4 = s4(tj%P,tk%P,tj%H,tk%H)
246  val = vs3 * ((delta(tk%H - tj%H - ti%H) - delta(tk%H &
247  &- tj%H + ti%H)) * delta(tk%P + tj%P - ti%P) +&
248  & delta(tk%H + tj%H - ti%H) * (delta(tk%P - tj%P&
249  & + ti%P) - delta(tk%P - tj%P - ti%P))) + vs4 *&
250  & ((delta(tk%H + tj%H - ti%H) * delta(tk%P - tj&
251  &%P - ti%P)) + (delta(tk%H - tj%H + ti%H) -&
252  & delta(tk%H - tj%H - ti%H)) * (delta(tk%P - tj&
253  &%P - ti%P) - delta(tk%P - tj%P + ti%P)))
254  ELSE
255 
256  s(1)=ti%typ
257  s(2)=tj%typ
258  s(3)=tk%typ
259 
260  w(1,:)=isin("A",s)
261  w(2,:)=isin("K",s)
262  w(3,:)=isin("L",s)
263 
264  IF (any(w(1,:)/=0) .AND. any(w(2,:)/=0) .AND. any(w(3,:)/=0)) THEN
265  b=w(:,1)
266  ti = awavenum(a(b(1)))
267  tj = awavenum(a(b(2)))
268  tk = awavenum(a(b(3)))
269  call piksrt(3,b,par)
270  vb1 = b1(ti%P,tj%P,tk%P)
271  vb2 = b2(ti%P,tj%P,tk%P)
272  val = -2 * sqrt(2.) / pi * tj%M * delta(tj%M - tk%H) * flambda(ti%P + tj%P + tk%P)
273  IF (val /= 0.d0) val = val * (vb1**2 / (vb1**2 - 1) - vb2**2 / (vb2**2 - 1))
274  ELSEIF ((w(2,2)/=0) .AND. (w(2,3)==0) .AND. any(w(3,:)/=0)) THEN
275  ti = awavenum(a(w(2,1)))
276  tj = awavenum(a(w(2,2)))
277  tk = awavenum(a(w(3,1)))
278  b(1)=w(2,1)
279  b(2)=w(2,2)
280  b(3)=w(3,1)
281  call piksrt(3,b,par)
282  vs1 = s1(tj%P,tk%P,tj%M,tk%H)
283  vs2 = s2(tj%P,tk%P,tj%M,tk%H)
284  val = vs1 * (delta(ti%M - tk%H - tj%M) * delta(ti%P -&
285  & tk%P + tj%P) - delta(ti%M- tk%H - tj%M) *&
286  & delta(ti%P + tk%P - tj%P) + (delta(tk%H - tj%M&
287  & + ti%M) + delta(tk%H - tj%M - ti%M)) *&
288  & delta(tk%P + tj%P - ti%P)) + vs2 * (delta(ti%M&
289  & - tk%H - tj%M) * delta(ti%P - tk%P - tj%P) +&
290  & (delta(tk%H - tj%M - ti%M) + delta(ti%M + tk%H&
291  & - tj%M)) * (delta(ti%P - tk%P + tj%P) -&
292  & delta(tk%P - tj%P + ti%P)))
293  ENDIF
294  ENDIF
295  calculate_g=par*val*n
296 
real(kind=8) function inprod_analytic::calculate_k ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Forcing of the atmosphere on the ocean.

\( K_{i,j} = (\eta_i, \nabla^2 F_j)\) .

Definition at line 336 of file inprod_analytic.f90.

336  INTEGER, INTENT(IN) :: i,j
337 
338  calculate_k = calculate_s(j,i) * calculate_a(j,j)
real(kind=8) function inprod_analytic::calculate_m ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Forcing of the ocean fields on the ocean.

\( M_{i,j} = (eta_i, \nabla^2 \eta_j)\) .

Definition at line 345 of file inprod_analytic.f90.

345  INTEGER, INTENT(IN) :: i,j
346  TYPE(ocean_wavenum) :: di
347 
348  calculate_m=0.d0
349  IF (i==j) THEN
350  di = owavenum(i)
351  calculate_m = -(n**2) * di%Nx**2 - di%Ny**2
352  END IF
real(kind=8) function inprod_analytic::calculate_n ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Beta term for the ocean.

\( N_{i,j} = (\eta_i, \partial_x \eta_j) \).

Definition at line 359 of file inprod_analytic.f90.

359  INTEGER, INTENT(IN) :: i,j
360  TYPE(ocean_wavenum) :: di,dj
361  REAL(KIND=8) :: val
362 
363  di = owavenum(i)
364  dj = owavenum(j)
365  calculate_n = 0.d0
366  IF (dj%H/=di%H) THEN
367  val = delta(di%P - dj%P) * flambda(di%H + dj%H)
368  calculate_n = val * (-2) * dj%H * di%H * n / ((dj%H**2 - di%H**2) * pi)
369  ENDIF
370 
real(kind=8) function inprod_analytic::calculate_o ( integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  k 
)
private

Temperature advection term (passive scalar)

\( O_{i,j,k} = (\eta_i, J(\eta_j, \eta_k))\) .

Definition at line 377 of file inprod_analytic.f90.

377  INTEGER, INTENT(IN) :: i,j,k
378  TYPE(ocean_wavenum) :: di,dj,dk
379  REAL(KIND=8) :: vs3,vs4,val
380  INTEGER, DIMENSION(3) :: a
381  INTEGER :: par
382 
383  val=0.d0
384 
385  a(1)=i
386  a(2)=j
387  a(3)=k
388 
389  CALL piksrt(3,a,par)
390 
391  di = owavenum(a(1))
392  dj = owavenum(a(2))
393  dk = owavenum(a(3))
394 
395  vs3 = s3(dj%P,dk%P,dj%H,dk%H)
396  vs4 = s4(dj%P,dk%P,dj%H,dk%H)
397  val = vs3*((delta(dk%H - dj%H - di%H) - delta(dk%H - dj&
398  &%H + di%H)) * delta(dk%P + dj%P - di%P) + delta(dk&
399  &%H + dj%H - di%H) * (delta(dk%P - dj%P + di%P) -&
400  & delta(dk%P - dj%P - di%P))) + vs4 * ((delta(dk%H &
401  &+ dj%H - di%H) * delta(dk%P - dj%P - di%P)) +&
402  & (delta(dk%H - dj%H + di%H) - delta(dk%H - dj%H -&
403  & di%H)) * (delta(dk%P - dj%P - di%P) - delta(dk%P &
404  &- dj%P + di%P)))
405  calculate_o = par * val * n / 2
real(kind=8) function inprod_analytic::calculate_s ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Forcing (thermal) of the ocean on the atmosphere.

\( s_{i,j} = (F_i, \eta_j)\) .

Definition at line 303 of file inprod_analytic.f90.

303  INTEGER, INTENT(IN) :: i,j
304  TYPE(atm_wavenum) :: ti
305  TYPE(ocean_wavenum) :: dj
306  REAL(KIND=8) :: val
307 
308  ti = awavenum(i)
309  dj = owavenum(j)
310  val=0.d0
311  IF (ti%typ == "A") THEN
312  val = flambda(dj%H) * flambda(dj%P + ti%P)
313  IF (val /= 0.d0) THEN
314  val = val*8*sqrt(2.)*dj%P/(pi**2 * (dj%P**2 - ti%P**2) * dj%H)
315  END IF
316  ELSEIF (ti%typ == "K") THEN
317  val = flambda(2 * ti%M + dj%H) * delta(dj%P - ti%P)
318  IF (val /= 0.d0) THEN
319  val = val*4*dj%H/(pi * (-4 * ti%M**2 + dj%H**2))
320  END IF
321  ELSEIF (ti%typ == "L") THEN
322  val = delta(dj%P - ti%P) * delta(2 * ti%H - dj%H)
323  END IF
324  calculate_s=val
325 
real(kind=8) function inprod_analytic::calculate_w ( integer, intent(in)  i,
integer, intent(in)  j 
)
private

Short-wave radiative forcing of the ocean.

\( W_{i,j} = (\eta_i, F_j)\) .

Definition at line 422 of file inprod_analytic.f90.

422  INTEGER, INTENT(IN) :: i,j
423 
424  calculate_w = calculate_s(j,i)
425 
real(kind=8) function inprod_analytic::delta ( integer  r)
private

Integer Dirac delta function.

Definition at line 112 of file inprod_analytic.f90.

112  INTEGER :: r
113  IF (r==0) THEN
114  delta = 1.d0
115  ELSE
116  delta = 0.d0
117  ENDIF
real(kind=8) function inprod_analytic::flambda ( integer  r)
private

"Odd or even" function

Definition at line 122 of file inprod_analytic.f90.

122  INTEGER :: r
123  IF (mod(r,2)==0) THEN
124  flambda = 0.d0
125  ELSE
126  flambda = 1.d0
127  ENDIF
subroutine, public inprod_analytic::init_inprod ( )

Initialisation of the inner product.

Definition at line 436 of file inprod_analytic.f90.

436  INTEGER :: i,j
437  INTEGER :: allocstat
438 
439  IF (natm == 0 ) THEN
440  stop "*** Problem : natm==0 ! ***"
441  ELSEIF (noc == 0) then
442  stop "*** Problem : noc==0 ! ***"
443  END IF
444 
445 
446  ! Definition of the types and wave numbers tables
447 
448  ALLOCATE(owavenum(noc),awavenum(natm), stat=allocstat)
449  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
450 
451  j=0
452  DO i=1,nbatm
453  IF (ams(i,1)==1) THEN
454  awavenum(j+1)%typ='A'
455  awavenum(j+2)%typ='K'
456  awavenum(j+3)%typ='L'
457 
458  awavenum(j+1)%P=ams(i,2)
459  awavenum(j+2)%M=ams(i,1)
460  awavenum(j+2)%P=ams(i,2)
461  awavenum(j+3)%H=ams(i,1)
462  awavenum(j+3)%P=ams(i,2)
463 
464  awavenum(j+1)%Ny=REAL(ams(i,2))
465  awavenum(j+2)%Nx=REAL(ams(i,1))
466  awavenum(j+2)%Ny=REAL(ams(i,2))
467  awavenum(j+3)%Nx=REAL(ams(i,1))
468  awavenum(j+3)%Ny=REAL(ams(i,2))
469 
470  j=j+3
471  ELSE
472  awavenum(j+1)%typ='K'
473  awavenum(j+2)%typ='L'
474 
475  awavenum(j+1)%M=ams(i,1)
476  awavenum(j+1)%P=ams(i,2)
477  awavenum(j+2)%H=ams(i,1)
478  awavenum(j+2)%P=ams(i,2)
479 
480  awavenum(j+1)%Nx=REAL(ams(i,1))
481  awavenum(j+1)%Ny=REAL(ams(i,2))
482  awavenum(j+2)%Nx=REAL(ams(i,1))
483  awavenum(j+2)%Ny=REAL(ams(i,2))
484 
485  j=j+2
486 
487  ENDIF
488  ENDDO
489 
490  DO i=1,noc
491  owavenum(i)%H=oms(i,1)
492  owavenum(i)%P=oms(i,2)
493 
494  owavenum(i)%Nx=oms(i,1)/2.d0
495  owavenum(i)%Ny=oms(i,2)
496 
497  ENDDO
498 
499  ! Pointing to the atmospheric inner products functions
500 
501  atmos%a => calculate_a
502  atmos%g => calculate_g
503  atmos%s => calculate_s
504  atmos%b => calculate_b
505  atmos%d => calculate_d
506  atmos%c => calculate_c_atm
507 
508  ! Pointing to the oceanic inner products functions
509 
510  ocean%M => calculate_m
511  ocean%N => calculate_n
512  ocean%O => calculate_o
513  ocean%C => calculate_c_oc
514  ocean%W => calculate_w
515  ocean%K => calculate_k
516 
Statistics accumulators.
Definition: stat.f90:14
real(kind=8) function inprod_analytic::s1 ( integer  Pj,
integer  Pk,
integer  Mj,
integer  Hk 
)
private

Cehelsky & Tung Helper functions.

Definition at line 132 of file inprod_analytic.f90.

132  INTEGER :: pk,pj,mj,hk
133  s1 = -((pk * mj + pj * hk)) / 2.d0
real(kind=8) function inprod_analytic::s2 ( integer  Pj,
integer  Pk,
integer  Mj,
integer  Hk 
)
private

Cehelsky & Tung Helper functions.

Definition at line 138 of file inprod_analytic.f90.

138  INTEGER :: pk,pj,mj,hk
139  s2 = (pk * mj - pj * hk) / 2.d0
real(kind=8) function inprod_analytic::s3 ( integer  Pj,
integer  Pk,
integer  Hj,
integer  Hk 
)
private

Cehelsky & Tung Helper functions.

Definition at line 144 of file inprod_analytic.f90.

144  INTEGER :: pj,pk,hj,hk
145  s3 = (pk * hj + pj * hk) / 2.d0
real(kind=8) function inprod_analytic::s4 ( integer  Pj,
integer  Pk,
integer  Hj,
integer  Hk 
)
private

Cehelsky & Tung Helper functions.

Definition at line 150 of file inprod_analytic.f90.

150  INTEGER :: pj,pk,hj,hk
151  s4 = (pk * hj - pj * hk) / 2.d0

Variable Documentation

type(atm_tensors), public inprod_analytic::atmos

Atmospheric tensors.

Definition at line 78 of file inprod_analytic.f90.

78  TYPE(atm_tensors), PUBLIC :: atmos
type(atm_wavenum), dimension(:), allocatable, public inprod_analytic::awavenum

Atmospheric blocs specification.

Definition at line 73 of file inprod_analytic.f90.

73  TYPE(atm_wavenum), DIMENSION(:), ALLOCATABLE, PUBLIC :: awavenum
type(ocean_tensors), public inprod_analytic::ocean

Oceanic tensors.

Definition at line 80 of file inprod_analytic.f90.

80  TYPE(ocean_tensors), PUBLIC :: ocean
type(ocean_wavenum), dimension(:), allocatable, public inprod_analytic::owavenum

Oceanic blocs specification.

Definition at line 75 of file inprod_analytic.f90.

75  TYPE(ocean_wavenum), DIMENSION(:), ALLOCATABLE, PUBLIC :: owavenum