| 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 |
|
|
use dimens_m, only: iim, jjm |
| 15 |
|
|
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 |
|
|
! (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 |
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 |
|
|
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 |
guez |
73 |
IF (rlatimod(i) >= rlatimod(i-1)) then |
| 60 |
|
|
print *, '"inter_barxy": "rlatimod" should be strictly decreasing' |
| 61 |
|
|
stop 1 |
| 62 |
|
|
end IF |
| 63 |
guez |
3 |
ENDDO |
| 64 |
|
|
|
| 65 |
|
|
yjmod(:jjm) = ord_coordm(rlatimod) |
| 66 |
|
|
IF (jmods == jjm + 1) THEN |
| 67 |
guez |
73 |
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 |
guez |
3 |
ELSE |
| 73 |
|
|
! jmods = jjm |
| 74 |
guez |
73 |
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 |
guez |
3 |
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 |
guez |
98 |
CALL ord_coord(dlatid, yjdat, decrois) |
| 87 |
guez |
3 |
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