source: LMDZ4/trunk/libf/dyn3dpar/inter_bary.F @ 1154

!
! $Header$
!
       SUBROUTINE inter_bary( jjm, jdatmax, yjdatt, fdatt  ,
     ,                       jmodmax, yjmodd,  fmod      )
c
c    ...  Auteurs :  Robert Sadourny  , P. Le Van ...
c
       IMPLICIT NONE

c  ----------------------------------------------------------
c       INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES  .
c         VERSION UNIDIMENSIONNELLE  ,    EN LATITUDE  .
c  ----------------------------------------------------------
c
c     jdat : indice du champ de donnees, de 1 a jdatmax
c     jmod : indice du champ du modele,  de 1 a jmodmax
c     fdatt(jdatmax) : champ de donnees (entrees)
c     yjdatt(jdatmax): ordonnees des interfaces des mailles donnees
c     yjmodd(jmodmax): ordonnees des interfaces des mailles modele
c     fmod(jmodmax)  : champ du modele  (sorties)
c
c      ( L'indice 1 correspond a l'interface maille 1 / maille 2)
c      ( Les ordonnees sont exprimees en degres)
c
c     jdatmax = nb. d'interfaces  donnees =  nombre de donnees - 1 
c     jmodmax = nb. d'interfaces  modele

c     Si jmodmax = jjm , on veut interpoler sur les jjm+1 latitudes 
c       rlatu   du modele ( lat.  des scalaires et de U ) 
c
c     Si jmodmax = jjp1 , on veut interpoler sur les jjm latitudes 
c       rlatv du modele  ( lat.  de  V ) 

c  ....  Arguments  en entree  .......

       INTEGER jjm , jdatmax, jmodmax
       REAL    yjdatt( jdatmax ) , fdatt( jdatmax +1 )
       REAL    yjmodd( jmodmax )     

c  ....  Arguments  en sortie  .......
c
       REAL    fmod( jmodmax + 1 )
c
c   ...... Variables locales  ......

       INTEGER      jmods

       REAL       yjdat ( jdatmax +1 ), fdat( jdatmax +1) 
       REAL       fscrat( jdatmax +1 )
       REAL       yjmod ( jmodmax +1 )
       LOGICAL    decrois
       SAVE       decrois
c
       REAL y0,dy,dym 
       INTEGER jdat, jmod,i
c

        DO i = 1, jdatmax +1
         fdat (i) = fdatt (i)
        ENDDO

       CALL ord_coord (  jdatmax , yjdatt(1), yjdat(1), decrois ) 

       IF( decrois )   THEN
         DO i = 1,jdatmax + 1
          fscrat(i) = fdat(i)
         ENDDO
         DO i = 1, jdatmax + 1
          fdat(i) = fscrat( jdatmax + 2 -i )
         ENDDO

       ENDIF

       CALL ord_coordm (jmodmax,yjmodd(1),yjmod(1),jjm,jmods,decrois ) 
c
c      Initialisation des variables
c    --------------------------------

       DO jmod = 1, jmods
        fmod(jmod) = 0.
       END DO

       y0    = 0.
       dym   = 0.
       jmod  = 1
       jdat  = 1
c  --------------------
c      Iteration
c  --------------------

100    IF ( yjmod(jmod).LT.yjdat(jdat) ) THEN
        dy         = yjmod(jmod) - y0
        dym        = dym + dy
        fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym
        y0         = yjmod(jmod)
        dym        = 0.
        jmod       = jmod + 1
        GO TO 100

       ELSE IF ( yjmod(jmod).GT.yjdat(jdat) ) THEN
        dy         = yjdat(jdat) - y0
        dym        = dym + dy
        fmod(jmod) = fmod(jmod) + dy * fdat(jdat)
        y0         = yjdat(jdat)
        jdat       = jdat + 1

       GO TO 100

       ELSE
        dy         = yjmod(jmod) - y0
        dym        = dym + dy
        fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym
        y0         = yjmod(jmod)
        dym        = 0.
        jmod       = jmod + 1
        jdat       = jdat + 1

        IF ( jmod.LE.jmods ) GO TO 100
       END IF
c   ---------------------------------------------
c    Le test de fin suppose que l'interface 0
c    est commune aux deux grilles yjdat et yjmod.
c   ----------------------------------------------
       IF( decrois )  THEN
         DO i = 1,jmods
          fscrat(i) = fmod(i)
         ENDDO
         DO i = 1, jmods
          fmod(i) = fscrat( jmods + 1 -i )
         ENDDO
       ENDIF

       RETURN
       END