Télécharger la plaquette Cast3M


fr en

Télécharger mixe.eso

Retour à la liste

Numérotation des lignes : 

mixe

  1. C MIXE      SOURCE    CB215821  24/04/12    21:16:43     11897          
  2.       SUBROUTINE MIXE
  3.  
  4. C_______________________________________________________________________
  5. C
  6. C    OPERATEUR DE MELANGE
  7. C
  8. C_______________________________________________________________________
  9. C      
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMCHAML
  17. -INC SMMODEL
  18.  
  19.       character*4  mcle(1)
  20.       data  mcle/'NOER'/
  21.  
  22.       IPCHE1 = 0
  23.       IPCHE2 = 0
  24.       IPCHE3 = 0
  25.       IPCHP4 = 0
  26.  
  27.       IPCHA2 = 0
  28.       IPCHA1 = 0
  29.       noer=0
  30.       call lirmot(mcle,1,noer,0)
  31.  
  32.       CALL LIROBJ('MMODEL  ',IPMOD0,1,irt1)
  33.       IF (IERR.NE.0) RETURN
  34.       CALL ACTOBJ('MMODEL  ',IPMOD0,1)
  35. * On deroule le modele initial IPMOD0 et on ne garde que les sous-
  36. * modeles d interet -> on cree un nouveau modele IPMODL
  37.       mmodel = IPMOD0
  38.       NSOUS = mmodel.kmodel(/1)
  39.       IPMODL = IPMOD0
  40.  
  41.       N1 = NSOUS
  42.       segini mmode1
  43.       k1 = 0
  44.       DO 10 im = 1, NSOUS
  45.         imodel = mmodel.kmodel(im)
  46.         IF (imodel.formod(1)(1:7).NE.'MELANGE') GOTO 10
  47.          k1 = k1 + 1
  48.          mmode1.kmodel(k1) = imodel
  49.  10   CONTINUE
  50.  
  51.       if (k1.gt.0) then
  52.         n1 = k1
  53.         segadj mmode1
  54.         IPMODL = mmode1
  55.       endif
  56.  
  57.  
  58. C- 1 ER  CHAMP/ELEMENT
  59. C
  60.       CALL LIROBJ('MCHAML  ',IPIN1,1,irt1)
  61.       IF (IERR.NE.0) RETURN
  62.       CALL ACTOBJ('MCHAML  ',IPIN1,1)
  63.       CALL REDUAF(IPIN1,IPMODL,IPCHA1,0,IR1,KER)
  64.       IF(IERR .NE. 0) RETURN
  65.  
  66. C- 2 EME CHAMP/ELEMENT
  67. C
  68.       CALL LIROBJ('MCHAML  ',IPIN2,1,irt1)
  69.       IF (IERR.NE.0) RETURN
  70.         CALL ACTOBJ('MCHAML  ',IPIN2,1)
  71.         CALL REDUAF(IPIN2,IPMODL,IPCHA2,0,IR2,KER)
  72.         IF(IERR .NE. 0) RETURN
  73.  
  74.       IF(IR1  .NE. 1.OR.IR2  .NE. 1) CALL ERREUR(KER)
  75.       IF(IR1  .EQ. 1) THEN
  76.          IPCHE1 = IPCHA1
  77.          IPCHE2 = IPIN2
  78.       ELSEIF(IR2 .EQ. 1) THEN
  79.          IPCHE1 = IPCHA2
  80.          IPCHE2 = IPIN1
  81.       ENDIF
  82.  
  83.       CALL MIXEMP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IRET,NOER)
  84.       IF (IERR.EQ.2 ) RETURN
  85.       if (iret.eq.1.or.(iret.eq.0.and.IPCHE3.GT.0)) then
  86. C
  87.  
  88.       CALL ACTOBJ('MCHAML  ',IPCHE3,1)
  89.       CALL ECROBJ('MCHAML  ',IPCHE3)
  90.       endif
  91.  
  92.  
  93.       RETURN 
  94.       END
  95.  
  96.  
  97.  
  98.  

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