C C $Header$ C subroutine iniinterp_horiz (imo,jmo,imn,jmn ,kllm, & rlonuo,rlatvo,rlonun,rlatvn, & ktotal,iik,jjk,jk,ik,intersec,airen) implicit none c --------------------------------------------------------- c Prepare l' interpolation des variables d'une grille LMDZ c dans une autre grille LMDZ en conservant la quantite c totale pour les variables intensives (/m2) : ex : Pression au sol c c (Pour chaque case autour d'un point scalaire de la nouvelle c grille, on calcule la surface (en m2)en intersection avec chaque c case de l'ancienne grille , pour la future interpolation) c c on calcule aussi l' aire dans la nouvelle grille c c c Auteur: F.Forget 01/1995 c ------- c c --------------------------------------------------------- c Declarations: c ============== c c ARGUMENTS c """"""""" c 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) c 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 c Autres variables c """""""""""""""" 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. ) c On repere les frontieres des cases : c =================================== c c Attention, on ruse avec des latitudes = 90 deg au pole. c ANcienne grile c """""""""""""" 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 c Nouvelle grille c """"""""""""""" 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 c Calcul de la surface des cases scalaires de la nouvelle grille c ============================================================== 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 c Calcul de la surface des intersections c ====================================== c boucle sur la nouvelle grille c """""""""""""""""""""""""""" 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