Esope source files

   1 : C KGRA      SOURCE    FANDEUR   10/12/14    21:17:14     6812           
   2 :       SUBROUTINE KGRA(MCHPO1,MPOVA1,IGEOM1,MTABD)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C*************************************************************************
   6 : C     Operateur KGRA
   7 : C
   8 : C     Objet : determine le GRADIENT  d un CHAMPOINT SOMMET
   9 : C
  10 : C     SYNTAXE : CHGR =KOPS CHPS 'GRAD' TABDOM ;
  11 : C     TABDOM  : Table DOMAINE contenant le support geometrique de CHPC
  12 : C     CHPS    : CHAMPOINT SOMMET
  13 : C     CHGR    : CHAMPOINT CENTRE
  14 : C
  15 : C*************************************************************************
  16 : -INC SMTABLE
  17 :       POINTEUR MTABD.MTABLE
  18 : -INC SMELEME                                                                    
  19 :       POINTEUR MELEMS.MELEME,MELEMC.MELEME,IGEOM1.MELEME
  20 : -INC CCOPTIO
  21 : -INC SMCOORD
  22 : -INC CCGEOME
  23 : -INC SMCHPOI
  24 :       POINTEUR IZB.MCHPOI,IZBB.MPOVAL
  25 :       POINTEUR IZD.MCHPOI,IZDD.MPOVAL
  26 :       POINTEUR IZV.MCHPOI,IZVV.MPOVAL
  27 : -INC SMLENTI
  28 :       POINTEUR IZIPAD.MLENTI
  29 : -INC SIZFFB
  30 :       REAL*8 HRT(24),RPGJ(9),XYZI(8)
  31 :       CHARACTER*8 TYPE,TYPC,NOM0
  32 : C***
  33 : C     write(6,*)' On est dans KGRA '
  34 :       IAXI=0
  35 :       IF(IFOMOD.EQ.0)IAXI=2
  36 : 
  37 :       NC=MPOVA1.VPOCHA(/2)
  38 :       NPT=MPOVA1.VPOCHA(/1)
  39 : 
  40 :       IF(NC.NE.1)THEN
  41 :       WRITE(6,*)' Opérateur KOPS option GRAD '
  42 :       WRITE(6,*)' Le Champoint a plus d''une composante ',nc
  43 :       RETURN
  44 :       ENDIF
  45 : 
  46 :       TYPE=' '
  46 :       CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS)
  47 : 
  47 :       CALL KRIPAD(IGEOM1,IZIPAD)
  47 :         CALL VERPAD(IZIPAD,MELEMS,IRET)
  48 :          IF(IRET.NE.0)THEN
  49 : C%    Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  50 :           MOTERR(1: 8) = 'TETA1'
  51 :           MOTERR(9:16) = 'CHPOINT '
  52 :           WRITE(IOIMP,*)'Operateur : KOPS GRAD'
  52 :           CALL ERREUR(788)
  53 :           RETURN
  54 :          ENDIF
  55 : 
  56 :       TYPE=' '
  56 :       CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  57 :       TYPE='CENTRE'
  57 :       CALL CRCHPT(TYPE,MELEMC,IDIM,MCHPOI)
  57 :       CALL LICHT(MCHPOI,MPOVAL,TYPE,IGEOM)
  58 : 
  59 :       TYPE=' '
  59 :       CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  60 : 
  61 :       SEGACT MELEME
  62 :       NBSOUS=LISOUS(/1)
  63 :       IF(NBSOUS.EQ.0)NBSOUS=1
  64 : 
  65 :       KK=0
  66 :       DO 1 L=1,NBSOUS
  67 :       IPT1=MELEME
  68 :       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  69 :       SEGACT IPT1
  70 :       NP=IPT1.NUM(/1)
  71 :       NEL=IPT1.NUM(/2)
  72 : 
  73 :       NOM0=NOMS(IPT1.ITYPEL)//'    '
  73 :       CALL KALPBG(NOM0,'FONFORM0',IZFFM)
  74 :       IF(IZFFM.EQ.0)GO TO 90
  75 :       SEGACT IZFFM*MOD
  76 :       IZHR=KZHR(1)
  77 :       SEGACT IZHR*MOD
  78 :       NPG=FN(/2)
  79 :       NES=GR(/1)
  80 : 
  81 :       DO 10 K=1,NEL
  82 :       KK=KK+1
  83 :       DO 9 I=1,NP
  84 :       J=IPT1.NUM(I,K)
  85 :       DO 12 N=1,IDIM
  86 :       XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N)
  87 :  12   CONTINUE
  88 :  9    CONTINUE
  89 : 
  89 :       CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
  90 :      *IDIM,NP,NPG,IAXI,AIRE)
  91 : 
  92 :       DO 36 N=1,IDIM
  93 :       UU=0.D0
  94 :       DO 35 I=1,NP
  95 :       IU = IZIPAD.LECT(IPT1.NUM(I,K)) 
  96 :       UU= UU + MPOVA1.VPOCHA(IU,1)*HR(N,I,1)
  97 :    35 CONTINUE
  98 :       VPOCHA(KK,N)=UU
  99 :    36 CONTINUE
 100 : 
 101 :  10   CONTINUE                                                                  
 102 :       SEGDES IPT1
 103 :  1    CONTINUE
 104 :       SEGDES MPOVA1,MPOVAL
 105 :       SEGDES MCHPO1,MCHPOI
 106 :       SEGDES MELEME,IGEOM1,MELEMS
 107 : C                                                                               
 108 :       SEGSUP IZIPAD,IZFFM,IZHR
 108 :       CALL ECROBJ('CHPOINT ',MCHPOI)
 109 :                                                                                 
 110 :       RETURN                                                                    
 111 : 
 112 :  90   CONTINUE
 113 :       WRITE(6,*)'Interruption anormale de KOPS option GRAD '
 114 :       RETURN
 115 : 
 116 :  1001 FORMAT(20(1X,I5))                                                         
 117 :  1008 FORMAT(10(1X,A8))                                                         
 118 :  1002 FORMAT(10(1X,1PE11.4))
 119 :       END                                                                       
 120 : 
 121 :