1 |
guez |
3 |
module inter_barxy_m |
2 |
|
|
|
3 |
guez |
225 |
! From inter_barxy.F, version 1.1.1.1, 2004/05/19 12:53:07 |
4 |
guez |
3 |
|
5 |
|
|
implicit none |
6 |
|
|
|
7 |
|
|
contains |
8 |
|
|
|
9 |
|
|
SUBROUTINE inter_barxy(dlonid, dlatid, champ, rlonimod, rlatimod, champint) |
10 |
|
|
|
11 |
|
|
! Author: P. Le Van |
12 |
|
|
|
13 |
guez |
98 |
use comgeom, only: aire_2d, apoln, apols |
14 |
guez |
265 |
use dimensions, only: iim, jjm |
15 |
guez |
98 |
use inter_barx_m, only: inter_barx |
16 |
|
|
use inter_bary_m, only: inter_bary |
17 |
guez |
36 |
use nr_util, only: assert_eq, assert |
18 |
guez |
98 |
use ord_coord_m, only: ord_coord |
19 |
|
|
use ord_coordm_m, only: ord_coordm |
20 |
guez |
3 |
|
21 |
|
|
REAL, intent(in):: dlonid(:) |
22 |
guez |
266 |
! longitude from input file, in rad, from -pi to pi |
23 |
guez |
3 |
|
24 |
|
|
REAL, intent(in):: dlatid(:), champ(:, :), rlonimod(:) |
25 |
|
|
|
26 |
|
|
REAL, intent(in):: rlatimod(:) |
27 |
guez |
266 |
! latitude angle, in degrees or rad, in strictly decreasing order |
28 |
guez |
3 |
|
29 |
|
|
real, intent(out):: champint(:, :) |
30 |
|
|
! Si taille de la seconde dim = jjm + 1, on veut interpoler sur les |
31 |
|
|
! jjm+1 latitudes rlatu du modele (latitudes des scalaires et de U) |
32 |
|
|
! Si taille de la seconde dim = jjm, on veut interpoler sur les |
33 |
guez |
225 |
! jjm latitudes rlatv du mod\`ele (latitudes de V) |
34 |
guez |
3 |
|
35 |
guez |
97 |
! Local: |
36 |
guez |
3 |
|
37 |
|
|
REAL champy(iim, size(champ, 2)) |
38 |
|
|
integer j, i, jnterfd, jmods |
39 |
|
|
|
40 |
|
|
REAL yjmod(size(champint, 2)) |
41 |
|
|
! (angle, in degrees, in strictly increasing order) |
42 |
|
|
|
43 |
|
|
REAL yjdat(size(dlatid) + 1) ! angle, in degrees, in increasing order |
44 |
|
|
LOGICAL decrois ! "dlatid" is in decreasing order |
45 |
|
|
|
46 |
|
|
!----------------------------------- |
47 |
|
|
|
48 |
guez |
266 |
jnterfd = assert_eq(size(champ, 2) - 1, size(dlatid), "inter_barxy jnterfd") |
49 |
guez |
3 |
jmods = size(champint, 2) |
50 |
|
|
call assert(size(champ, 1) == size(dlonid), "inter_barxy size(champ, 1)") |
51 |
|
|
call assert((/size(rlonimod), size(champint, 1)/) == iim, & |
52 |
|
|
"inter_barxy iim") |
53 |
|
|
call assert(any(jmods == (/jjm, jjm + 1/)), 'inter_barxy jmods') |
54 |
|
|
call assert(size(rlatimod) == jjm, "inter_barxy size(rlatimod)") |
55 |
|
|
|
56 |
|
|
! Check decreasing order for "rlatimod": |
57 |
|
|
DO i = 2, jjm |
58 |
guez |
73 |
IF (rlatimod(i) >= rlatimod(i-1)) then |
59 |
|
|
print *, '"inter_barxy": "rlatimod" should be strictly decreasing' |
60 |
|
|
stop 1 |
61 |
|
|
end IF |
62 |
guez |
3 |
ENDDO |
63 |
|
|
|
64 |
|
|
yjmod(:jjm) = ord_coordm(rlatimod) |
65 |
|
|
IF (jmods == jjm + 1) THEN |
66 |
guez |
73 |
IF (90. - yjmod(jjm) < 0.01) then |
67 |
|
|
print *, '"inter_barxy": with jmods = jjm + 1, ' & |
68 |
|
|
// 'yjmod(jjm) should be < 90.' |
69 |
|
|
stop 1 |
70 |
|
|
end IF |
71 |
guez |
3 |
ELSE |
72 |
|
|
! jmods = jjm |
73 |
guez |
73 |
IF (ABS(yjmod(jjm) - 90.) > 0.01) then |
74 |
|
|
print *, '"inter_barxy": with jmods = jjm, yjmod(jjm) should be 90.' |
75 |
|
|
stop 1 |
76 |
|
|
end IF |
77 |
guez |
3 |
ENDIF |
78 |
|
|
|
79 |
|
|
if (jmods == jjm + 1) yjmod(jjm + 1) = 90. |
80 |
|
|
|
81 |
|
|
DO j = 1, jnterfd + 1 |
82 |
|
|
champy(:, j) = inter_barx(dlonid, champ(:, j), rlonimod) |
83 |
|
|
ENDDO |
84 |
|
|
|
85 |
guez |
98 |
CALL ord_coord(dlatid, yjdat, decrois) |
86 |
guez |
3 |
IF (decrois) champy(:, :) = champy(:, jnterfd + 1:1:-1) |
87 |
|
|
DO i = 1, iim |
88 |
|
|
champint(i, :) = inter_bary(yjdat, champy(i, :), yjmod) |
89 |
|
|
ENDDO |
90 |
|
|
champint(:, :) = champint(:, jmods:1:-1) |
91 |
|
|
|
92 |
|
|
IF (jmods == jjm + 1) THEN |
93 |
|
|
! Valeurs uniques aux poles |
94 |
|
|
champint(:, 1) = SUM(aire_2d(:iim, 1) * champint(:, 1)) / apoln |
95 |
|
|
champint(:, jjm + 1) = SUM(aire_2d(:iim, jjm + 1) & |
96 |
|
|
* champint(:, jjm + 1)) / apols |
97 |
|
|
ENDIF |
98 |
|
|
|
99 |
|
|
END SUBROUTINE inter_barxy |
100 |
|
|
|
101 |
|
|
end module inter_barxy_m |