subroutine iniinterp_h (imo,jmo,imn,jmn ,kmax,
     &       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 kmax ! 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(kmax), jjk(kmax),jk(kmax),ik(kmax)
       real intersec(kmax)  ! surface des intersections (m2)
       real airen (imn+1,jmn+1) ! aire dans la nouvelle grille


       
 
c Autres variables
c """"""""""""""""
       integer i,j,ii,jj
       integer imomx,jmomx,imnmx1,jmnmx1
!       parameter (imomx=361,jmomx=180,imnmx1=190,jmnmx1=100)
       parameter (imomx=1441,jmomx=720,imnmx1=1440,jmnmx1=730)
       real a(imomx+1),b(imomx+1),c(jmomx+1),d(jmomx+1)
       real an(imnmx1+1),bn(imnmx1+1)
       real cn(jmnmx1+1),dn(jmnmx1+1)
       real aa, bb,cc,dd
       real pi

       pi      = 2.*ASIN( 1. )

c Test dimensions imnmx1 jmnmx1
c""""""""""""""""""""""""""""""
c test dimensionnement tableau airetest
      if (imn.GT.imnmx1.OR.jmn.GT.jmnmx1) then
        write(*,*) 'STOP pb dimensionnement'
        write(*,*) 'il faut imn < imnmx1 et jmn < jmnmx1'
        write(*,*) 'imn imnmx1', imn,imnmx1
        write(*,*) 'jmn jmnmx1', jmn,jmnmx1
        call exit(1)
      endif

      if (imo.GT.imomx.OR.jmo.GT.jmomx) then
        write(*,*) 'STOP pb dimensionnement'
        write(*,*) 'il faut imo < imomx et jmo < jmomx'
        write(*,*) 'imo imomx', imo,imomx
        write(*,*) 'jmo jmomx', jmo,jmomx
        call exit(1)
      endif

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
      an(1)=-pi        !TB17
      bn(imn+1)=pi     ! TB17

      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 ======================================

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c     boucle sur la nouvelle grille
c     """"""""""""""""""""""""""""
      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))
c		      write(12,*) 'intersec(ktotal)',intersec(ktotal)
                     end if
                end do
               end do
             end if
         end do
       end do       


c     TEST  INFO
c       DO k=1,ktotal 
c        ii = iik(k) 
c        jj = jjk(k)
c        i = ik(k)
c        j = jk(k)
c      if ((ii.eq.10).and.(jj.eq.10).and.(i.eq.10).and.(j.eq.10))then
c      if (jj.eq.2.and.(ii.eq.1))then
c          write(*,*) '**************** jj=',jj,'ii=',ii
c          write(*,*) 'i,j =',i,j
c          write(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj)
c          write(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j)
c          write(12,*) 'intersec(k)',intersec(k)
c          write(13,*) 'airen(ii,jj)=',airen(ii,jj)
c      end if
c      end if
c       END DO 

      return
      end