Esope source files

   1 : C FIMAX2    SOURCE    CHAT      05/01/13    00:00:39     5004           
   2 :       SUBROUTINE FIMAX2(ICEN,IX2D,IY2D,IS2D,IVOL,IPN,IGPN,ILGPN,IRES)
   3 : C************************************************************************
   4 : C
   5 : C PROJET            :  CASTEM 2000
   6 : C
   7 : C NOM               :  FIMAX2
   8 : C
   9 : C DESCRIPTION       :  Voir FIMAXI
  10 : C
  11 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12 : C      
  13 : C AUTEUR            :  A. BECCANTINI, LTMF
  14 : C     
  15 : C************************************************************************
  16 : C
  17 : C
  18 : C APPELES (Outils)  :  AUCUN
  19 : C
  20 : C APPELES (Calcul)  :  AUCUN 
  21 : C     
  22 : C
  23 : C************************************************************************
  24 : C
  25 : C ENTREES
  26 : C
  27 : C
  28 : C     1) Pointeurs de MELEMEs et de CHPOINTs "CENTRE" de la table DOMAINE
  29 : C
  30 : C     ICEN      : MELEME de 'POI1' SPG des CENTRES
  31 : C
  32 : C     IX2D,IY2D : coordonnés des centres 2D
  33 : C     
  34 : C     IS2D      : surface 2D
  35 : C     IVOL      : volume
  36 : C
  37 : C     2) CHPOINTs "CENTRE"
  38 : C
  39 : C     IPN,IGPN,ILGPN : pression, gradient, limiteur
  40 : C
  41 : C     
  42 : C SORTIES
  43 : C
  44 : C     IRES    : contribution au residu
  45 : C
  46 : C
  47 : C************************************************************************
  48 : C
  49 : C HISTORIQUE (Anomalies et modifications éventuelles)
  50 : C
  51 : C HISTORIQUE :  Créée le 25.2.2004
  52 : C 
  53 : C      
  54 : C 
  55 : C************************************************************************
  56 : C
  57 : C*** Variables de COOPTIO
  58 : C
  59 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  60 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  61 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  62 : C     &        ,IECHO,   IIMPI,  IOSPI
  63 : C     &        ,IDIM
  64 : CC     &        ,MCOORD      
  65 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  66 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  67 : C     &        ,NORINC,NORVAL,NORIND,NORVAD
  68 : C     &        ,NUCROU, IPSAUV,IFICLE,IPREFI,IREFOR,ISAFOR         
  69 : CC
  70 :       IMPLICIT INTEGER(I-N)
  71 :       INTEGER ICEN,IX2D,IY2D,IS2D,IVOL,IPN,IGPN,ILGPN,IRES
  72 :      &     , NBEL, IELEM, NP, INDP, IGEOM
  73 :       REAL*8 DX, DY, GX, GY, GEOM, AL, P
  74 :       CHARACTER*8 TYPE
  75 : C
  76 : C**** Les Includes
  77 : C
  78 : -INC SMCOORD
  79 : -INC CCOPTIO
  80 : -INC SMCHPOI
  81 :       POINTEUR MP.MPOVAL,     MGRP.MPOVAL,
  82 :      &         MALP.MPOVAL,   MPXC2D.MPOVAL,
  83 :      &         MPYC2D.MPOVAL, MPSU2D.MPOVAL,
  84 :      &         MPVOLU.MPOVAL, MPRES.MPOVAL
  85 : -INC SMELEME
  86 : C
  86 :       CALL LICHT(IPN,MP,TYPE,IGEOM)
  86 :       CALL LICHT(IGPN,MGRP,TYPE,IGEOM)
  86 :       CALL LICHT(ILGPN,MALP,TYPE,IGEOM)
  86 :       CALL LICHT(IX2D,MPXC2D,TYPE,IGEOM)
  86 :       CALL LICHT(IY2D,MPYC2D,TYPE,IGEOM)
  86 :       CALL LICHT(IS2D,MPSU2D,TYPE,IGEOM)
  86 :       CALL LICHT(IVOL,MPVOLU,TYPE,IGEOM)
  86 :       CALL LICHT(IRES,MPRES,TYPE,IGEOM)
  87 : C
  88 : C     SEGACT   MP
  89 : C     SEGACT   MGRP
  90 : C     SEGACT   MALP
  91 : C     SEGACT   MPXC2D
  92 : C     SEGACT   MPYC2D
  93 : C     SEGACT   MPSU2D
  94 : C     SEGACT   MPVOLU
  95 : C     SEGACT   MPRES
  96 : C
  97 :       MELEME=ICEN
  98 :       SEGACT MELEME
  99 :       NBEL=MELEME.NUM(/2)
 100 :       DO IELEM=1,NBEL,1
 101 :          NP=MELEME.NUM(1,IELEM)
 102 :          INDP = (NP-1)*3
 103 :          DX=MPXC2D.VPOCHA(IELEM,1) - XCOOR(INDP+1)
 104 :          DY=MPYC2D.VPOCHA(IELEM,1) - XCOOR(INDP+2)
 105 :          GX=MGRP.VPOCHA(IELEM,1)
 106 :          GY=MGRP.VPOCHA(IELEM,2)
 107 :          GEOM=MPSU2D.VPOCHA(IELEM,1)/MPVOLU.VPOCHA(IELEM,1)
 108 :          AL=MALP.VPOCHA(IELEM,1)
 109 :          P=MP.VPOCHA(IELEM,1)
 110 :          MPRES.VPOCHA(IELEM,1)=(P+(AL*((GX*DX)+(GY*DY))))*GEOM
 111 :       ENDDO
 112 : C
 113 :       SEGDES  MELEME
 114 :       SEGDES  MP
 115 :       SEGDES  MGRP
 116 :       SEGDES  MALP
 117 :       SEGDES  MPXC2D
 118 :       SEGDES  MPYC2D
 119 :       SEGDES  MPSU2D
 120 :       SEGDES  MPVOLU
 121 :       SEGDES  MPRES
 122 : C
 123 :  9999 CONTINUE
 124 : C      
 125 :       RETURN                                                                    
 126 :       END
 127 : 
 128 : 
 129 : 
 130 :  
 131 :  
 132 :  
 133 :  
 134 :