! ! $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