C YSOUR     SOURCE    CHAT      05/01/13    04:20:20     5004
      SUBROUTINE YSOUR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
     & NES,IDIM,NP,NPG,IAXI,LE,SO,KDIM,IPADS,
     & NBEL,K0,XCOOR,F,NPT)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

C************************************************************************
C
C   OPERATEUR SOUR
C - IKAS = 1 Source scalaire    s :  FLOTTANT ou CHPOINT SCAL CENTRE
C - IKAS = 2 Source QDM         s :  POINT    ou CHPOINT SCAL CENTRE
C - IKAS = 3 Source QDM         g*beta*( T - Tref )
C
C   /           /
C   | W s do  = | Na (Mb Sb) do   Sb donne aux pts de Gauss
C  /            /
C
C************************************************************************

      DIMENSION FN(NP,NPG),GR(IDIM,NP,NPG),PG(NPG)
      DIMENSION XYZ(IDIM,NP),HR(NES,NP,NPG),PGSQ(NPG),RPG(NPG)
      DIMENSION XCOOR(*)
      DIMENSION SO(NBEL,NPG,KDIM)
      DIMENSION LE(NP,NBEL),F(NPT,KDIM),IPADS(*)
C***********************************************************************

      NK=K0
      DO 208 KE=1,NBEL
      NK=NK+1
      DO 209 I=1,NP
      J=LE(I,KE)
      DO 209 N=1,IDIM
      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
 209  CONTINUE

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
     *IDIM,NP,NPG,IAXI,AIRE)

      DO 204 N=1,KDIM
      DO 203 I=1,NP
      I1=IPADS(LE(I,KE))
      U=0.D0
      DO 201 L=1,NPG
      U=U+FN(I,L)*PGSQ(L)*SO(KE,L,N)
 201  CONTINUE
 202  CONTINUE
      F(I1,N)=F(I1,N)+U
 203  CONTINUE
 204  CONTINUE
 208  CONTINUE
      RETURN

 1002 FORMAT(8(1X,1PE11.4))
 1001 FORMAT(20(1X,I5))
      END