Télécharger la plaquette Cast3M


fr en

Télécharger vchbor.eso

Retour à la liste

Numérotation des lignes : 

vchbor

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales