| 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èle (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 |
Parent Directory
| 
Revision Log