Esope source files

   1 : C VCHBOR    SOURCE    PV        09/03/12    21:36:46     6325           
   2 : C
   3 : C   Calcul des min et max du champ sur un objet deforme
   4 : C
   5 :       SUBROUTINE VCHBOR(MDEFOR,VCHMIN,VCHMAX)
   6 :       IMPLICIT INTEGER(I-N)
   7 : -INC CCOPTIO
   8 : -INC SMELEME
   9 : -INC SMCHPOI
  10 : -INC SMCHAML
  11 : -INC SMDEFOR
  12 : C
  13 : C
  14 :       segact mdefor
  15 :       do 100 idef=1,ampl(/1)
  16 :       meleme=ieldef(idef)
  17 :       mchpoi=mdchp(idef)
  18 :       mcham=mdchel(idef)
  19 :       model=mdmode(idef)
  20 : C
  21 :       if (mcham.ne.0) then
  22 : *  on cree le meleme a tracer        
  23 : *  on stocke les melval dans lisref (tres astucieux)
  24 :       mchelm=mcham
  25 :       segact mchelm
  26 :       nbsous=imache(/1)
  27 :       nbref=nbsous
  28 :       nbnn=0
  29 :       nbelem=0
  30 :       segini meleme
  31 :       itypel=0
  32 :       do 10 isous=1,nbsous
  33 :        lisous(isous)=imache(isous)
  34 :   10  continue
  35 :       do 20 isous=1,nbsous
  36 :        if (infche(isous,2).eq.1.and.infche(isous,6).ne.1) then
  37 : *  pas un chamelem aux noeuds
  37 :         call erreur(609)
  38 :         return
  39 :        endif
  40 :        mchaml=ichaml(isous)
  41 :        segact mchaml
  42 :        if (typche(/2).ne.1.or.typche(1).ne.'REAL*8') then
  43 : * pas un chamelem de scalaires
  43 :         call erreur(320)
  44 :         return
  45 :        endif
  46 :        lisref(isous)=ielval(1)
  47 :        segdes mchaml
  48 :   20  continue
  49 :       segdes mchelm
  50 : *
  51 :       do 30 isous=1,nbsous
  52 :        melval=lisref(isous)
  53 :        segact melval
  54 :        do 40 inn=1,velche(/1)
  55 :        do 40 iel=1,velche(/2)
  56 :         vchmin=min(vchmin,real(velche(inn,iel)))
  57 :         vchmax=max(vchmax,real(velche(inn,iel)))
  58 :   40  continue
  59 :   30  continue
  60 :       endif
  61 : **
  62 :       if (mchpoi.ne.0) then
  63 : C
  64 :       SEGACT MELEME
  65 :       SEGACT MCHPOI
  66 :       NSOUPO=IPCHP(/1)
  67 :       DO 9500 ISOUPO=1,NSOUPO
  68 :           MSOUPO=IPCHP(ISOUPO)
  69 :           SEGACT MSOUPO
  70 :           MPOVAL=IPOVAL
  71 :           SEGACT MPOVAL
  72 :           IPT2=IGEOC
  73 :           SEGACT IPT2
  74 :           NCC=NOCOMP(/2)
  74 :           IF (NCC.NE.1) CALL ERREUR(180)
  75 :           DO 9510 IC=1,NCC
  76 :             DO 9510 IEL=1,IPT2.NUM(/2)
  77 :               vchmin=min(vchmin,real(VPOCHA(IEL,IC)))
  78 :               vchmax=max(vchmax,real(VPOCHA(IEL,IC)))
  79 : 9510      CONTINUE
  80 : 9500  CONTINUE
  81 :       endif
  82 : C
  83 :  100  continue
  84 : C
  85 :       RETURN
  86 :       END
  87 :  
  88 :  
  89 :  
  90 : 
  91 :  
  92 :  
  93 :  
  94 :  
  95 :  
  96 :