Télécharger la plaquette Cast3M


fr en

Télécharger comouw.eso

Retour à la liste

Numérotation des lignes : 

comouw

  1. C COMOUW    SOURCE    JK148537  24/10/29    21:15:04     12056          
  2.       SUBROUTINE COMOUW(iqmod,ipcon,INDESO,ipil,iwrk52,iwrk53,
  3.      &iretou,iwr522)
  4. *-------------------------------------------------
  5. * identifie les melval de la pile
  6. *  - recherche d abord ceux lies au modele
  7. *  - puis tous les autres rang
  8. * les active
  9. * !!!!! 2023 : tous les deche ayant le bon support a trier 
  10. * points delicats : evite de passer certaines composantes de
  11. * constituants differents de celui du modele :
  12. * dans tous les cas, caracteristiques materiau et geometrique,
  13. * de plus pour la mecanique, contraintes,
  14. * variables internes et deformations inelastiques.
  15. * cependant pour les autres on croise les doigts en esperant que les noms
  16. * de composantes correspondent a un seul constituant
  17. * pas de garde fou
  18. * puis suivant les formulations cree les deche associes
  19. * aux noms de composantes des mchaml attendus en sortie
  20. * (le rang est INDESO)
  21. *-------------------------------------------------
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMMODEL
  28. -INC SMCHAML
  29. -INC DECHE
  30.       logical nouvid
  31. c
  32.       nouvid = .true.
  33.       lilcon = ipcon
  34.       wrk53 = iwrk53
  35. c
  36.       imodel = iqmod
  37.  
  38. *-------------------------------------------------
  39.       CALL oooprl(1)
  40.       call comou2(iqmod,INDESO,ipil,iwrk52,iwrk53,iwr522)
  41.       CALL oooprl(0)
  42.  
  43.       liluc = ipil
  44.       iiluc= liluc(/1)
  45.       ijluc = iiluc
  46.       wrk52  = iwrk52
  47.       wrk522 = iwr522
  48.       nexo = exova0(/1)
  49. c
  50.       do icon = 1,lilcon(/1)
  51.         deche = lilcon(icon)
  52.  
  53. C* Cas du test pouvant arriver ?
  54.         if (deche.LE.0) GOTO 40
  55.  
  56. * recherche du nom de composante parmi celles qui existent
  57. *
  58.        do juc = 1,ijluc
  59.  
  60. C composantes inutiles formulation MELANGE
  61.          if (juc.ne.23.and.(cmate.eq.'PARALLEL'.or.
  62.      &cmate.eq.'SERIE')) goto 35
  63.          if ((.not.((juc.ge.13.and.juc.le.15).or.juc.eq.23.or.juc.eq.1
  64.      &.or.juc.eq.2)).and.
  65.      &formod(1)(1:8).eq.'MELANGE') goto 35 
  66.  
  67.          nomid  = liluc(juc,1)
  68. C Cas du test ci-dessous puvant arriver ?
  69.          if (nomid.le.0) goto 35
  70.          nobl = lesobl(/2)
  71.          nfac = lesfac(/2)
  72.          pilnec = liluc(juc,2)
  73.          if (nobl.gt.0) then
  74.           do 30 jm =1,nobl
  75.             if (nomdec.ne.lesobl(jm)) goto 30
  76.             if (juc.eq.13.or.juc.eq.14) then
  77.               if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  78.                 if (pilobl(jm,indec).gt.0) then
  79.                   dec1 = pilobl(jm,indec)
  80.                   if (dec1.imadec.eq.imamod) then
  81.                     if (imadec.ne.imamod) then
  82. c surcharge stationnaire
  83.                       pilobl(jm,indec) = deche
  84.                     else
  85.        write(6,*) 'comouw redondance ',nomdec,indec,imadec,conmod,imamod
  86. *          write(6,*) jm, dec1.imadec,dec1.indec
  87.                      call erreur(21)
  88.                      return
  89.                     endif
  90.                   else  
  91.                     if (imadec.ne.imamod) then
  92.        write(6,*) 'comredondon2 ',nomdec,conmod,imamod,indec,imadec
  93. *          write(6,*) jm, dec1.imadec,dec1.indec
  94.                      call erreur(21)
  95.                      return
  96.                     endif               
  97.                   endif  
  98.                 endif
  99.                 pilobl(jm,indec)=deche
  100.                 goto 40
  101.               endif
  102.             elseif ((FORMOD(1)(1:10).EQ.'MECANIQUE '.OR.
  103.      &FORMOD(1)(1:10).EQ.'POREUX    ').and.
  104.      & (juc.ge.11.and.juc.le.24.and.juc.ne.15)) then
  105.               if (pilobl(jm,indec).eq.0) pilobl(jm,indec)=deche
  106.               if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  107.                 pilobl(jm,indec)=deche
  108.               endif
  109.               goto 40
  110.             elseif (juc.eq.23.and.cmate.ne.'PARALLEL'.and.
  111.      &cmate.ne.'SERIE') then
  112.               if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  113.             if (pilobl(jm,indec).gt.0) then
  114.          write(6,*) 'comouw redondance donnees',nomdec,conmod,imamod
  115.                call erreur(21)
  116.                return
  117.             endif
  118.                 pilobl(jm,indec)=deche
  119.                 goto 40
  120.               endif
  121.             else
  122.                 pilobl(jm,indec)=deche
  123.                 goto 40
  124.             endif
  125.   30      continue
  126.          endif
  127.          if (nfac.gt.0) then
  128.           do 31 jm =1,nfac
  129.             if (nomdec.ne.lesfac(jm)) goto 31
  130.              if (juc.eq.13.or.juc.eq.14) then
  131.               if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  132.                 pilfac(jm,indec)=deche
  133.                 goto 40
  134.               endif
  135.              elseif ((FORMOD(1)(1:10).EQ.'MECANIQUE '.OR.
  136.      &FORMOD(1)(1:10).EQ.'POREUX    ').and.
  137.      & (juc.ge.10.and.juc.le.24.and.juc.ne.15)) then
  138.               if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  139.                 pilfac(jm,indec)=deche
  140.                 goto 40
  141.               endif
  142.              else
  143.                 pilfac(jm,indec)=deche
  144.                 goto 40
  145.              endif
  146.   31      continue
  147.          endif
  148.  
  149. ********          segdes nomid,pilnec
  150.   35    continue
  151.        enddo
  152.  
  153.        if (condec(1:LCONMO).ne.conmod(1:LCONMO)) goto 40
  154.  
  155. * pas dans les listes : reajuster wrk52
  156.  
  157.         nsca = scal0(/1)
  158.         ndep = depl0(/1)
  159.         nfor = forc0(/1)
  160.         ngra = grad0(/1)
  161.         nstrs = SIG0(/1)
  162.         ndefo = DEPST(/1)
  163.         ncara = XMAT(/1)
  164.         ncarb = XCARB(/1)
  165.         ntur = ture0(/1)
  166.         npri = prin0(/1)
  167.         nmah = maho0(/1)
  168.         nhot = hota0(/1)
  169.         nvari = VAR0(/1)
  170.         ngrf = graf0(/1)
  171.         nrhi = rhas0(/1)
  172.         ndein = DEFP(/1)
  173.         nparex=PAREX0(/1)
  174. *
  175.       if (nouvid) then
  176.         nouvid = .false.
  177. * creation d un nomid et du pilnec
  178.         nbrobl=1
  179.         nbrfac = 0
  180.         segini nomid
  181.         lesobl(1) = nomdec
  182.         ijluc=ijluc+1
  183.         if(ijluc.gt.iiluc) then
  184.            iiluc=iiluc+1
  185.             segadj liluc
  186.         endif
  187.         liluc(ijluc,1)=nomid
  188.         mobl = 1
  189.         mfac = 0
  190.         mran = INDESO
  191.         segini pilnec
  192.         liluc(ijluc,2)=pilnec
  193.         pilobl(1,indec) = deche
  194.         nexo = nexo + 1
  195. *
  196.         segadj wrk52,wrk522
  197.         typexo(nexo) = typdec
  198.         conexo(nexo) = condec
  199.         nomexo(nexo) = nomdec
  200.         goto 40
  201.  
  202.       else
  203.         knmid = ijluc
  204.         nomid = liluc(knmid,1)
  205.         nbrobl = lesobl(/2) + 1
  206.         nbrfac = 0
  207.         segadj nomid
  208.         lesobl(nbrobl) = nomdec
  209.         pilnec = liluc(knmid,2)
  210.         mobl = nbrobl
  211.         mfac = 0
  212.         mran = indeso
  213.         segadj pilnec
  214.         pilobl(mobl,indec) = deche
  215.         nexo = nexo + 1
  216.         segadj wrk52,wrk522
  217.         typexo(nexo) = typdec
  218.         conexo(nexo) = condec
  219.         nomexo(nexo) = nomdec
  220.         goto 40
  221.       endif
  222.  
  223.       moterr(1:16) = condec
  224.       moterr(17:24) = nomdec
  225.       interr(1) = 1
  226.       call erreur(943)
  227.       return
  228.  
  229.   40   continue
  230.       enddo
  231.  
  232. * controle
  233.  
  234.       do juc = 13,14
  235.         if ((juc.eq.14.and.imatee.eq.11.and.inatuu.eq.41).or.
  236. * jk148537 : materiau fluendo3D inextricable 
  237.      & (juc.eq.13.and.imatee.eq.1.and.inatuu.eq.187)) goto 50
  238.          nomid  = liluc(juc,1)
  239.          if (nomid.gt.0) then
  240.           nobl = lesobl(/2)
  241.           pilnec = liluc(juc,2)
  242.           do jm=1,nobl
  243.            if (pilobl(jm,1).eq.0.and.pilobl(jm,2).eq.0) then
  244.         moterr(1:45) = 'absence donnee materiau / caracteristique '
  245.         call erreur(-385)
  246.         interr(1) = imodel
  247.         moterr(1:16) = conmod
  248.         moterr(17:24) = lesobl(jm)
  249.         call erreur(-386)        
  250.              call erreur(21)
  251.              return
  252.            endif           
  253.           enddo       
  254.          endif
  255.       enddo
  256.  
  257.   50  continue    
  258.  
  259.       if (FORMOD(1)(1:10).EQ.'MECANIQUE ') then
  260.          juc = 12
  261.          nomid  = liluc(juc,1)
  262.          nobl = lesobl(/2)
  263.          pilnec = liluc(juc,2)
  264.          do jm=1,nobl
  265.            if (pilobl(jm,1).eq.0.or.pilobl(jm,2).eq.0) then
  266.         moterr(1:50) = 'absence deformation initiale et/ou finale '
  267.         call erreur(-385)
  268.         interr(1) = imodel
  269.         moterr(1:16) = conmod
  270.         moterr(17:24) = lesobl(jm)
  271.         call erreur(-386)        
  272.              call erreur(21)
  273.              return
  274.            endif           
  275.          enddo       
  276.       endif
  277.  
  278.       if (FORMOD(1)(1:8).EQ.'MELANGE ') then
  279.          juc = 23
  280.          nomid  = liluc(juc,1)
  281.          nobl = lesobl(/2)
  282.          pilnec = liluc(juc,2)
  283.          do jm=1,nobl
  284.           if (cmate.eq.'PARALLEL') then
  285.            if (pilobl(jm,2).eq.0.and.pilobl(jm,3).eq.0) then
  286.         moterr(1:50) = 'absence phase finale melange parallele'
  287.         call erreur(-385)
  288.         interr(1) = imodel
  289.         moterr(1:16) = conmod
  290.         moterr(17:24) = lesobl(jm)
  291.         call erreur(-386)        
  292.              call erreur(21)
  293.              return
  294.            endif
  295.           else
  296.             if (pilobl(jm,1).eq.0) then
  297.         moterr(1:50) = 'absence phase initiale melange'
  298.         call erreur(-385)
  299.         interr(1) = imodel
  300.         moterr(1:16) = conmod
  301.         moterr(17:24) = lesobl(jm)
  302.         call erreur(-386)        
  303.             endif 
  304.           endif 
  305.          enddo             
  306.       endif
  307.  
  308.       if (cmate(1:5).eq.'ZTMAX') then
  309.          juc = 15
  310.          nomid  = liluc(juc,1)
  311.          nobl = lesobl(/2)
  312.          pilnec = liluc(juc,2)
  313.          do jm=1,nobl
  314.            if (pilobl(jm,1).eq.0.or.pilobl(jm,2).eq.0) then
  315.         moterr(1:50) = 'absence temperature initiale et/ou finale '
  316.         write(6,*) jm,pilobl(jm,1),pilobl(jm,2)
  317.         call erreur(-385)
  318.         interr(1) = imodel
  319.         moterr(1:16) = conmod
  320.         moterr(17:24) = lesobl(jm)
  321.         call erreur(-386)        
  322.              call erreur(21)
  323.              return
  324.            endif           
  325.          enddo       
  326.  
  327.       endif
  328.  
  329. *
  330.       IF (INPLAS.EQ.-1) THEN
  331.         NSIGM0 = SIG0(/1)
  332.         NEPST0 = EPST0(/1)
  333.         IF (NSIGM0.GT.0.AND.NEPST0.GT.0.AND.NSIGM0.NE.NEPST0) THEN
  334.           CALL ERREUR(963)
  335.           RETURN
  336.         ENDIF
  337.       ENDIF
  338. *-------------------------------------------------
  339. c
  340.       ipil = liluc
  341.       iwrk52 = wrk52
  342. c
  343.       RETURN
  344.       END
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  

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