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    OF166741  24/10/21    21:15:20     12042          
  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 CCPRECO
  24.  
  25. -INC SMMODEL
  26.  
  27.       CHARACTER*(16) MOT16
  28.       SEGMENT,LIMODE(0)
  29.  
  30.       MOT16='MELANGE         '
  31.  
  32.       MMODEL=IPMODL
  33.       NSOUS =KMODEL(/1)
  34.  
  35. C     Recherche d'un eventuel modele de MELANGE 'PARALLELE'
  36.       DO im = 1,NSOUS
  37.          imodel = kmodel(im)
  38.          IF (formod(1) .eq. MOT16) THEN
  39.            if (matmod(1)(1:10).eq.'PARALLELE ') GOTO 1
  40.          ENDIF
  41.       ENDDO
  42.  
  43.       IMELAN=0
  44.       MMODE1=IPMODL
  45.       RETURN
  46.  
  47.  1    CONTINUE      
  48.       IMELAN=1
  49.  
  50. C     Verification si presence dans le preconditionnement CCPRECO
  51.       ith   = oothrd
  52.       ith1  = ith + 1
  53.  
  54.       ITAILL = NBMOMO(ith1)
  55.       DO 10 IPREC1 = 1, ITAILL
  56.         IF (PMOMO1(IPREC1,ith1) .NE. mmodel)       GOTO 10
  57.         MMODE1 = PMOMO2(IPREC1,ith1)
  58.         CALL ACTOBJ('MMODEL  ',MMODE1,1)
  59. C        IF (IPREC1 .EQ. NPREDU) THEN
  60. C          PRINT *,' CCPRECO trop petit :',IPREC1
  61. C          CALL ERREUR(5)
  62. C        ENDIF
  63. C        PRINT *,'Preconditionnement MODETE trouve',mmodel,MMODE1,IPREC1
  64.  
  65. C       Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1 du MMODEL etendu
  66.         IF (IPREC1 .EQ. 1) RETURN
  67.         DO IPREC2 = IPREC1,2,-1
  68.           PMOMO1(IPREC2,ith1) = PMOMO1(IPREC2 - 1,ith1)
  69.           PMOMO2(IPREC2,ith1) = PMOMO2(IPREC2 - 1,ith1)
  70.         ENDDO
  71.         PMOMO1(1,ith1) = mmodel
  72.         PMOMO2(1,ith1) = MMODE1
  73.         RETURN
  74.  10   CONTINUE
  75.  
  76. C     En cas de modele melange derouler : creer un nouveau MMODEL
  77.       SEGINI,LIMODE
  78.       do im = 1,NSOUS
  79.          imodel = kmodel(im)
  80.          CALL ajou(LIMODE,imodel)
  81.          if (formod(1) .eq. MOT16) then
  82.             if (ivamod(/1).ge.1) then
  83.                do ivm1 = 1,ivamod(/1)
  84.                   if (tymode(ivm1).eq.'IMODEL') then
  85.                     iel=ivamod(ivm1)
  86.                     CALL ajou(LIMODE,iel)
  87.                   endif
  88.                enddo
  89.             endif
  90.          endif
  91.       enddo
  92.  
  93.       N1=LIMODE(/1)
  94.       SEGINI,MMODE1
  95.       DO iii=1,N1
  96.         MMODE1.KMODEL(iii)=LIMODE(iii)
  97.       ENDDO
  98.       SEGSUP,LIMODE
  99.  
  100. C     Mise a jour du preconditionnement dans CCPRECO
  101.       ITAILL       = MIN(ITAILL + 1, NPREDU)
  102.       NBMOMO(ith1) = ITAILL
  103.       DO IPRECO = ITAILL,2,-1
  104.         PMOMO1(IPRECO,ith1) = PMOMO1(IPRECO - 1,ith1)
  105.         PMOMO2(IPRECO,ith1) = PMOMO2(IPRECO - 1,ith1)
  106.       ENDDO
  107.       PMOMO1(1,ith1) = mmodel
  108.       PMOMO2(1,ith1) = MMODE1
  109. C*      PRINT *,'Preconditionnement MODETE fabrique',mmodel,MMODE1
  110.  
  111. c      RETURN
  112.       END
  113.  
  114.  
  115.  

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