Télécharger la plaquette Cast3M


fr en

Télécharger cham12.eso

Retour à la liste

Numérotation des lignes : 

cham12

  1. C CHAM12    SOURCE    OF166741  24/10/07    21:15:06     12016          
  2.  
  3.       SUBROUTINE CHAM12(NBTHL,ITHR,ISUP,ISAUT,MMODEL,MCHELM,ICPR,MTRA2)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC CCGEOME
  11.  
  12. -INC SMCHAML
  13. -INC SMINTE
  14. -INC SMMODEL
  15. -INC SMELEME
  16.  
  17.       CHARACTER*(NCONCH) CONM
  18.       CHARACTER*(LOCOMP) LENAME
  19.  
  20.       LOGICAL FLAG1, FLAG3, FLAG4
  21.  
  22.       SEGMENT ISAUT(IVAL,NSOUS)
  23.       SEGMENT ICPR(NNNN)
  24.  
  25.       SEGMENT MTRA2
  26. C      Copie du CHPOINT dans MTRA2 pour aller plus vite ensuite
  27.        CHARACTER*(LOCOMP) INCO(N2)
  28.        REAL*8             BB(NX,N2)
  29. C        INCO  : Nom des INCONNUES du CHPOINT
  30. C        BB    : Valeurs au noeuds du MMODEL (associees au ICPR)
  31. C                NX : Nombre de noeuds differents dans le MODELE
  32. C                N2 : Nombre de composantes dans le CHPOINT
  33.       ENDSEGMENT
  34.  
  35.  
  36.       CONM  =' '
  37.  
  38.       NVAL  = ISAUT(/1)
  39.       NSOUS = ISAUT(/2)
  40.       N2    = MTRA2.BB(/2)
  41.  
  42. C     boucle sur les zones geometriques elementaires
  43. C
  44.       ischm = 0
  45.       DO 20 ISOUS=1,NSOUS
  46.          IPT2=ISAUT(1,ISOUS)
  47. C        On saute directement les SOUS-ZONES inutiles
  48.          IF(IPT2 .EQ. 0) GOTO 20
  49.          ischm = ischm + 1
  50.  
  51.          NPINT = 0
  52.          IPMINT = ISAUT(4,ISOUS)
  53.          ISUP1  = ISAUT(6,ISOUS)
  54.          IF (MMODEL.NE.0) THEN
  55.             IMODEL = KMODEL(ISOUS)
  56.             CONM   = CONMOD
  57.             MELE   = NEFMOD
  58. c*            IF (ISUP1.GT.1) MELE=NEFMOD
  59.             NPINT=INFMOD(1)
  60.          ENDIF
  61.  
  62.          IMACHE(ischm)  =IPT2
  63.          CONCHE(ischm)  =CONM
  64.          INFCHE(ischm,1)=0
  65.          INFCHE(ischm,2)=0
  66.          INFCHE(ischm,3)=NIFOUR
  67.          INFCHE(ischm,4)=IPMINT
  68.          IF (ISUP1.GT.1) THEN
  69.             INFCHE(ischm,5)=0
  70.          ELSE
  71.          ENDIF
  72.          INFCHE(ischm,6)=ISUP1
  73.  
  74.          MCHAML=ICHAML(ischm)
  75.          DO ICOMP=1,N2
  76.            NOMCHE(ICOMP)= MTRA2.INCO(ICOMP)
  77.            TYPCHE(ICOMP)='REAL*8'
  78.          ENDDO
  79.          NBN1  =IPT2.NUM(/1)
  80.          NBELE1=IPT2.NUM(/2)
  81.  
  82. C        On assure le travail contigu en memoire (Si // sur les threads)
  83.          IF(NBTHL .EQ. 1)THEN
  84.            IDEB  = 1
  85.            IFIN  = NBELE1
  86.  
  87.          ELSE
  88.            NBTHR= MIN(NBELE1,NBTHL)
  89.            IF(ithr .GT. NBTHR) GOTO 20
  90.            IRES = MOD(NBELE1,NBTHR)
  91.            IF(IRES  .EQ. 0)THEN
  92.              ILON  = NBELE1 / NBTHR
  93.              IDEB  = (ithr-1)* ILON + 1
  94.            ELSE
  95.              IF (ithr .LE. IRES) THEN
  96.                ILON  = (NBELE1 / NBTHR) + 1
  97.                IDEB  = (ithr-1)* ILON + 1
  98.              ELSE
  99.                ILON  = NBELE1 / NBTHR
  100.                IDEB  = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  101.              ENDIF
  102.            ENDIF
  103.            IFIN  = IDEB + ILON - 1
  104.          ENDIF
  105.  
  106.          IF (IPMINT .EQ. 0) THEN
  107. C          Remplissage des MELVAL aux NOEUDS de chaque composante
  108.            DO IE=IDEB,IFIN
  109.              DO IG=1,NBN1
  110.                INOEU=IPT2.NUM(IG,IE)
  111.                IPCPR=ICPR(INOEU)
  112.                DO ICOMP=1,N2
  113.                  MELVAL=IELVAL(ICOMP)
  114.                  VELCHE(IG,IE)=BB(IPCPR,ICOMP)
  115.                ENDDO
  116.              ENDDO
  117.            ENDDO
  118.  
  119.          ELSE
  120. C           Changement de support
  121.             MINTE =IPMINT
  122.             NBPGAU=SHPTOT(/3)
  123.             NBNO  =ISAUT(5,ISOUS)
  124.             MELGEO=NUMGEO(MELE)
  125.  
  126. C        Cas des JOINTS
  127.             IF( MELGEO.EQ.12 .OR. MELGEO.EQ.13 .OR. MELGEO.EQ.29 .OR.
  128.      &          MELGEO.EQ.30 .OR. MELGEO.EQ.31) THEN
  129.  
  130.               IDECA=0
  131.               IF(MELGEO.EQ.29) IDECA=2
  132.               IF(MELGEO.EQ.30) IDECA=3
  133.               IF(MELGEO.EQ.31) IDECA=4
  134.               NBNOU=NBNNE(MELGEO)-IDECA
  135.               NBNOV=NBNO - IDECA
  136.  
  137.               FAC=0.5D0
  138.               IF((MELGEO.EQ.12 .OR. MELGEO.EQ.13) .AND. 
  139.      &           NBNOU .GT.NBNO) THEN
  140.                 NBNOU=NBNO
  141.                 FAC=1.D0
  142.               ENDIF
  143.  
  144.               DO ICOMP=1,N2
  145.                  MELVAL= IELVAL(ICOMP)
  146.                  LENAME = NOMCHE(ICOMP)
  147.                  IF(LENAME.EQ.'P '.OR.LENAME.EQ.'PQ '
  148.      &                            .OR.LENAME.EQ.'TP ') THEN
  149.                    DO IE=IDEB,IFIN
  150.                      DO IG=1,NBPGAU
  151.                        XVAL1=0.D0
  152.                        DO INBNO=1,IDECA
  153.                          INOE =NBNOU + INBNO
  154.                          INB2 =NBNOV + INBNO
  155.                          INOEU=IPT2.NUM(INOE,IE)
  156.                          IPCPR=ICPR(INOEU)
  157.                          XVAL1=XVAL1 + BB(IPCPR,ICOMP)*SHPTOT(1,INB2,IG)
  158.                        ENDDO
  159.                        VELCHE(IG,IE)=XVAL1
  160.                      ENDDO
  161.                    ENDDO
  162.  
  163.                  ELSE
  164.  
  165.                    DO IE=IDEB,IFIN
  166.                      DO IG=1,NBPGAU
  167.                        XVAL1=0.D0
  168.                        DO INOE=1,NBNOU
  169.                          INOEU=IPT2.NUM(INOE,IE)
  170.                          IPCPR=ICPR(INOEU)
  171.                          XVAL1=XVAL1 + BB(IPCPR,ICOMP)*SHPTOT(1,INOE,IG)
  172.                        ENDDO
  173.                        VELCHE(IG,IE)=XVAL1*FAC
  174.                      ENDDO
  175.                    ENDDO
  176.                  ENDIF
  177.               ENDDO
  178.  
  179. C     Autres CAS
  180.             ELSE
  181.               DO ICOMP=1,N2
  182.                  MELVAL= IELVAL(ICOMP)
  183.                  DO IE=IDEB,IFIN
  184.                    DO IG=1,NBPGAU
  185.                      XVAL1=0.D0
  186.                      DO INOE=1,NBNO
  187.                        INOEU=IPT2.NUM(INOE,IE)
  188.                        IPCPR=ICPR(INOEU)
  189.                        XVAL1=XVAL1 + BB(IPCPR,ICOMP)*SHPTOT(1,INOE,IG)
  190.                      ENDDO
  191.                      VELCHE(IG,IE)=XVAL1
  192.                    ENDDO
  193.                  ENDDO
  194.               ENDDO
  195.             ENDIF
  196.          ENDIF
  197.  
  198. C cas integration dans l'epaisseur avec variable t temperature.
  199. C on transforme 'TINF' 'T' 'TSUP' en 'T' defini par une variation
  200. C parabolique dans l'epaisseur. si il n'y a que 'T' on ne fait rien.
  201. C Ce travail n'est a faire que pour les elements DKT, COQ4, COQ6 et COQ8
  202. C et uniquement si le MCHAML resultat n'est pas exprime aux noeuds !
  203.          IF (ISUP1.NE.1) THEN
  204.           IF ( (MELE.EQ.28.AND.NPINT.NE.0) .OR. (MELE.EQ.49) .OR.
  205.      &         (MELE.EQ.56) .OR. (MELE.EQ.41) ) THEN
  206.             FLAG1 = .FALSE.
  207.             FLAG3 = .FALSE.
  208.             FLAG4 = .FALSE.
  209.             DO 21 ISOU1 = 1,N2
  210.                LENAME=NOMCHE(ISOU1)
  211.                IF(LENAME.EQ.'T    ') FLAG1 = .TRUE.
  212.                IF(LENAME.EQ.'TINF ') FLAG3 = .TRUE.
  213.                IF(LENAME.EQ.'TSUP ') FLAG4 = .TRUE.
  214.    21       CONTINUE
  215.             IF (FLAG1.AND.FLAG3.AND.FLAG4) THEN
  216.                ISAUT(NVAL-1,ISOUS)=2
  217.                IVCH4=ISAUT(NVAL,ISOUS)
  218.                CALL CHAME4(MCHAML,IPMINT,IPT2,IVCH4)
  219.             ENDIF
  220.           ENDIF
  221.          ENDIF
  222. C
  223.  20   CONTINUE
  224. C     fin de la boucle sur les zones elementaires
  225.  
  226.       RETURN
  227.       END 
  228.  
  229.  
  230.  
  231.  

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