! ! $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).lt.d(j)).and.(dn(jj).gt.c(j)))then do ii=1,imn + 1 do i=1, imo +1 if ( ((an(ii).lt.b(i)).and.(bn(ii).gt.a(i))) & .or. ((an(ii).lt.b(i)-2*pi).and.(bn(ii).gt.a(i)-2*pi) & .and.(b(i)-2*pi.lt.-pi) ) & .or. ((an(ii).lt.b(i)+2*pi).and.(bn(ii).gt.a(i)+2*pi) & .and.(a(i)+2*pi.gt.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.lt. c(j))cc=c(j) if((an(ii).lt.b(i)-2*pi).and. & (bn(ii).gt.a(i)-2*pi)) then bb = min(b(i)-2*pi,bn(ii)) aa = an(ii) if (aa.lt.a(i)-2*pi) aa=a(i)-2*pi else if((an(ii).lt.b(i)+2*pi).and. & (bn(ii).gt.a(i)+2*pi)) then bb = min(b(i)+2*pi,bn(ii)) aa = an(ii) if (aa.lt.a(i)+2*pi) aa=a(i)+2*pi else bb = min(b(i),bn(ii)) aa = an(ii) if (aa.lt.a(i)) aa=a(i) end if intersec(ktotal)=(bb-aa)*(sin(dd)-sin(cc)) end if end do end do end if end do end do ! TEST INFO ! DO k=1,ktotal ! ii = iik(k) ! jj = jjk(k) ! i = ik(k) ! j = jk(k) ! if ((ii.eq.10).and.(jj.eq.10).and.(i.eq.10).and.(j.eq.10))then ! if (jj.eq.2.and.(ii.eq.1))then ! write(*,*) '**************** jj=',jj,'ii=',ii ! write(*,*) 'i,j =',i,j ! write(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj) ! write(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j) ! write(*,*) 'intersec(k)',intersec(k) ! write(*,*) 'airen(ii,jj)=',airen(ii,jj) ! end if ! END DO return end subroutine iniinterp_horiz