42 INTEGER :: m=0,p=0,h=0
43 REAL(KIND=8) :: nx=0.,ny=0.
99 REAL(KIND=8) FUNCTION b1(Pi, Pj, Pk)
101 b1 = (pk + pj) /
REAL(pi)
105 REAL(KIND=8) FUNCTION b2(Pi, Pj, Pk)
107 b2 = (pk - pj) /
REAL(pi)
111 REAL(KIND=8) FUNCTION delta(r)
121 REAL(KIND=8) FUNCTION flambda(r)
123 IF (mod(r,2)==0)
THEN 131 REAL(KIND=8) FUNCTION s1(Pj, Pk, Mj, Hk)
132 INTEGER :: Pk,Pj,Mj,Hk
133 s1 = -((pk * mj + pj * hk)) / 2.d0
137 REAL(KIND=8) FUNCTION s2(Pj, Pk, Mj, Hk)
138 INTEGER :: Pk,Pj,Mj,Hk
139 s2 = (pk * mj - pj * hk) / 2.d0
143 REAL(KIND=8) FUNCTION s3(Pj, Pk, Hj, Hk)
144 INTEGER :: Pj,Pk,Hj,Hk
145 s3 = (pk * hj + pj * hk) / 2.d0
149 REAL(KIND=8) FUNCTION s4(Pj, Pk, Hj, Hk)
150 INTEGER :: Pj,Pk,Hj,Hk
151 s4 = (pk * hj - pj * hk) / 2.d0
164 INTEGER,
INTENT(IN) :: i,j
178 INTEGER,
INTENT(IN) :: i,j,k
188 INTEGER,
INTENT(IN) :: i,j
194 IF ((ti%typ ==
"K") .AND. (tj%typ ==
"L"))
THEN 196 ELSE IF ((ti%typ ==
"L") .AND. (tj%typ ==
"K"))
THEN 208 INTEGER,
INTENT(IN) :: i,j
218 INTEGER,
INTENT(IN) :: i,j,k
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
236 IF ((ti%typ ==
"L") .AND. (tj%typ ==
"L") .AND. (tk%typ ==
"L"))
THEN 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)))
264 IF (any(w(1,:)/=0) .AND. any(w(2,:)/=0) .AND. any(w(3,:)/=0))
THEN 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 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)))
303 INTEGER,
INTENT(IN) :: i,j
311 IF (ti%typ ==
"A")
THEN 313 IF (val /= 0.d0)
THEN 314 val = val*8*sqrt(2.)*dj%P/(
pi**2 * (dj%P**2 - ti%P**2) * dj%H)
316 ELSEIF (ti%typ ==
"K")
THEN 318 IF (val /= 0.d0)
THEN 319 val = val*4*dj%H/(
pi * (-4 * ti%M**2 + dj%H**2))
321 ELSEIF (ti%typ ==
"L")
THEN 322 val =
delta(dj%P - ti%P) *
delta(2 * ti%H - dj%H)
336 INTEGER,
INTENT(IN) :: i,j
345 INTEGER,
INTENT(IN) :: i,j
359 INTEGER,
INTENT(IN) :: i,j
368 calculate_n = val * (-2) * dj%H * di%H *
n / ((dj%H**2 - di%H**2) *
pi)
377 INTEGER,
INTENT(IN) :: i,j,k
379 REAL(KIND=8) :: vs3,vs4,val
380 INTEGER,
DIMENSION(3) :: a
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 &
412 INTEGER,
INTENT(IN) :: i,j,k
422 INTEGER,
INTENT(IN) :: i,j
440 stop
"*** Problem : natm==0 ! ***" 441 ELSEIF (
noc == 0)
then 442 stop
"*** Problem : noc==0 ! ***" 449 IF (allocstat /= 0) stop
"*** Not enough memory ! ***" 453 IF (
ams(i,1)==1)
THEN integer noc
Number of oceanic basis functions.
real(kind=8) function calculate_g(i, j, k)
Temperature advection terms (atmospheric)
Atmospheric bloc specification type.
subroutine, public init_inprod
Initialisation of the inner product.
integer nbatm
Number of oceanic blocks.
real(kind=8) function calculate_d(i, j)
Forcing of the ocean on the atmosphere.
Inner products between the truncated set of basis functions for the ocean and atmosphere streamfuncti...
subroutine, public piksrt(k, arr, par)
Simple card player sorting function.
real(kind=8) function b1(Pi, Pj, Pk)
Cehelsky & Tung Helper functions.
real(kind=8) function s4(Pj, Pk, Hj, Hk)
Cehelsky & Tung Helper functions.
real(kind=8) function s2(Pj, Pk, Mj, Hk)
Cehelsky & Tung Helper functions.
real(kind=8) function b2(Pi, Pj, Pk)
Cehelsky & Tung Helper functions.
real(kind=8) function delta(r)
Integer Dirac delta function.
real(kind=8) function calculate_c_oc(i, j, k)
Streamfunction advection terms (oceanic)
real(kind=8) function calculate_o(i, j, k)
Temperature advection term (passive scalar)
integer function, dimension(size(s)), public isin(c, s)
Determine if a character is in a string and where.
type(ocean_wavenum), dimension(:), allocatable, public owavenum
Oceanic blocs specification.
Type holding the oceanic inner products tensors.
real(kind=8) function calculate_s(i, j)
Forcing (thermal) of the ocean on the atmosphere.
real(kind=8) function calculate_k(i, j)
Forcing of the atmosphere on the ocean.
type(atm_wavenum), dimension(:), allocatable, public awavenum
Atmospheric blocs specification.
Oceanic bloc specification type.
real(kind=8) function s1(Pj, Pk, Mj, Hk)
Cehelsky & Tung Helper functions.
real(kind=8) function s3(Pj, Pk, Hj, Hk)
Cehelsky & Tung Helper functions.
integer natm
Number of atmospheric basis functions.
type(atm_tensors), public atmos
Atmospheric tensors.
real(kind=8) function calculate_m(i, j)
Forcing of the ocean fields on the ocean.
real(kind=8) function calculate_w(i, j)
Short-wave radiative forcing of the ocean.
integer nboc
Number of atmospheric blocks.
real(kind=8) function flambda(r)
"Odd or even" function
The model parameters module.
real(kind=8) function calculate_b(i, j, k)
Streamfunction advection terms (atmospheric)
real(kind=8) function calculate_c_atm(i, j)
Beta term for the atmosphere.
Type holding the atmospheric inner products tensors.
integer, dimension(:,:), allocatable ams
Atmospheric mode selection array.
real(kind=8) function calculate_n(i, j)
Beta term for the ocean.
type(ocean_tensors), public ocean
Oceanic tensors.
integer, dimension(:,:), allocatable oms
Ocean mode selection array.
real(kind=8) function calculate_a(i, j)
Eigenvalues of the Laplacian (atmospheric)
real(kind=8) n
- Aspect ratio