Télécharger la plaquette Cast3M


fr en

Télécharger impp1.eso

Retour à la liste

Numérotation des lignes : 

impp1

  1. C IMPP1     SOURCE    CB215821  21/10/18    21:15:21     11126          
  2.       SUBROUTINE IMPP1(MELEME,IPT2,IPT3,MOT1)
  3.  
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. * +--------------------------------------------------------------------+
  8. * création du maillage support des conditions aux limites de changement
  9. * de phase: création en vue d'un bloquer mini ou d'un bloque maxi.
  10. * C'est a dire que pour chaque point on cree un seul multiplicateur
  11. * les elements crees sont de type 22
  12. * IPT2 : MAILLAGE unique en cas de 'CHANGEMENT_PHASE' 'PARFAIT   '
  13. * IPT3 : 2eme MAILLAGE   en cas de 'CHANGEMENT_PHASE' 'SOLUBILITE' (Comme le FROTTEMENT pour le deuxieme LX)
  14. *
  15. * +--------------------------------------------------------------------+
  16.  
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20. -INC SMELEME
  21. -INC SMCOORD
  22.  
  23.       SEGMENT ICPR1(nbpts0)
  24.  
  25.       CHARACTER*(*)MOT1
  26.  
  27. * +--------------------------------------------------------------------+
  28.  
  29.       IPT2 = 0
  30.       IPT3 = 0
  31.  
  32.       IDIM1 = IDIM +1
  33.       segact mcoord
  34.       nbpts0= nbpts
  35.  
  36. C     Normalement le MAILLAGE receptionne n'a qu'une seule SOUS-ZONE
  37.       IF(MELEME.LISOUS(/1) .NE. 0)THEN
  38.         CALL ERREUR(5)
  39.       ENDIF
  40.       SEGINI,ICPR1
  41.  
  42. C     On procede au comptage
  43.       NBELEM = 0
  44.       DO J=1,MELEME.NUM(/2)
  45.         DO K = 1,MELEME.NUM(/1)
  46.           inum=MELEME.NUM(K,J)
  47.           IF(ICPR1(inum) .EQ. 0)THEN
  48.             NBELEM      = NBELEM + 1
  49.             ICPR1(inum) = NBELEM
  50.           ENDIF
  51.         ENDDO
  52.       ENDDO
  53.  
  54.  
  55.       IF    (MOT1(1:10) .EQ. 'PARFAIT   ')THEN
  56.         ICAS  = 1
  57.         NBNN  = 2
  58.         NBEL2 = NBELEM
  59.       ELSEIF(MOT1(1:10) .EQ. 'SOLUBILITE')THEN
  60.         ICAS  = 2
  61.         NBNN  = 3
  62.         NBEL2 = 2 * NBELEM
  63.       ELSE
  64.         CALL ERREUR(5)
  65.       ENDIF
  66.  
  67.       NBPTS = nbpts0 + NBEL2
  68.       SEGADJ,MCOORD
  69.  
  70. C     Creation et Remplissage du nouveau MAILLAGE (LX en premier, Primales en deuxieme)
  71.       NBSOUS= 0
  72.       NBREF = 0
  73.       IF    (ICAS .EQ. 1)THEN
  74.         SEGINI,IPT2
  75.         IPT2.ITYPEL=22
  76.       ELSEIF(ICAS .EQ. 2)THEN
  77.         SEGINI,IPT2,IPT3
  78.         IPT2.ITYPEL=22
  79.         IPT3.ITYPEL=22
  80.       ELSE
  81.         CALL ERREUR(5)
  82.       ENDIF
  83.  
  84.       DO 5 i=1,nbpts0
  85.         i_EL    = ICPR1(i)
  86.         IF(i_EL .EQ. 0) GOTO 5
  87.  
  88.         IP_INCO =(i  - 1) * IDIM1 + 1
  89.  
  90.         IF    (ICAS .EQ. 1)THEN
  91. C         Noeud 1 : 'LX'
  92. C         Noeud 2 : 'Inconnues classiques'
  93.           i_LX            = nbpts0 + i_EL
  94.           IPT2.NUM(1,i_EL)= i_LX
  95.           IPT2.NUM(2,i_EL)= i
  96.           IP_LX           =(i_LX - 1) * IDIM1 + 1
  97.           DO jj=1,IDIM
  98. C           Je donne au LX les memes coordonnees que le noeud support de l'inconnue primale
  99.             XVAL1 = MCOORD.XCOOR(IP_INCO + jj - 1)
  100.             MCOORD.XCOOR(IP_LX + jj - 1)= XVAL1
  101.           ENDDO
  102.  
  103.         ELSEIF(ICAS .EQ. 2)THEN
  104. C         MAILLAGE n°1 : IPT2
  105. C         -------------------
  106. C         Noeud 1 : 'LX' pour         la premiere inconnue PRIMALE
  107. C         Noeud 2 :  Noeud support de la premiere inconnue PRIMALE
  108. C         Noeud 3 :  Noeud support de la deuxieme inconnue PRIMALE
  109.           i_LX1            = nbpts0 + i_EL
  110.           IPT2.NUM(1,i_EL)= i_LX1
  111.           IPT2.NUM(2,i_EL)= i
  112.           IPT2.NUM(3,i_EL)= i
  113.           IP_LX1          =(i_LX1 - 1) * IDIM1 + 1
  114.  
  115. C         MAILLAGE n°2 : IPT3
  116. C         -------------------
  117. C         Noeud 1 : 'LX' pour la deuxieme         inconnue PRIMALE
  118. C         Noeud 2 :  Noeud support de la premiere inconnue PRIMALE
  119. C         Noeud 3 :  Noeud support de la deuxieme inconnue PRIMALE
  120.           i_LX2            = i_LX1  + NBELEM
  121.           IPT3.NUM(1,i_EL)= i_LX2
  122.           IPT3.NUM(2,i_EL)= i
  123.           IPT3.NUM(3,i_EL)= i
  124.           IP_LX2          =(i_LX2 - 1) * IDIM1 + 1
  125.  
  126.           DO jj=1,IDIM1
  127. C          Je donne aux LX les memes coordonnees que le noeud support des inconnues primales
  128.             XVAL1 = MCOORD.XCOOR(IP_INCO + jj - 1)
  129.             MCOORD.XCOOR(IP_LX1 + jj - 1)= XVAL1
  130.             MCOORD.XCOOR(IP_LX2 + jj - 1)= XVAL1
  131.           ENDDO
  132.         ELSE
  133.           CALL ERREUR(5)
  134.         ENDIF
  135.     5 continue
  136.  
  137.       SEGSUP,ICPR1
  138.       SEGDES,MCOORD
  139.  
  140.       END
  141.  
  142.  
  143.  

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