Esope source files

   1 : C IMPP1     SOURCE    CHAT      05/01/13    00:34:19     5004           
   2 :       SUBROUTINE IMPP1(IPT3,IPT2)
   3 : *
   4 : * création du maillage support des conditions aux limites de changement
   5 : * de phase: création en vue d'un bloquer mini ou d'un bloque maxi.
   6 : * C'est a dire que pour chaque point on cree un multiplicateurs
   7 : * les elements crees sont de type 22 
   8 :       IMPLICIT INTEGER(I-N)
   9 : -INC CCOPTIO
  10 : -INC SMELEME
  11 : -INC SMCOORD
  12 :       segment icpr(XCOOR(/1)/(IDIM+1))
  13 :       segini icpr
  14 :       meleme=ipt3
  15 :       segact meleme
  16 :       ipt1 = meleme
  17 :       do 1 I=1,max(1,ipt1.lisous(/1))
  18 :        if(ipt1.lisous(/1). NE. 0) then
  19 :          meleme = lisous(i)
  20 :          segact meleme
  21 :        endif
  22 :        do 2 J=1,NUM(/2)
  23 :        do 2 K = 1, num(/1)
  24 :        icpr(num(K,J))=1
  25 :    2  continue
  26 :       IF(ipt1.lisous(/1). NE. 0) segdes meleme
  27 :     1 continue 
  28 :       segdes ipt1
  29 :       na=0
  30 :       do 3 j=1,icpr(/1)
  31 :       if(icpr(J).ne.0) then
  32 :          na = na + 1
  33 :          icpr(j) = na
  34 :        endif
  35 :    3  continue
  36 :       idim1 = idim +1
  37 :       nbelem = na
  38 :       nbnn = 2
  39 :       nbsous=0
  40 :       nbref=0
  41 :       segini meleme
  42 :       itypel=22
  43 :       ndec = xcoor(/1)/(IDIM+1)   
  44 :       nbpts = ndec  + na 
  45 :       segadj mcoord
  46 :       nb = na      
  47 :       na=0  
  48 :       do 4 i=1,icpr(/1)
  49 :        if(icpr(i).ne.0) then
  50 :         na = na + 1
  51 :         nc =  na + ndec
  52 :         ncidi=(nc - 1 ) * idim1 +1
  53 :         num(1,na) = nc
  54 :         num(2,na) = i
  55 :         i1 = ( icpr(i) - 1) * idim1 +1
  56 :         xcoor(ncidi) = xcoor ( i1)
  57 :         xcoor(ncidi+1) = xcoor( i1 + 1)
  58 :         if (idim.eq.3) xcoor(ncidi+2) = xcoor( i1 + 2)
  59 :       endif
  60 :     4  continue
  61 :       segdes meleme
  62 :       ipt2=meleme
  63 :       segsup icpr
  64 :       return
  65 :       end
  66 :         
  67 : 
  68 :         
  69 : 
  70 :         
  71 :  
  72 :