1 |
module inter_barxy_m |
2 |
|
3 |
! From inter_barxy.F, version 1.1.1.1, 2004/05/19 12:53:07 |
4 |
|
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 |
use comgeom, only: aire_2d, apoln, apols |
14 |
use dimens_m, only: iim, jjm |
15 |
use inter_barx_m, only: inter_barx |
16 |
use inter_bary_m, only: inter_bary |
17 |
use nr_util, only: assert_eq, assert |
18 |
use ord_coord_m, only: ord_coord |
19 |
use ord_coordm_m, only: ord_coordm |
20 |
|
21 |
REAL, intent(in):: dlonid(:) |
22 |
! (longitude from input file, in rad, from -pi to pi) |
23 |
|
24 |
REAL, intent(in):: dlatid(:), champ(:, :), rlonimod(:) |
25 |
|
26 |
REAL, intent(in):: rlatimod(:) |
27 |
! (latitude angle, in degrees or rad, in strictly decreasing order) |
28 |
|
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 |
! jjm latitudes rlatv du mod\`ele (latitudes de V) |
34 |
|
35 |
! Local: |
36 |
|
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 |
jnterfd = assert_eq(size(champ, 2) - 1, size(dlatid), & |
49 |
"inter_barxy jnterfd") |
50 |
jmods = size(champint, 2) |
51 |
call assert(size(champ, 1) == size(dlonid), "inter_barxy size(champ, 1)") |
52 |
call assert((/size(rlonimod), size(champint, 1)/) == iim, & |
53 |
"inter_barxy iim") |
54 |
call assert(any(jmods == (/jjm, jjm + 1/)), 'inter_barxy jmods') |
55 |
call assert(size(rlatimod) == jjm, "inter_barxy size(rlatimod)") |
56 |
|
57 |
! Check decreasing order for "rlatimod": |
58 |
DO i = 2, jjm |
59 |
IF (rlatimod(i) >= rlatimod(i-1)) then |
60 |
print *, '"inter_barxy": "rlatimod" should be strictly decreasing' |
61 |
stop 1 |
62 |
end IF |
63 |
ENDDO |
64 |
|
65 |
yjmod(:jjm) = ord_coordm(rlatimod) |
66 |
IF (jmods == jjm + 1) THEN |
67 |
IF (90. - yjmod(jjm) < 0.01) then |
68 |
print *, '"inter_barxy": with jmods = jjm + 1, ' & |
69 |
// 'yjmod(jjm) should be < 90.' |
70 |
stop 1 |
71 |
end IF |
72 |
ELSE |
73 |
! jmods = jjm |
74 |
IF (ABS(yjmod(jjm) - 90.) > 0.01) then |
75 |
print *, '"inter_barxy": with jmods = jjm, yjmod(jjm) should be 90.' |
76 |
stop 1 |
77 |
end IF |
78 |
ENDIF |
79 |
|
80 |
if (jmods == jjm + 1) yjmod(jjm + 1) = 90. |
81 |
|
82 |
DO j = 1, jnterfd + 1 |
83 |
champy(:, j) = inter_barx(dlonid, champ(:, j), rlonimod) |
84 |
ENDDO |
85 |
|
86 |
CALL ord_coord(dlatid, yjdat, decrois) |
87 |
IF (decrois) champy(:, :) = champy(:, jnterfd + 1:1:-1) |
88 |
DO i = 1, iim |
89 |
champint(i, :) = inter_bary(yjdat, champy(i, :), yjmod) |
90 |
ENDDO |
91 |
champint(:, :) = champint(:, jmods:1:-1) |
92 |
|
93 |
IF (jmods == jjm + 1) THEN |
94 |
! Valeurs uniques aux poles |
95 |
champint(:, 1) = SUM(aire_2d(:iim, 1) * champint(:, 1)) / apoln |
96 |
champint(:, jjm + 1) = SUM(aire_2d(:iim, jjm + 1) & |
97 |
* champint(:, jjm + 1)) / apols |
98 |
ENDIF |
99 |
|
100 |
END SUBROUTINE inter_barxy |
101 |
|
102 |
end module inter_barxy_m |