Télécharger la plaquette Cast3M


fr en

Télécharger chelco.eso

Retour à la liste

Numérotation des lignes : 

chelco

  1. C CHELCO    SOURCE    PV090527  24/08/03    21:15:02     11976          
  2.  
  3. C=======================================================================
  4. C ENTREES
  5. C   IVAL = 0 SI ON VEUT IDIM CHAMELEMS CONTENANT CHACUN UNE COMPOSA
  6. C   IVAL = 1 SI ON VEUT LA PREMIERE COMPOSANTE
  7. C   IVAL = 2 SI ON VEUT LA DEUXIEME COMPOSANTE
  8. C   IVAL = 3 SI ON VEUT LA TROISIEME COMPOSANTE
  9. C   IPCHEL = POINTEUR ACTIF SUR UN CHAMP PAR ELEMENT (TYPE MCHAML)
  10.  
  11. C SORTIES
  12. C   IPCHE1 = POINTEURS ACTIFS SUR CHAMP/ELEMENT DE CHAQUE COORDONNEE
  13. C   IPCHE2
  14. C   IPCHE3
  15. C=======================================================================
  16.  
  17.       SUBROUTINE CHELCO(IVAL,IPCHEL,IPCHE1,IPCHE2,IPCHE3)
  18.  
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC CCGEOME
  25.  
  26. -INC SMCOORD
  27. -INC SMCHAML
  28. -INC SMELEME
  29. -INC SMINTE
  30.  
  31.       SEGMENT MTRA
  32.         REAL*8 XE(3,NBMA)
  33.       ENDSEGMENT
  34.  
  35.       CHARACTER*(4) NOMEL
  36.  
  37.       IF (IVAL.EQ.0) THEN
  38.         IDEB=1
  39.         IFIN=IDIM
  40.       ELSE
  41.         IDEB=IVAL
  42.         IFIN=IVAL
  43.       ENDIF
  44.  
  45.       MCHEL1 = IPCHEL
  46.       N1 = MCHEL1.INFCHE(/1)
  47.       N3 = MCHEL1.INFCHE(/2)
  48.       L1 = 8
  49.  
  50.       NSOUS = N1
  51.  
  52. C (Sur)Dimensionnement & Initialisation du segment MTRA
  53.       NBMA = 0
  54.       DO ISOUS = 1, NSOUS
  55.         MELEME = mchel1.IMACHE(ISOUS)
  56.         NBMA   = MAX( NBMA, meleme.NUM(/1))
  57.       ENDDO
  58.       SEGINI,MTRA
  59.  
  60. C BOUCLE SUR LES COMPOSANTES A EXTRAIRE
  61.  
  62.       ich = 0
  63.       IPCHE1 = 0
  64.       IPCHE2 = 0
  65.       IPCHE3 = 0
  66.  
  67.       DO ICO = IFIN, IDEB, -1
  68. C
  69. C   ON INITIALISE LE MCHAML CONTENANT LA COORDONNEE ICO
  70. C
  71.         SEGINI,MCHELM
  72.         mchelm.IFOCHE = MCHEL1.IFOCHE
  73.         mchelm.TITCHE = 'SCALAIRE'
  74.  
  75.         ich = ich + 1
  76.         IF (ich.EQ.1) IPCHE1 = MCHELM
  77.         IF (ich.EQ.2) IPCHE2 = MCHELM
  78.         IF (ich.EQ.3) IPCHE3 = MCHELM
  79. C
  80. C   BOUCLE SUR LES SOUS-ZONES
  81. C
  82.         DO ISOUS = 1, NSOUS
  83.  
  84.           mchelm.CONCHE(ISOUS) = MCHEL1.CONCHE(ISOUS)
  85.           mchelm.IMACHE(ISOUS) = MCHEL1.IMACHE(ISOUS)
  86.           DO isc = 1, N3
  87.             mchelm.INFCHE(ISOUS,isc) = MCHEL1.INFCHE(ISOUS,isc)
  88.           ENDDO
  89.  
  90.           MELEME = mchelm.IMACHE(ISOUS)
  91.           NBELEM = meleme.NUM(/2)
  92.           NBNN   = meleme.NUM(/1)
  93.  
  94.           ISUP = mchelm.INFCHE(ISOUS,6)
  95.           IF (ISUP.NE.1) THEN
  96.             MINTE  = mchelm.INFCHE(ISOUS,4)
  97.             NBPGAU = minte.SHPTOT(/3)
  98.           ELSE
  99.             NBPGAU = NBNN
  100.           ENDIF
  101.  
  102.           N2 = 1
  103.           SEGINI MCHAML
  104.           mchaml.NOMCHE(1) = 'SCAL    '
  105.           mchaml.TYPCHE(1) = 'REAL*8  '
  106.  
  107.           mchelm.ICHAML(ISOUS) = MCHAML
  108.  
  109.           N1EL   = NBELEM
  110.           N1PTEL = NBPGAU
  111.           N2EL   = 0
  112.           N2PTEL = 0
  113.           SEGINI,MELVAL
  114.           mchaml.IELVAL(1) = MELVAL
  115.  
  116.           IF (ISUP.NE.1) THEN
  117.             facz = 1.D0
  118.             NBOUC = NBNN
  119. C      ON DIVISE PAR 2 LE RESULTAT POUR CERTAINS ELEMENTS DE JOINTS
  120. CAM 29/3/16  UNIQUEMENT SI LE SUPPORT EST DIFFERENT DE 1
  121.             NOMEL = NOMS(meleme.ITYPEL)
  122.             IF ( NOMEL.EQ.'RAC2' .OR. NOMEL.EQ.'LIA3' .OR.
  123.      &           NOMEL.EQ.'LIA4' .OR. NOMEL.EQ.'LIA6' .OR.
  124.      &           NOMEL.EQ.'LIA8' .OR. NOMEL.EQ.'RAP3' .OR.
  125.      &           NOMEL.EQ.'LIP6' .OR. NOMEL.EQ.'LIP8' ) THEN
  126.               facz = 0.5D0
  127.               IF (NOMEL.EQ.'RAP3') NBOUC =  6
  128.               IF (NOMEL.EQ.'LIP6') NBOUC = 12
  129.               IF (NOMEL.EQ.'LIP8') NBOUC = 16
  130.             ENDIF 
  131.  
  132.             DO IB = 1, NBELEM
  133.               CALL ZERO(XE,3,NBNN)
  134.               CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  135.               DO IGAU = 1, NBPGAU
  136.                 XX = 0.D0
  137.                 DO isc = 1, NBOUC
  138.                   XX = XX + SHPTOT(1,isc,IGAU)*XE(ICO,isc)
  139.                 ENDDO
  140.                 VELCHE(IGAU,IB) = facz*XX
  141.               ENDDO
  142.             ENDDO
  143.  
  144.           ELSE
  145.             DO IB = 1, NBELEM
  146.               CALL ZERO(XE,3,NBNN)
  147.               CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  148.               DO IGAU = 1, NBPGAU
  149.                 VELCHE(IGAU,IB) = XE(ICO,IGAU)
  150.               ENDDO
  151.             ENDDO
  152.           ENDIF
  153.  
  154.         ENDDO
  155. C   Fin BOUCLE sur les SOUS-ZONES
  156.  
  157.       ENDDO
  158. C Fin BOUCLE sur les COMPOSANTEs
  159.  
  160.       SEGSUP MTRA
  161.  
  162. c      RETURN
  163.       END
  164.  
  165.  
  166.  
  167.  

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