Télécharger la plaquette Cast3M


fr en

Télécharger idphas.eso

Retour à la liste

Numérotation des lignes : 

idphas

  1. C IDPHAS    SOURCE    CB215821  24/04/12    21:16:22     11897          
  2.       SUBROUTINE IDPHAS(MFR,IPMODL,IPCOMP,NBROBL,NBRFAC)
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *    RECHERCHE DES NOMS DE COMPOSANTES DES VARIABLES MICROSTRUCTURES *
  6. *    ________________________________________________________        *
  7. *                                                                    *
  8. *    ENTREES:                                                        *
  9. *                                                                    *
  10. *        MFR       NUMERO DE LA FORMULATION                          *
  11. *        IPMODL    OBJET MODEL ELEMENTAIRE ( SEGMENT ACTIF )         *
  12. *                                                                    *
  13. *    SORTIES:                                                        *
  14. *                                                                    *
  15. *        IPCOMP    POINTEUR SUR LES LISTES DE NOMS DE COMPOSANTES    *
  16. *                  obligatoires et facultatives                      *
  17. *                                                                    *
  18. *        NBROBL    nombre de composantes obligatoires                *
  19. *                                                                    *
  20. *        NBRFAC    nombre de composantes facultatives                *
  21. *                                                                    *
  22. *--------------------------------------------------------------------*
  23. *
  24.       IMPLICIT INTEGER(I-N)
  25. -INC SMMODEL
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. *
  31.       CHARACTER*16 MOMODL(100)
  32.       logical lozut
  33. *
  34.       NBROBL=0
  35.       NBRFAC=0
  36.       SEGINI NOMID
  37.       IPCOMP = NOMID
  38. C
  39.       IMODEL=IPMODL
  40.       NMAT=MATMOD(/2)
  41.       NFOR=FORMOD(/2)
  42.       MELE=NEFMOD
  43.  
  44. C
  45.       CALL PLACE(FORMOD,NFOR,ICONV,'MELANGE')
  46. c      write(6,*) 'idph-1', iconv
  47.       IF (ICONV.EQ.0) RETURN
  48.  
  49.       if (nmat.lt.1) then
  50.        call erreur(5)
  51.        return
  52.       endif
  53.  
  54.       CALL MODMEL (MOMODL,NMOD)
  55.   50  CONTINUE
  56.  
  57.         CALL PLACE (MOMODL,NMOD,IPLAC,MATMOD(1))
  58. c      write(6,*) 'idph-2', iplac,matmod(1)
  59.       IF (IPLAC.EQ.1) THEN
  60. * CEREM
  61.           JGA=LESOBL(/2)
  62.           JGB=LESFAC(/2)
  63.           NBROBL=JGA+4
  64.           NBRFAC=JGB+0
  65.           segadj nomid
  66.          LESOBL(JGA+1)= 'AUST'
  67.          LESOBL(JGA+2)= 'FERR'
  68.          LESOBL(JGA+3)= 'BAIN'
  69.          LESOBL(JGA+4)= 'MART'
  70. *
  71.       ELSE IF (IPLAC.EQ.2) THEN
  72. * ZTMAX
  73.           JGA=LESOBL(/2)
  74.           JGB=LESFAC(/2)
  75.           NBROBL=JGA+2
  76.           NBRFAC=JGB+0
  77.           segadj nomid
  78.          LESOBL(JGA+1)= 'PHA1'
  79.          LESOBL(JGA+2)= 'PHA2'
  80. *
  81.       ELSEIF (iplac.eq.3.or.iplac.eq.4) THEN
  82. * PARALLELE ou SERIE : recupere les noms de phase
  83.           JGOBL = imodel.ivamod(/1)
  84. c      write(6,*) 'idph-jgobl', jgobl
  85.           JGA=LESOBL(/2)
  86.           JGB=LESFAC(/2)
  87.           NBROBL = JGA + JGOBL
  88.           NBRFAC = JGB
  89.           segadj nomid
  90.           kc1 = 0
  91.           do ic1 = 1,JGOBL
  92.            if (tymode(ic1).eq.'IMODEL') then
  93.              imode2 = ivamod(ic1)
  94.              segact imode2
  95.              lozut = .false.
  96.              if (kc1.ge.1) then
  97.               do kkc1 = 1, kc1
  98.                 if (imode2.conmod(17:24).eq.LESOBL(kkc1)) then
  99.                   lozut = .true.
  100. C          write(6,*) 'noms de phase redondants '
  101.                   call erreur(21)
  102.                   return
  103.                 endif
  104.               enddo
  105.              endif
  106.              if (.not.lozut) then
  107.                kc1 = kc1 + 1
  108.                LESOBL(kc1) = imode2.conmod(17:24)
  109.              endif
  110.            endif
  111.           enddo
  112.           NBROBL = JGA + kc1
  113.           NBRFAC = JGB
  114.           segadj nomid
  115. c      write(6,*) 'idph-kc1', kc1
  116. *
  117.       ELSE IF (IPLAC.EQ.6) THEN
  118. * TMM_LMT2
  119.           JGA=LESOBL(/2)
  120.           JGB=LESFAC(/2)
  121.           NBROBL=JGA+5
  122.           NBRFAC=JGB+0
  123.           segadj nomid
  124.          LESOBL(JGA+1)= 'PHA1'
  125.          LESOBL(JGA+2)= 'PHA2'
  126.          LESOBL(JGA+3)= 'PHA3'
  127.          LESOBL(JGA+4)= 'PHA4'
  128.          LESOBL(JGA+5)= 'PHA5'
  129. *
  130. *
  131.       ELSE IF (IPLAC.EQ.99) THEN
  132. * LEBLOND
  133.           IPCOMP = NOMID
  134. *
  135.       ELSE IF (IPLAC.EQ.99) THEN
  136. * MGRAIN
  137.           JGA=LESOBL(/2)
  138.           JGB=LESFAC(/2)
  139.           NBROBL=JGA+0
  140.           NBRFAC=JGB+0
  141.           IPCOMP = NOMID
  142. *
  143.       ELSE
  144. *
  145.       ENDIF
  146. *
  147.       NBROBL=LESOBL(/2)
  148.       NBRFAC=LESFAC(/2)
  149.       SEGDES NOMID
  150.       RETURN
  151.  
  152. C
  153.       END
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  

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