Esope source files

   1 : C FIMVF2    SOURCE    CHAT      05/01/13    00:01:06     5004           
   2 :       SUBROUTINE FIMVF2(ILIINC,ICEN,IRO,IROVIT,IGRAV,
   3 :      &     IRES)
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  FIMVF2
   9 : C
  10 : C DESCRIPTION       :  VOIR FIMVF1
  11 : C
  12 : C                      Gaz ideal mono-espece: 
  13 : C                      residu lié à la gravité.
  14 : C
  15 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  16 : C      
  17 : C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF                        
  18 : C
  19 : C************************************************************************
  20 : C
  21 : C ENTREES  :
  22 : C
  23 : C            ILIINC  : LISTMOTS, noms des inconnues
  24 : C
  25 : C            ICEN    : SPG geometrique
  26 : C
  27 : C            IRO     : CHPOINT, densité
  28 : C     
  29 : C            IROVIT  : CHPOINT  qdm
  30 : C
  31 : C            IGRAV   : CHPOINT  gravité
  32 : C
  33 : C      
  34 : C SORTIES  : IRES    : CHPOINT  residu
  35 : C
  36 : C     
  37 : C************************************************************************
  38 : C
  39 : C HISTORIQUE (Anomalies et modifications éventuelles)
  40 : C
  41 : C HISTORIQUE :  Créée le 24.1.03
  42 : C 
  43 : C************************************************************************
  44 : C
  45 : C
  46 : C**** Variables de COOPTIO
  47 : C
  48 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  49 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  50 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  51 : C     &        ,IECHO,   IIMPI,  IOSPI
  52 : C     &        ,IDIM
  53 : C     &        ,MCOORD      
  54 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  55 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR, LTEXLU
  56 : C     &        ,NORINC, NORVAL, NORIND, NORVAD
  57 : C     &        ,NUCROU, IPSAUV, IFICLE, IPREFI
  58 : C
  59 : C**** Les variables
  60 : C      
  61 :       IMPLICIT INTEGER(I-N)
  62 :       INTEGER ILIINC,ICEN,IRO,IROVIT,IGRAV,IRES,N1,NLCE
  63 :      &     ,IGEOM
  64 :       CHARACTER*8 TYPE
  65 :       REAL*8 RO, RVX, RVY, RVZ, GX, GY, GZ
  66 : C
  67 : C**** Les includes
  68 : C
  69 : -INC CCOPTIO
  70 : -INC SMCHPOI
  71 : -INC SMELEME
  72 : C     
  73 :       IPT1 = ICEN
  74 :       SEGACT IPT1
  75 :       N1 = IPT1.NUM(/2)
  76 :       SEGDES IPT1
  77 : C
  78 : C**** Creation de CHPOINT IRES
  79 : C    
  80 :       TYPE='        '
  80 :       CALL KRCHP1(TYPE,ICEN,IRES,ILIINC)
  81 : C
  82 : C
  83 : C**** Lecture de MPOVALs
  84 : C
  84 :       CALL LICHT(IRO,MPOVA1,TYPE,IGEOM)
  84 :       CALL LICHT(IROVIT,MPOVA2,TYPE,IGEOM)
  84 :       CALL LICHT(IGRAV,MPOVA3,TYPE,IGEOM)
  84 :       CALL LICHT(IRES,MPOVA4,TYPE,IGEOM)
  85 : C
  86 : C**** LICHT active les MPOVALs en *MOD
  87 : C
  88 : C     i.e.
  89 : C
  90 : C     SEGACT MPOVA1*MOD
  91 : C     SEGACT MPOVA2*MOD
  92 : C     SEGACT MPOVA3*MOD
  93 : C     SEGACT MPOVA4*MOD
  94 : C
  95 : C
  96 :       GZ=0.0D0
  97 :       RVZ=0.0D0
  98 :       DO NLCE = 1, N1, 1
  99 : C
 100 : C******* Les differents variables a chaque centre
 101 : C        
 102 :          RO = MPOVA1.VPOCHA(NLCE,1)
 103 :          RVX = MPOVA2.VPOCHA(NLCE,1)
 104 :          RVY = MPOVA2.VPOCHA(NLCE,2)
 105 :          GX = MPOVA3.VPOCHA(NLCE,1)
 106 :          GY = MPOVA3.VPOCHA(NLCE,2)
 107 :          IF(IDIM .EQ. 3)THEN
 108 :             RVZ = MPOVA2.VPOCHA(NLCE,3)
 109 :             GZ = MPOVA3.VPOCHA(NLCE,3)
 110 :          ENDIF
 111 :          MPOVA4.VPOCHA(NLCE,1) = 0.0D0
 112 :          MPOVA4.VPOCHA(NLCE,2) = RO*GX
 113 :          MPOVA4.VPOCHA(NLCE,3) = RO*GY
 114 :          IF(IDIM .EQ. 3)THEN
 115 :             MPOVA4.VPOCHA(NLCE,4) = RO*GZ
 116 :          ENDIF
 117 :          MPOVA4.VPOCHA(NLCE,IDIM+2)=(RVX*GX)+(RVY*GY)+(RVZ*GZ)
 118 :       ENDDO
 119 : C
 120 :       SEGDES MPOVA1
 121 :       SEGDES MPOVA2
 122 :       SEGDES MPOVA3
 123 :       SEGDES MPOVA4
 124 : C
 125 :       RETURN
 126 :       END
 127 :  
 128 :  
 129 :