Télécharger la plaquette Cast3M


fr en

Télécharger coml.eso

Retour à la liste

Numérotation des lignes : 

coml

  1. C COML      SOURCE    CB215821  24/04/12    21:15:25     11897          
  2.  
  3.       SUBROUTINE COML
  4.  
  5. *-----------------------------------------------------------------------
  6. *                INTEGRATION DES LOIS DE COMPORTEMENT
  7. *-----------------------------------------------------------------------
  8. *    SYNTAXE
  9. * CHES1 = 'COMP' MODL CHET1 CHET2 ;
  10. *
  11. *  MMODEL     |    MODL    OBJET MODELE
  12. *             |
  13. *  MCHAML     |   CHET1  par exemple : contraintes, phases,
  14. *             | caracteristiques, variables internes, temperatures
  15. *             |         rassemblees dans le champ pour un etat
  16. *             |           initial
  17. *  MCHAML     |    CHET2  : idem etat final
  18. *  on entre ce dont on a besoin
  19. *  on sort ce qui doit
  20. *
  21. *  Ne concerne que les formulations MECANIQUE, POREUX, MELANGE, LIAISON
  22. *  DIFFUSION et METALLURGIE.
  23. *-----------------------------------------------------------------------
  24.  
  25.       IMPLICIT INTEGER (I-N)
  26.       IMPLICIT REAL*8(A-H,O-Z)
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMLENTI
  31. -INC SMCHAML
  32. -INC SMMODEL
  33. -INC SMCOORD
  34. -INC DECHE
  35. C     POINTEUR DES MCHEML EN ENTREE
  36.       SEGMENT llchee(NNN)
  37.       SEGMENT LIMODE(NSM)
  38. C
  39. C     =================================================================
  40. C     LECTURE D'UN MMODEL
  41. C     =================================================================
  42.       CALL LIROBJ('MMODEL  ',IPMODL,1,irt)
  43.       CALL ACTOBJ('MMODEL  ',IPMODL,1)
  44.       IF (IERR.NE.0) RETURN
  45. C
  46. C     DEROULER LE MMODEL POUR NE SELECTIONNER QUE CEUX D'INTERET
  47.       MMODEL = IPMODL
  48.       NSOUS  = KMODEL(/1)
  49.       NSM = NSOUS
  50.       SEGINI,LIMODE
  51. c
  52.       NLIMOD = 0
  53.       NMOMEL = 0
  54.       DO IM = 1, NSOUS
  55.         IMODEL = KMODEL(IM)
  56.         IF (FORMOD(1)(1:16).EQ.'MECANIQUE       ' .OR.
  57.      &      FORMOD(1)(1:16).EQ.'LIQUIDE         ' .OR.
  58.      &      FORMOD(1)(1:16).EQ.'POREUX          ' .OR.
  59.      &      FORMOD(1)(1:16).EQ.'LIAISON         ' .OR.
  60.      &      FORMOD(1)(1:16).EQ.'DIFFUSION       ' .OR.
  61.      &      FORMOD(1)(1:16).EQ.'METALLURGIE     '  ) THEN
  62.           NLIMOD = NLIMOD+1
  63.           IF (NLIMOD.GT.NSM) THEN
  64.             NSM = NSM * 2
  65.             SEGADJ LIMODE
  66.           ENDIF
  67.           LIMODE(NLIMOD) = IMODEL
  68.         ELSE IF (FORMOD(1)(1:16).EQ. 'MELANGE         ') THEN
  69.           NLIMOD = NLIMOD+1
  70.           IF (NLIMOD.GT.NSM) THEN
  71.             NSM = NSM * 2
  72.             SEGADJ LIMODE
  73.           ENDIF
  74.           LIMODE(NLIMOD) = IMODEL
  75.           nmomel = nmomel + 1
  76.           IF (MATMOD(1)(1:6).NE.'SERIE ') THEN
  77.             IF (IVAMOD(/1).GE.1) THEN
  78.               DO IVM1 = 1,IVAMOD(/1)
  79.                 IF (TYMODE(IVM1).EQ.'IMODEL  ') THEN
  80.                   IMODE1 = IVAMOD(IVM1)
  81.                   NLIMOD = NLIMOD+1
  82.                   IF (NLIMOD.GT.NSM) THEN
  83.                     NSM = NSM * 2
  84.                     SEGADJ LIMODE
  85.                   ENDIF
  86.                   LIMODE(NLIMOD) = IMODE1
  87.                 ENDIF
  88.               ENDDO
  89.             ENDIF
  90.           ENDIF
  91.         ENDIF
  92.       ENDDO
  93. C
  94.       IF (NLIMOD.LE.0) THEN
  95.         WRITE(IOIMP,*) 'ERREUR ANORMALE : MMODEL VIDE !'
  96.         CALL ERREUR(5)
  97.         RETURN
  98.       ENDIF
  99. C
  100. C     TEST DE NON REDONDANCE DES SOUS-MODELES
  101.       N1 = 1
  102.       DO 1161 IT1 = NLIMOD, 2, -1
  103.         IMODE1 = LIMODE(IT1)
  104.         DO IT2 = (IT1 - 1), 1, -1
  105.           IMODE2 = LIMODE(IT2)
  106.           IF (IMODE1.EQ.IMODE2) THEN
  107.             LIMODE(IT1) = 0
  108.             GOTO 1161
  109.           ELSE IF (IMODE1.IMAMOD.EQ.IMODE2.IMAMOD .AND.
  110.      &          IMODE1.CONMOD(1:LCONMO).EQ.IMODE2.CONMOD(1:LCONMO)) THEN
  111.             LIMODE(IT1) = 0
  112.             GOTO 1161
  113.           ENDIF
  114.         ENDDO
  115.         N1 = N1 + 1
  116.  1161 CONTINUE
  117. C
  118. C     CREATION DU MMODEL DE TRAVAIL (les sous-modeles de formulation 
  119. C     melange sont mis a la fin pour qu'ils soient traites en dernier 
  120. C     car ils dependent des resultats des autres sous-modeles)
  121.       SEGINI,MMODEL
  122.       IT1 = 0
  123.       IT2 = N1 - NMOMEL
  124.       DO IM = 1, NLIMOD
  125.         IMODEL = LIMODE(IM)
  126.         IF (IMODEL.GT.0) THEN
  127.           IF (FORMOD(1)(1:8).NE.'MELANGE ') THEN
  128.             IT1 = IT1 + 1
  129.             KMODEL(IT1) = IMODEL
  130.           ELSE
  131.             IT2 = IT2 + 1
  132.             KMODEL(IT2) = IMODEL
  133.           ENDIF
  134.         ENDIF
  135.       ENDDO
  136.       SEGSUP,LIMODE
  137.       IPMODL=MMODEL
  138. C
  139. C     =================================================================
  140. C     LECTURE DES MCHAML (AU MOINS UN)
  141. C     =================================================================
  142.       NNN    = 2
  143.       SEGINI,llchee
  144.       LACOND = 1
  145.       NBCHEE = 0
  146.  50   CONTINUE
  147.       CALL LIROBJ('MCHAML  ',ipche1,LACOND,irt)
  148.       IF (IERR.NE.0) GOTO 9010
  149.       IF (irt.eq.1) THEN
  150.         NBCHEE=NBCHEE+1
  151.         IF(NBCHEE .GT. NNN)THEN
  152.           NNN=NBCHEE*2+10
  153.           SEGADJ,llchee
  154.         ENDIF
  155.         CALL ACTOBJ('MCHAML  ',ipche1,1)
  156.         IF (IERR.NE.0) GOTO 9010
  157.         CALL REDUAF(ipche1,ipmodl,ipch,0,iret,kerr)
  158.         IF (iret.NE.1) CALL ERREUR(kerr)
  159.         IF (IERR.NE.0) GOTO 9010
  160.         llchee(NBCHEE) = ipch
  161.         LACOND = 0
  162.         GOTO 50
  163.       ENDIF
  164. C
  165. C     =================================================================
  166. C     CREATION DES DECHE
  167. C     =================================================================
  168.       iimel = 500
  169.       CALL oooprl(1)
  170. C     On a besoin du MCOORD plus loin dans doxe.eso
  171.       segact,mcoord
  172.       segini,lilmel
  173.       ijmel=0
  174.       do iem = 1, NBCHEE
  175.         mchelm = llchee(iem)
  176.         n1 = conche(/2)
  177.         n3 = infche(/2)
  178.         do in1 = 1, n1
  179.           mchaml = ichaml(in1)
  180.           n2 = nomche(/2)
  181.           do in2 = 1, n2
  182.             segini deche
  183.             indec  = iem
  184.             ieldec = -1*ielval(in2)
  185.             typdec = typche(in2)
  186.             typree = typdec(1:6).eq.'REAL*8'
  187.             nomdec = nomche(in2)
  188.             imadec = imache(in1)
  189.             condec = conche(in1)
  190.             ifodec = ifoche
  191.             do in3 = 1, n3
  192.               infdec(in3) = infche(in1,in3)
  193.             enddo
  194. *        write (ioimp,*) ' coml in1 in2 condec ',in1,in2,condec
  195.             ijmel=ijmel+1
  196.             if (ijmel.gt.iimel)then
  197.               iimel=iimel+500
  198.               segadj lilmel
  199.             endif
  200.             lilmel(ijmel) = deche
  201.           enddo
  202.         enddo
  203.       enddo
  204.       iimel=ijmel
  205.       segadj lilmel
  206.       CALL oooprl(0)
  207.       ipmel= lilmel
  208. C
  209. C     =================================================================
  210. C     Indice des deche pour le champ de sortie
  211.       INDESO = NBCHEE + 1
  212. C
  213. C     Indicateur(s) d'erreur si non nul(s)
  214.       IRETOU = 0
  215. C
  216.       CALL COML2(IPMODL,ipmel,INDESO,IRETOU)
  217. C
  218. C     =================================================================
  219. C     Sortie sur une erreur bloquante
  220.       IF (IERR.GT.0 .OR. IRETOU.NE.0) GOTO 9000
  221. C
  222. C     Construction du MCHAML resultat : sortie normale
  223.       lilmel = ipmel
  224.       iga = 0
  225.       n3 = 0
  226.       kme = 0
  227. *
  228.       DO 107 iol = 1, lilmel(/1)
  229.         deche = lilmel(iol)
  230.         IF (indec.EQ.INDESO) THEN
  231.           iga = iga + 1
  232.           if (iga.eq.1) kme = iol
  233.           n3 = max(n3,infdec(/1))
  234.         ELSE
  235.          segsup deche
  236.          lilmel(iol) = 0
  237.         ENDIF
  238.   107 CONTINUE
  239.  
  240.       call oooprl(1)
  241.       jg = iga
  242.       segini mlenti
  243.       n1 = iga
  244.       n2 = iga
  245.       L1 = 13
  246.       SEGINI,mchelm
  247.       TITCHE = 'CREE PAR COMP'
  248.       deche = lilmel(kme)
  249.       IFOCHE = ifodec
  250.       CONCHE(1) = condec
  251.       IMACHE(1) = imadec
  252.       DO in3 = 1, infdec(/1)
  253.         INFCHE(1,in3) = infdec(in3)
  254.       ENDDO
  255.       SEGINI,mchaml
  256.       ICHAML(1)=mchaml
  257.       kga = 1
  258.       iga = 0
  259.       DO 108 iol = 1, lilmel(/1)
  260.         deche = lilmel(iol)
  261.         if (deche.eq.0) goto 108
  262.         melval=ABS(ieldec)
  263.         IF (indec.EQ.INDESO) THEN
  264. c... compresse eventuellement le melval s il est constant
  265.           CALL comred(melval)
  266.  
  267.           do 120 ik=1,kga
  268.             if (imadec.ne.imache(ik)) goto 120
  269.             if (condec(1:LCONMO).ne.conche(ik)(1:NCONCH)) goto 120
  270.             DO in3 = 1, infdec(/1)
  271.               if(INFCHE(ik,in3).ne.infdec(in3)) goto 120
  272.             ENDDO
  273.             mchaml = ichaml(ik)
  274.             kme = lect(ik)
  275.             kme = kme + 1
  276.             NOMCHE(kme) = nomdec
  277.             TYPCHE(kme) = typdec
  278.             IELVAL(kme) = melval
  279.             lect(ik) = kme
  280.             goto 109
  281.  120      continue
  282.           kga = kga + 1
  283. c         IFOCHE = ifodec
  284.           CONCHE(kga) = condec
  285.           IMACHE(kga) = imadec
  286.           DO in3 = 1, infdec(/1)
  287.             INFCHE(kga,in3) = infdec(in3)
  288.           ENDDO
  289.           SEGINI,mchaml
  290.           ICHAML(kga)=mchaml
  291.           NOMCHE(1) = nomdec
  292.           TYPCHE(1) = typdec
  293.           IELVAL(1) = melval
  294.           lect(kga) = 1
  295.         ENDIF
  296.  109    CONTINUE
  297.         SEGSUP,deche
  298.  108  continue
  299.  
  300.       n1 = kga
  301.       segadj mchelm
  302.       do iga = 1,n1
  303.         mchaml = ichaml(iga)
  304.         n2 = lect(iga)
  305.         segadj mchaml
  306.       enddo
  307.       segdes,mcoord
  308.       call oooprl(0)
  309. C      
  310.       CALL ACTOBJ('MCHAML  ',mchelm,1)
  311.       CALL ECROBJ('MCHAML  ',mchelm)
  312. c      write(ioimp,*) 'sortie normale de coml', mchelm
  313.  
  314.  9000 CONTINUE
  315.       MMODEL=IPMODL
  316.       SEGSUP,MMODEL
  317.       SEGSUP,lilmel
  318.  9010 CONTINUE
  319.       SEGSUP,llchee
  320.  
  321.       END
  322.  
  323.  
  324.  
  325.  

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