source: LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F90 @ 5229

! $Id: interp_horiz.F90 5159 2024-08-02 19:58:25Z abarral $

SUBROUTINE interp_horiz(varo, varn, imo, jmo, imn, jmn, lm, &
        rlonuo, rlatvo, rlonun, rlatvn)

  !===========================================================
  !  Interpolation Horizontales des variables d'une grille LMDZ
  ! (des points SCALAIRES au point SCALAIRES)
  !  dans une autre grille LMDZ en conservant la quantite
  !  totale pour les variables intensives (/m2) : ex : Pression au sol

  ! Francois Forget (01/1995)
  !===========================================================

  IMPLICIT NONE

  !   Declarations:
  ! ==============

  !  ARGUMENTS
  !  """""""""

  INTEGER :: imo, jmo ! dimensions ancienne grille (input)
  INTEGER :: imn, jmn  ! dimensions nouvelle grille (input)

  REAL :: rlonuo(imo + 1)     !  Latitude et
  REAL :: rlatvo(jmo)       !  longitude des
  REAL :: rlonun(imn + 1)     !  bord des
  REAL :: rlatvn(jmn)     !  cases "scalaires" (input)

  INTEGER :: lm ! dimension verticale (input)
  REAL :: varo (imo + 1, jmo + 1, lm) ! var dans l'ancienne grille (input)
  REAL :: varn (imn + 1, jmn + 1, lm) ! var dans la nouvelle grille (output)

  ! Autres variables
  ! """"""""""""""""
  INTEGER :: ii, jj, l

  REAL :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
  !    Info sur les ktotal intersection entre les cases new/old grille
  INTEGER :: kllm, k, ktotal
  parameter (kllm = 400 * 200 * 10)
  INTEGER :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
  REAL :: intersec(kllm)
  REAL :: totn, tots

  ! initialisation
  ! --------------
  ! Si c'est le premier appel, on prepare l'interpolation
  ! en calculant pour chaque case autour d'un point scalaire de la
  ! nouvelle grille, la surface  de intersection avec chaque
  !    case de l'ancienne grille.

  CALL iniinterp_horiz (imo, jmo, imn, jmn, kllm, &
          rlonuo, rlatvo, rlonun, rlatvn, &
          ktotal, iik, jjk, jk, ik, intersec, airen)

  DO l = 1, lm
    DO jj = 1, jmn + 1
      DO ii = 1, imn + 1
        varn(ii, jj, l) = 0.
      END DO
    END DO
  END DO

  ! Interpolation horizontale
  ! -------------------------
  ! boucle sur toute les ktotal intersections entre les cases
  ! de l'ancienne et la  nouvelle grille

  PRINT *, 'ktotal 1 = ', ktotal

  DO k = 1, ktotal
    DO l = 1, lm
      varn(iik(k), jjk(k), l) = varn(iik(k), jjk(k), l) &
              + varo(ik(k), jk(k), l) * intersec(k) / airen(iik(k), jjk(k))
    END DO
  END DO

  ! Une seule valeur au pole pour les variables ! :
  DO l = 1, lm
    totn = 0.
    tots = 0.
    DO ii = 1, imn + 1
      totn = totn + varn(ii, 1, l)
      tots = tots + varn (ii, jmn + 1, l)
    END DO
    DO ii = 1, imn + 1
      varn(ii, 1, l) = totn / REAL(imn + 1)
      varn(ii, jmn + 1, l) = tots / REAL(imn + 1)
    END DO
  END DO

END SUBROUTINE  interp_horiz