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

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