Esope source files

   1 : C XCNEF0    SOURCE    PV        09/03/12    21:37:09     6325           
   2 :       SUBROUTINE XCNEF0(NBEL,NP,MP,AF1,RO,VITESS,DCENTR
   3 :      &     ,NPT,IDIM,IDCEN,XYZ,NUTOEL,XCOOR,LTOG,
   4 :      &     IPADL,AF2,AF3,
   5 :      &     FN,GR,PG,HR,PGSQ,RPG,NES,NPG,IAXI,DRR,
   6 :      &     NBME,AMU,COTE,NELZ,IKR,IKU,IKM,TN,AIMPL,IPADL2,DT,
   7 :      &     MELEMC)
   8 :       IMPLICIT INTEGER(I-N)
   9 :       IMPLICIT REAL*8 (A-H,O-Z)
  10 : 
  11 : -INC SMCHAML
  12 : -INC SMELEME
  13 :       POINTEUR MELEMC.MELEME
  14 : 
  15 :       DIMENSION FN(MP,NPG),GR(IDIM,MP,NPG),PG(NPG)
  16 :       DIMENSION HR(IDIM,MP,NPG),PGSQ(NPG),RPG(NPG)
  17 :       DIMENSION AF1(NBEL,NP,MP),AF2(NBEL,NP,MP)
  18 :       DIMENSION AF3(NBEL,NP,MP),RO(1)
  19 :       DIMENSION VITESS(NPT,IDIM),TN(*)
  20 :       DIMENSION DCENTR(1),XYZ(IDIM,MP)
  21 :       DIMENSION XCOOR(*),DRR(MP,NBEL),IPADL2(*)
  22 :       DIMENSION LTOG(MP,NBEL),IPADL(*),AMU(1),COTE(NELZ,*)
  23 : 
  24 : C=============================================
  25 : C     Cette routine calcules les matrices    C
  26 : C     Elementaires associees a l'operateur  C
  27 : C     KONV en EFM0                           C
  28 : C=============================================
  29 :       PARAMETER (LRV=64,NPX=9,NPGX=9)
  30 :       DIMENSION WT(LRV,NPX,NPGX),WS(LRV,NPX,NPGX),HK(LRV,3,NPX,NPGX)
  31 :       DIMENSION PGSK(LRV,NPGX),RPGK(LRV,NPGX),AIRE(LRV)
  32 :       DIMENSION UMJ(LRV,3,NPGX),DUMJ(LRV,3,NPGX)
  33 :       DIMENSION COEFK(LRV),ANUK(LRV)
  34 :       DIMENSION AL(LRV),AH(LRV),AP(LRV)
  35 :       DIMENSION UAM(9,9)
  36 : -INC CCREEL
  37 : 
  38 :       INTEGER I,J,K,NUMAUX
  39 :       REAL*8 UMOY(3),RESW,CT
  40 : 
  41 : C ===================================
  42 : C Calcul du nombre de paquets de LRV éléments
  43 : C
  44 :       NNN=MOD(NBEL,LRV)
  45 :       IF(NNN.EQ.0) NPACK=NBEL/LRV
  46 :       IF(NNN.NE.0) NPACK=1+(NBEL-NNN)/LRV
  47 :       KPACKD=1
  48 :       KPACKF=NPACK
  49 :       CT=0.0D0
  50 : 
  51 : C====================================
  52 : 
  53 : C     Boucle sur les paquets de LRV elements
  54 : 
  55 : c      WRITE(6,*) 'IDCEN=' , IDCEN
  56 :       DO KPACK=KPACKD,KPACKF
  57 : 
  58 : C ======= A L'INTERIEUR DE CHAQUE PAQUET DE LRV ELEMENTS =======
  59 : C
  60 : C 1. Calcul des limites du paquet courant.
  61 :          KDEB=1+(KPACK-1)*LRV
  62 :          KFIN=MIN(NBEL,KDEB+LRV-1)
  63 : C
  64 : C     On rempli le tableau de COEFK sur chaque
  65 : C     element du paquet
  66 :          DO K=KDEB,KFIN
  67 :             KP=K-KDEB+1
  68 :             NK=K+NUTOEL
  69 :             NKR=(1-IKR)*(NK-1)+1
  70 :             NKM=(1-IKM)*(NK-1)+1
  71 :             COEFK(KP)=RO(NKR)
  72 :             ANUK(KP)=AMU(NKM)/RO(NKR)
  73 :             AL(KP)=COTE(NK,1)
  74 :             AH(KP)=COTE(NK,2)
  75 :          END DO
  76 : 
  76 :          CALL KSUPG(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  77 :      &        NES,MP,NPG,IAXI,XCOOR,
  78 :      &        WT,WS,HK,PGSK,RPGK,AIRE,
  79 :      &        UMJ,DUMJ,KDEB,KFIN,LRV,NPX,NPGX,
  80 :      &        TN,IPADL,VITESS,IPADL,NPT,NELZ,ANUK,
  81 :      &        IDCEN,LTOG,
  82 :      &        AL,AH,AP,
  83 :      &        DTM1,DT,DTT1,DTT2,DIAEL,NUEL)
  84 : 
  85 :          DO K=KDEB,KFIN
  86 :             KP=K-KDEB+1
  87 :             CT=CT+TN(IPADL2(MELEMC.NUM(1,K)))*
  88 :      &           AIRE(KP)
  89 :             DO I=1,MP
  90 : 
  91 :                IF (NBME.GT.0) AF1(K,1,I)=0.0D0
  92 :                IF (NBME.GT.1) AF2(K,1,I)=0.0D0
  93 :                IF (NBME.GT.2) AF3(K,1,I)=0.0D0
  94 : 
  95 :                DO J=1,MP
  96 :                   UAM(I,J)=0.0D0
  97 :                   DO L=1,NPG
  98 :                      UAM(I,J)=UAM(I,J)+
  99 :      &                    FN(I,L)*WT(KP,J,L)*PGSK(KP,L)
 100 :                   END DO
 101 :                END DO
 102 :             END DO
 103 : 
 104 : 
 105 :             DO I=1,MP
 106 :                DO J=1,MP
 107 :                   IF (NBME.GT.0) THEN
 108 :                      AF1(K,1,I)=AF1(K,1,I)+UAM(I,J)*
 109 :      &                    VITESS(IPADL(LTOG(J,K)),1)
 110 :      &                    *COEFK(KP)
 111 :                   END IF
 112 :                   IF (NBME.GT.1) THEN
 113 :                      AF2(K,1,I)=AF2(K,1,I)+UAM(I,J)*
 114 :      &                    VITESS(IPADL(LTOG(J,K)),2)
 115 :      &                    *COEFK(KP)
 116 :                   END IF
 117 :                   IF (NBME.GT.2) THEN
 118 :                      AF3(K,1,I)=AF3(K,1,I)+UAM(I,J)*
 119 :      &                    VITESS(IPADL(LTOG(J,K)),3)
 120 :      &                    *COEFK(KP)
 121 :                   END IF
 122 :                END DO
 123 :             END DO
 124 : 
 125 :          END DO
 126 :       END DO
 127 : C     WRITE(6,*) 'Int Ct=',CT
 128 :       RETURN
 129 :       
 130 :       END
 131 :  
 132 :  
 133 :  
 134 :  
 135 :  
 136 :  
 137 :