Télécharger la plaquette Cast3M


fr en

Télécharger modete.eso

Retour à la liste

Numérotation des lignes : 

modete

  1. C MODETE    SOURCE    CB215821  24/04/12    21:16:46     11897          
  2.  
  3.       SUBROUTINE MODETE(IPMODL,MMODE1,IMELAN)
  4.  
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7.  
  8. ***********************************************************************
  9. * Cette SUBROUTINE permet d'etendre un MMODEL lorsqu'une formulation
  10. * de MELANGE est presente
  11. *
  12. * Entrees : 
  13. *   IPMODL : Pointeur sur un objet MMODEL
  14. *   
  15. * Sorties : 
  16. *   MMODE1 : Modele etendu           (si presence MELANGE 'PARALLELE')
  17. *            Identique a celui donne (si absence  MELANGE 'PARALLELE')
  18. *   IMELAN : Flag valant 1 si un MMODEL de MELANGE a ete trouve
  19. *                        0 sinon
  20. ***********************************************************************
  21.  
  22. -INC PPARAM
  23. -INC SMMODEL
  24. -INC CCPRECO
  25.  
  26.       CHARACTER*(16) MOT16
  27.       SEGMENT,LIMODE(0)
  28.  
  29.       MOT16='MELANGE         '
  30.  
  31.       MMODEL=IPMODL
  32.       NSOUS =KMODEL(/1)
  33.  
  34. C     Recherche d'un eventuel modele de MELANGE 'PARALLELE'
  35.       DO im = 1,NSOUS
  36.          imodel = kmodel(im)
  37.          IF (formod(1) .eq. MOT16) THEN
  38.            if (matmod(1)(1:10).eq.'PARALLELE ') GOTO 1
  39.          ENDIF
  40.       ENDDO
  41.  
  42.       IMELAN=0
  43.       MMODE1=IPMODL
  44.       RETURN
  45.  
  46.  1    CONTINUE      
  47.       IMELAN=1
  48.  
  49. C     Verification si presence dans le preconditionnement CCPRECO
  50.       ith   = oothrd
  51.       ith1  = ith + 1
  52.  
  53.       ITAILL = NBMOMO(ith1)
  54.       DO 10 IPREC1 = 1, ITAILL
  55.         IF (PMOMO1(IPREC1,ith1) .NE. mmodel)       GOTO 10
  56.         MMODE1 = PMOMO2(IPREC1,ith1)
  57.         CALL ACTOBJ('MMODEL  ',MMODE1,1)
  58. C        IF (IPREC1 .EQ. NPREDU) THEN
  59. C          PRINT *,' CCPRECO trop petit :',IPREC1
  60. C          CALL ERREUR(5)
  61. C        ENDIF
  62. C        PRINT *,'Preconditionnement MODETE trouve',mmodel,MMODE1,IPREC1
  63.  
  64. C       Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1 du MMODEL etendu
  65.         IF (IPREC1 .EQ. 1) RETURN
  66.         DO IPREC2 = IPREC1,2,-1
  67.           PMOMO1(IPREC2,ith1) = PMOMO1(IPREC2 - 1,ith1)
  68.           PMOMO2(IPREC2,ith1) = PMOMO2(IPREC2 - 1,ith1)
  69.         ENDDO
  70.         PMOMO1(1,ith1) = mmodel
  71.         PMOMO2(1,ith1) = MMODE1
  72.         RETURN
  73.  10   CONTINUE
  74.  
  75. C     En cas de modele melange derouler : creer un nouveau MMODEL
  76.       SEGINI,LIMODE
  77.       do im = 1,NSOUS
  78.          imodel = kmodel(im)
  79.          CALL ajou(LIMODE,imodel)
  80.          if (formod(1) .eq. MOT16) then
  81.             if (ivamod(/1).ge.1) then
  82.                do ivm1 = 1,ivamod(/1)
  83.                   if (tymode(ivm1).eq.'IMODEL') then
  84.                     iel=ivamod(ivm1)
  85.                     CALL ajou(LIMODE,iel)
  86.                   endif
  87.                enddo
  88.             endif
  89.          endif
  90.       enddo
  91.  
  92.       N1=LIMODE(/1)
  93.       SEGINI,MMODE1
  94.       DO iii=1,N1
  95.         MMODE1.KMODEL(iii)=LIMODE(iii)
  96.       ENDDO
  97.       SEGSUP,LIMODE
  98.  
  99. C     Mise a jour du preconditionnement dans CCPRECO
  100.       ITAILL       = MIN(ITAILL + 1, NPREDU)
  101.       NBMOMO(ith1) = ITAILL
  102.       DO IPRECO = ITAILL,2,-1
  103.         PMOMO1(IPRECO,ith1) = PMOMO1(IPRECO - 1,ith1)
  104.         PMOMO2(IPRECO,ith1) = PMOMO2(IPRECO - 1,ith1)
  105.       ENDDO
  106.       PMOMO1(1,ith1) = mmodel
  107.       PMOMO2(1,ith1) = MMODE1
  108.       PRINT *,'Preconditionnement MODETE fabrique',mmodel,MMODE1
  109.  
  110.       END
  111.  
  112.  
  113.  

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