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

!
! $Id: interp_horiz.F90 5117 2024-07-24 14:23:34Z 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
  ! """"""""""""""""
  REAL :: airetest(imn + 1, jmn + 1)
  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 :: R
  REAL :: totn, tots

  LOGICAL :: firstcall, firsttest, aire_ok
  save firsttest
  data firsttest /.TRUE./
  data aire_ok /.TRUE./





  ! 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


  !---------------------------------------------------------------
  !  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST
  !!       if (.NOT.(firsttest)) goto 99
  !!       firsttest = .FALSE.
  !! !     write (*,*) 'INTERP. HORIZ. : TEST SUR LES AIRES:'
  !!       do jj =1 , jmn+1
  !!         do ii=1, imn+1
  !!           airetest(ii,jj) =0.
  !!         END DO
  !!       END DO
  !!       PRINT *, 'ktotal = ', ktotal
  !!       PRINT *, 'jmn+1 =', jmn+1, 'imn+1', imn+1
  !!
  !!       do k=1,ktotal
  !!          airetest(iik(k),jjk(k))= airetest(iik(k),jjk(k)) +intersec(k)
  !!       end DO
  !!
  !!
  !!       PRINT *, 'fin boucle'
  !!       do jj =1 , jmn+1
  !!        do ii=1, imn+1
  !!          r = airen(ii,jj)/airetest(ii,jj)
  !!          if ((r.gt.1.001).OR.(r.lt.0.999)) THEN
  !! !             write (*,*) '********** PROBLEME D'' AIRES !!!',
  !! !     &                   ' DANS L''INTERPOLATION HORIZONTALE'
  !! !             WRITE(*,*)'ii,jj,airen,airetest',
  !! !     &          ii,jj,airen(ii,jj),airetest(ii,jj)
  !!              aire_ok = .FALSE.
  !!          end if
  !!        END DO
  !!       END DO
  !! !      if (aire_ok) WRITE(*,*) 'INTERP. HORIZ. : AIRES OK'
  !!  99   continue

  ! FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST
  !---------------------------------------------------------------


END SUBROUTINE  interp_horiz