! ! $Id: interp_horiz.F90 5158 2024-08-02 12:12:03Z 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