Esope source files

   1 : C COSOCE    SOURCE    CHAT      05/01/12    22:22:57     5004           
   2 :       SUBROUTINE COSOCE(IPT1,IPT2,IPT3,MPOVA1,MPOVAL)
   3 : C---------------------------------------------------------------------
   4 : C Cet subroutine crée un MPOVAL contenant la valeur moyenne d'un
   5 : C champ connu par ses valeurs aux sommets
   6 : C---------------------------------------------------------------------
   7 : C
   8 : C----------------
   9 : C Entrée/Sortie :
  10 : C----------------
  11 : C
  12 : C E/  IPT1    : MELEME CENTRE   de la table DOMAINE
  13 : C E/  IPT2    : MELEME SOMMET   de la table DOMAINE
  14 : C E/  IPT3    : MELEME MAILLAGE de la table DOMAINE
  15 : C E/  MPOVA1  : MPOVAL des valeurs du CHPO aux SOMMET
  16 : C  /S MPOVAL  : MPOVAL des valeurs du CHPO aux CENTRE - SEGMENT ACTIF
  17 : C
  18 : C---------------------------------------------------------------------
  19 :       IMPLICIT INTEGER(I-N)
  20 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  21 : C
  22 : -INC SMCHPOI
  23 : -INC SMELEME
  24 : -INC SMLENTI
  25 : C
  25 :       CALL KRIPAD(IPT2,MLENTI)
  26 :       SEGACT IPT1
  27 :       N  = IPT1.NUM(/2)
  28 :       SEGDES IPT1
  29 :       SEGACT MPOVA1
  30 :       NC = MPOVA1.VPOCHA(/2)
  31 :       SEGINI MPOVAL
  32 :       SEGACT IPT3
  33 :       NBZONE = IPT3.LISOUS(/1)
  34 :       IF (NBZONE.EQ.0) NBZONE=1
  35 :       K = 0
  36 :       DO 40 L=1,NBZONE
  37 :          IPT4 = IPT3
  38 :          IF (NBZONE.NE.1) IPT4=IPT3.LISOUS(L)
  39 :          SEGACT IPT4
  40 :          NUMPTZ = IPT4.NUM(/1)
  41 :          NUMELZ = IPT4.NUM(/2)
  42 :          DO 30 I=1,NUMELZ
  43 :             K = K + 1
  44 :             DO 20 N=1,NC
  45 :                UU = 0.D0
  46 :                DO 10 J=1,NUMPTZ
  47 :                   UU = UU + MPOVA1.VPOCHA(LECT(IPT4.NUM(J,I)),N)
  48 :  10            CONTINUE
  49 :                VPOCHA(K,N) = UU / (FLOAT(NUMPTZ))
  50 : C        WRITE(6,*) 'K N',K,N,VPOCHA(K,N)
  51 :  20         CONTINUE
  52 :  30      CONTINUE
  53 :          SEGDES IPT4
  54 :  40   CONTINUE
  55 :       SEGDES MPOVA1
  56 :       IF (NBZONE.NE.1) SEGDES IPT3
  57 :       SEGSUP MLENTI
  58 : C
  59 :       RETURN
  60 :       END
  61 :  
  62 :  
  63 :