Esope source files

   1 : C YSOUR     SOURCE    CHAT      05/01/13    04:20:20     5004           
   2 :       SUBROUTINE YSOUR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
   3 :      & NES,IDIM,NP,NPG,IAXI,LE,SO,KDIM,IPADS,
   4 :      & NBEL,K0,XCOOR,F,NPT)
   5 :                                                                                 
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   8 :                                                                                 
   9 : C************************************************************************       
  10 : C                                                                               
  11 : C   OPERATEUR SOUR
  12 : C - IKAS = 1 Source scalaire    s :  FLOTTANT ou CHPOINT SCAL CENTRE
  13 : C - IKAS = 2 Source QDM         s :  POINT    ou CHPOINT SCAL CENTRE
  14 : C - IKAS = 3 Source QDM         g*beta*( T - Tref )
  15 : C                                                                               
  16 : C   /           /
  17 : C   | W s do  = | Na (Mb Sb) do   Sb donne aux pts de Gauss
  18 : C  /            /
  19 : C                                                                               
  20 : C************************************************************************       
  21 :                                                                                 
  22 :       DIMENSION FN(NP,NPG),GR(IDIM,NP,NPG),PG(NPG)
  23 :       DIMENSION XYZ(IDIM,NP),HR(NES,NP,NPG),PGSQ(NPG),RPG(NPG)
  24 :       DIMENSION XCOOR(*)
  25 :       DIMENSION SO(NBEL,NPG,KDIM)
  26 :       DIMENSION LE(NP,NBEL),F(NPT,KDIM),IPADS(*)
  27 : C***********************************************************************        
  28 : 
  29 :       NK=K0
  30 :       DO 208 KE=1,NBEL
  31 :       NK=NK+1
  32 :       DO 209 I=1,NP
  33 :       J=LE(I,KE)
  34 :       DO 209 N=1,IDIM
  35 :       XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  36 :  209  CONTINUE
  37 : 
  37 :       CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
  38 :      *IDIM,NP,NPG,IAXI,AIRE)
  39 : 
  40 :       DO 204 N=1,KDIM
  41 :       DO 203 I=1,NP
  42 :       I1=IPADS(LE(I,KE))
  43 :       U=0.D0
  44 :       DO 201 L=1,NPG
  45 :       U=U+FN(I,L)*PGSQ(L)*SO(KE,L,N)
  46 :  201  CONTINUE
  47 :  202  CONTINUE
  48 :       F(I1,N)=F(I1,N)+U
  49 :  203  CONTINUE
  50 :  204  CONTINUE
  51 :  208  CONTINUE
  52 :       RETURN                                                                    
  53 : 
  54 :  1002 FORMAT(8(1X,1PE11.4))                                                     
  55 :  1001 FORMAT(20(1X,I5))                                                         
  56 :       END                                                                       
  57 :  
  58 :