! ! $Header$ ! SUBROUTINE iniinterp_horiz(imo, jmo, imn, jmn, kllm, & rlonuo, rlatvo, rlonun, rlatvn, & ktotal, iik, jjk, jk, ik, intersec, airen) IMPLICIT NONE ! --------------------------------------------------------- ! Prepare l' interpolation des variables d'une grille LMDZ ! dans une autre grille LMDZ en conservant la quantite ! totale pour les variables intensives (/m2) : ex : Pression au sol ! ! (Pour chaque case autour d'un point scalaire de la nouvelle ! grille, on calcule la surface (en m2)en intersection avec chaque ! case de l'ancienne grille , pour la future interpolation) ! ! on calcule aussi l' aire dans la nouvelle grille ! ! ! Auteur: F.Forget 01/1995 ! ------- ! ! --------------------------------------------------------- ! Declarations: ! ============== ! ! ARGUMENTS ! """"""""" ! INPUT INTEGER :: imo, jmo ! dimensions ancienne grille INTEGER :: imn, jmn ! dimensions nouvelle grille INTEGER :: kllm ! taille du tableau des intersections REAL :: rlonuo(imo + 1) ! Latitude et REAL :: rlatvo(jmo) ! longitude des REAL :: rlonun(imn + 1) ! bord des REAL :: rlatvn(jmn) ! cases "scalaires" (input) ! OUTPUT INTEGER :: ktotal ! nombre totale d'intersections reperees INTEGER :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm) REAL :: intersec(kllm) ! surface des intersections (m2) REAL :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille ! Autres variables ! """""""""""""""" INTEGER :: i, j, ii, jj, k REAL :: a(imo + 1), b(imo + 1), c(jmo + 1), d(jmo + 1) REAL :: an(imn + 1), bn(imn + 1), cn(jmn + 1), dn(jmn + 1) REAL :: aa, bb, cc, dd REAL :: pi pi = 2. * ASIN(1.) ! On repere les frontieres des cases : ! =================================== ! ! Attention, on ruse avec des latitudes = 90 deg au pole. ! ANcienne grile ! """""""""""""" a(1) = - rlonuo(imo + 1) b(1) = rlonuo(1) do i = 2, imo + 1 a(i) = rlonuo(i - 1) b(i) = rlonuo(i) END DO d(1) = pi / 2 do j = 1, jmo c(j) = rlatvo(j) d(j + 1) = rlatvo(j) END DO c(jmo + 1) = -pi / 2 ! Nouvelle grille ! """"""""""""""" an(1) = - rlonun(imn + 1) bn(1) = rlonun(1) do i = 2, imn + 1 an(i) = rlonun(i - 1) bn(i) = rlonun(i) END DO dn(1) = pi / 2 do j = 1, jmn cn(j) = rlatvn(j) dn(j + 1) = rlatvn(j) END DO cn(jmn + 1) = -pi / 2 ! Calcul de la surface des cases scalaires de la nouvelle grille ! ============================================================== do ii = 1, imn + 1 do jj = 1, jmn + 1 airen(ii, jj) = (bn(ii) - an(ii)) * (sin(dn(jj)) - sin(cn(jj))) END DO END DO ! Calcul de la surface des intersections ! ====================================== ! boucle sur la nouvelle grille ! """""""""""""""""""""""""""" ktotal = 0 do jj = 1, jmn + 1 do j = 1, jmo + 1 IF((cn(jj)c(j)))THEN do ii = 1, imn + 1 do i = 1, imo + 1 IF (((an(ii)a(i))) & .OR. ((an(ii)a(i) - 2 * pi) & .AND.(b(i) - 2 * pi<-pi)) & .OR. ((an(ii)a(i) + 2 * pi) & .AND.(a(i) + 2 * pi>pi)) & )THEN ktotal = ktotal + 1 iik(ktotal) = ii jjk(ktotal) = jj ik(ktotal) = i jk(ktotal) = j dd = min(d(j), dn(jj)) cc = cn(jj) IF (cc< c(j))cc = c(j) IF((an(ii)a(i) - 2 * pi)) THEN bb = min(b(i) - 2 * pi, bn(ii)) aa = an(ii) IF (aaa(i) + 2 * pi)) THEN bb = min(b(i) + 2 * pi, bn(ii)) aa = an(ii) IF (aa