Télécharger la plaquette Cast3M


fr en

Télécharger coml2.eso

Retour à la liste

Numérotation des lignes : 

coml2

  1. C COML2     SOURCE    PV090527  25/01/07    14:42:28     12115          
  2.  
  3.        SUBROUTINE COML2(IPMODL,IPMEL,INDESO,IRETOU)
  4.  
  5. *---------------------------------------------------------------------
  6. * coml2 : trie et boucle sur les modeles elementaires
  7. *         selectionne les composantes de meme support
  8. *         passe a coml6
  9. *         complete les deche resultats
  10. *----------------------------------------------------------------
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC CCGEOME
  17. -INC CCHAMP
  18. -INC SMCOORD
  19.  
  20. -INC SMCHAML
  21. -INC SMMODEL
  22.       POINTEUR IMOSTA.IMODEL
  23. -INC SMINTE
  24. -INC SMLENTI
  25. * segment deroulant le mcheml
  26. -INC DECHE
  27.  
  28. c*of
  29.       SEGMENT INFO
  30.         INTEGER INFELL(16)
  31.       ENDSEGMENT
  32. ** pile des deche contruits pour changer de support
  33.       segment lichan(iichan)
  34. ** pile des deche pour construire le champ de caracteristiques geometriques
  35.       segment licarb(iicarb)
  36. ** pile des noms de composantes a proteger
  37.       segment linomp(iinomp)
  38. ** pile modeles elementaires
  39.       segment limode(NSM)
  40. ** segment sous-structures dynamiques
  41.       segment struli
  42.         integer itlia,itbmod,momoda, mostat,itmail,molia
  43.         integer ldefo(np1),lcgra(np1),lsstru(np1)
  44.         integer nsstru,nndefo,nliab,nsb,na2,idimb
  45.         integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas
  46.         INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib
  47. * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0)
  48.         INTEGER ICHAIN
  49.       endsegment
  50.  
  51.       LOGICAL LOME1,LOME2
  52.  
  53. *     Liste des formulations
  54.       PARAMETER (MFORMU=19)
  55.       CHARACTER*16 LISFOR(MFORMU)
  56.       DATA LISFOR /
  57.      &       'THERMIQUE       ','MECANIQUE       ','LIQUIDE         ',
  58.      &       'CONVECTION      ','POREUX          ','DARCY           ',
  59.      &       'FROTTEMENT      ','RAYONNEMENT     ','MAGNETODYNAMIQUE',
  60.      &       'NAVIER_STOKES   ','MELANGE         ','EULER           ',
  61.      &       'FISSURE         ','LIAISON         ','THERMOHYDRIQUE  ',
  62.      &       'ELECTROSTATIQUE ','DIFFUSION       ','METALLURGIE     ',
  63.      &       'MECANIQUE+LIQUID'/
  64.  
  65. c      call  gibtem (xkt)
  66. c      write(ioimp,*) ' entree coml2 '
  67.  
  68.       MMODEL = IPMODL
  69.       NSOUS = KMODEL(/1)
  70.       NSM = NSOUS
  71.       SEGINI,LIMODE
  72. C     -----------------------------------------------------------------
  73. C     Traitement particulier pour la formulation LIAISON
  74. C     -----------------------------------------------------------------
  75.       itruli = 0
  76.       struli = 0
  77.       iplia  = 0
  78. *     Test sur la presence de la formulation LIAISON
  79.       N1 = 0
  80.       DO im = 1, NSOUS
  81.         imodel = kmodel(im)
  82.         if (formod(1)(1:8).EQ.'LIAISON ') then
  83.           N1 = N1 + 1
  84.           limode(N1) = imodel
  85.         ENDIF
  86.       ENDDO
  87. *     Definition du modele (iplia) associe a la seule formulation LIAISON
  88.       if (N1.ne.0) then
  89.         segini,mmode1
  90.         DO im = 1, N1
  91.           mmode1.kmodel(im) = limode(im)
  92.         ENDDO
  93.         iplia = mmode1
  94. *       Initialisation du segment struli
  95.         np1 = 0
  96.         segini struli
  97.         itruli = struli
  98.         itlia = iplia
  99. *       Remplissage avec les donnees dependant des sous-modeles MODAL / STATIQUE
  100.         call comalo(ipmodl,itruli,ipmel)
  101.       ENDIF
  102. C     -----------------------------------------------------------------
  103.       SEGSUP,LIMODE
  104.  
  105.       lilmel = ipmel
  106.       iimel  = lilmel(/1)
  107. c
  108. C     En cas de changement de support, appel a chasup qui travaille sur
  109. C     un mmodel et un mchelm. ces structures sont creees ici puis
  110. C     completees si besoin dans la boucle 1000
  111.       N1 = 1
  112.       SEGINI,mmode1
  113.       IPMOD1 = mmode1
  114. C
  115.       N1 = 1
  116.       L1 = 1
  117.       N3 = 6
  118.       SEGINI,mchelm
  119.       titche = ' '
  120.       conche(1) = '        '
  121. c*      ifoche = 0
  122. c*      imache(1) = 0
  123. c*      DO i = 1, N3
  124. c*        infche(1,i) = 0
  125. c*      ENDDO
  126. c*      infche(1,6) = 1
  127.       n2 = 1
  128.       SEGINI,mchaml
  129.       ichaml(1) = mchaml
  130.       nomche(1) = ' '
  131.       typche(1) = ' '
  132. c*      ielval(1) = 0
  133.       IPOI1 = mchelm
  134. C
  135. C     ----------------------------------------
  136. C     Boucle (1000) sur les modeles elementaires
  137. C     ----------------------------------------
  138.       DO 1000 isous = 1, NSOUS
  139.  
  140.         imodel = kmodel(isous)
  141.         iqmod = imodel
  142.  
  143.         mmode1 = IPMOD1
  144.         mmode1.kmodel(1) = iqmod
  145. *       write(*,*) 'INPLAS = ',inatuu
  146. *
  147. *       write(ioimp,*) 'coml2 modele elementaire numero ',isous
  148. *       write(6,*) 'coml2 formulation ',formod(1),' cons ',conmod
  149. *       moterr(1:6) = 'COML2  '
  150. *       moterr(7:15) = 'IMODEL  '
  151. *       interr(1) = im
  152. *       call erreur(-329)
  153. C
  154. C       ===============================================================
  155. C       DETERMINATION DE LA FORMULATION DU MODELE
  156. C       ===============================================================
  157.         NFORMU = FORMOD(/2)
  158.         iform1 = 0
  159.         CALL PLACE(LISFOR,MFORMU,iform1,FORMOD(1))
  160.         lformu = iform1
  161.         IF (nformu.EQ.2) THEN
  162.           iform2 = 0
  163.           CALL PLACE(LISFOR,MFORMU,iform2,FORMOD(2))
  164.           lformu = 0
  165.           IF ( (iform1.eq.2 .and. iform2.eq.3) .or.
  166.      &         (iform1.eq.3 .and. iform2.eq.2) )  lformu = 19
  167.         ENDIF
  168.  
  169. C       Normalement coml a fait le tri
  170.         IF (lformu.EQ.0) THEN
  171.           WRITE(IOIMP,*) 'COML2 : FORMULATION NON PREVUE ICI'
  172.           GOTO 1000
  173.         ENDIF
  174.  
  175. C       NE TRAITER QUE LES FORMULATIONS CONCERNEES PAR L'INTEGRATION
  176.         IF ((lformu.NE. 2).AND.(lformu.NE. 3).AND.(lformu.NE. 5).AND.
  177.      &      (lformu.NE.11).AND.(lformu.NE.14).AND.(lformu.NE.17).AND.
  178.      &      (lformu.NE.18).AND.(lformu.NE.19)) GOTO 1000
  179. C
  180. C       ===============================================================
  181. C       DETERMINATION DU SUPPORT DES CHAMPS (PAR DEFAUT A 5)
  182. C       ===============================================================
  183. cof : a stocker dans un segment de travail pour la suite ?
  184.         lesupp = 5
  185.         jtruli = 0
  186. C       Formulation METALLURGIE
  187.         if (lformu.EQ.18) then
  188.           lesupp = 6
  189. C       Formulation MELANGE
  190.         else if (lformu.eq.11) then
  191.           lesupp = 3
  192.           if (ivamod(/1).gt.0) then
  193.             lesupp = 5
  194.           endif
  195. C       Formulation LIAISON
  196.         else if (lformu.EQ.14) then
  197.           lesupp = 1
  198.           jtruli = itruli
  199.         endif
  200. C
  201. C       ===============================================================
  202. C       INFORMATION SUR L'ELEMENT FINI
  203. C       ===============================================================
  204. c*of
  205.         MELE1 = imodel.NEFMOD
  206.         if (infmod(/1).lt.2+lesupp) then
  207. c*of          write(ioimp,*) 'COML2:',imodel,lformu,formod(1),infmod(/1),mele1
  208.           CALL ELQUOI(MELE1,0,lesupp,ipinf,IMODEL)
  209.           IF (IERR.NE.0) RETURN
  210.           info = ipinf
  211.           MFR2 = INFELL(13)
  212. c*of          call erreur(5)
  213.         ELSE
  214.           ipinf = 0
  215.           info = ipinf
  216.           MFR2 = imodel.INFELE(13)
  217.         ENDIF
  218.  
  219. C stationnaire
  220.         imosta = 0
  221.            do im = 1,matmod(/2)
  222.              if (matmod(im).eq.'STATIONNAIRE') then
  223.                do jn = ivamod(/1),1
  224. * jk148537 plutôt dernier rangé
  225.                  if (tymode(jn).eq.'IMODEL') then
  226.                    imosta = ivamod(jn)
  227.                    goto 150
  228.                  endif
  229.                enddo
  230.              endif
  231.            enddo
  232.   150   CONTINUE    
  233.  
  234. C       ===============================================================
  235. C       CHAMPS QUI CONCERNENT LE MODELE ELEMENTAIRE
  236. C       ===============================================================
  237. C       REDUAF a mis en correspondance les maillages supports des
  238. C       modeles elementaires et ceux du mchaml. Il suffit de tester
  239. C       l'egalite des pointeurs .
  240.         iinomp=iimel
  241.         ijnomp=0
  242.         segini linomp
  243.         DO 90 ICHMP = 1, IIMEL
  244.           DECHE = LILMEL(ICHMP)
  245.           IF (IMAMOD.EQ.IMADEC) THEN
  246. *jk148537 : très laxiste, ça laisse tout le travail a faire ...
  247.             ijnomp = ijnomp + 1
  248.             linomp(ijnomp) = DECHE
  249.           ENDIF
  250.  
  251.           if (imosta.gt.0) then
  252.         if (cmatee.eq.'ZTMAX'.and.nomdec.eq.'T'.and.
  253.      &imosta.imamod.eq.imadec.and.indec.eq.2) then
  254.         endif
  255.  
  256.            if ((imosta.imamod.eq.imadec.and.indec.eq.3.and.
  257.      &imosta.conmod.eq.condec).OR.(nomdec(1:1).eq.'T'.and.
  258.      &imosta.imamod.eq.imadec.and.indec.eq.2))          then
  259. * on initialise avec les resultats / l etat 2
  260.             segini,dec1=deche
  261.             dec1.condec = conmod
  262.             dec1.indec = 1 
  263.             dec1.imadec = imamod
  264.             ijnomp = ijnomp + 1
  265.             linomp(ijnomp) = dec1
  266.            endif
  267.           endif
  268.   90    CONTINUE
  269.         IF (IJNOMP.NE.IINOMP) THEN
  270.           IINOMP=IJNOMP
  271.           SEGADJ LINOMP
  272.         ENDIF
  273. C
  274. C       Segment pour changer les supports d integration
  275.         iichan=iinomp
  276.         ijchan=0
  277.         segini lichan
  278. C
  279. C       Segment contenant les deche sur les bons supports
  280.         iilcon=iinomp
  281.         ijlcon=0
  282.         segini lilcon
  283.         ipcon = lilcon
  284. c
  285. c pour gagner du temps
  286. c --- on vise les etudes d ingenierie donc la selection est faite sur
  287. c la formulation ---  on ne passe dans coml6 que les deche qui correspondent
  288. c au support. ce n est pas bien parce que la philosophie de COMP
  289. c est justement de faire descendre le maximum d info. o tristesse.kich (05/01)
  290. c
  291.         if (((mfr2.ge.11.or.mfr2.eq.7).and.mfr2.ne.33) .or.
  292.      &      lformu.eq.14) then
  293.           do ldn=1,iinomp
  294.             lilcon(ldn) = linomp(ldn)
  295.           enddo
  296.           ijlcon=iinomp
  297.           goto 201
  298.         endif
  299. c
  300. c tri sommaire des deche : support geometrique
  301. c
  302.        if(lformu.eq.11.and.cmatee.eq.'PARALLEL') then
  303. *
  304.         if (ivamod(/1).le.0) then
  305.           call erreur(21)
  306.           return
  307.         endif
  308. c
  309. c rassemble les deche lies aux phases
  310.         do 910 ide = 1,lilmel(/1)
  311.          deche = lilmel(ide)
  312.          if (.false.) then
  313.          if (indec.eq.indeso.and.imadec.eq.imamod) then
  314.           if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  315.                  ijlcon = ijlcon + 1
  316.                  lilcon(ijlcon) = deche
  317.           else
  318.            do im = 1,ivamod(/1)
  319.              if (tymode(im).eq.'IMODEL  ') then
  320.                imode1 = ivamod(im)
  321.                if ((condec(1:LCONMO).eq.imode1.conmod(1:LCONMO)).or.
  322.      &(nomdec(1:4).eq.imode1.conmod(17:20))) then
  323.                  ijlcon = ijlcon + 1
  324.                  lilcon(ijlcon) = deche
  325.                endif
  326.              endif
  327.            enddo
  328.           endif
  329.          elseif (indec.eq.2.and.imadec.eq.imamod.and.
  330.      &           condec(1:LCONMO).ne.conmod(1:LCONMO)) then
  331.            do im = 1,ivamod(/1)
  332.              if (tymode(im).eq.'IMODEL  ') then
  333.                imode1 = ivamod(im)
  334.                if ((condec(1:LCONMO).eq.imode1.conmod(1:LCONMO)).or.
  335.      &(nomdec(1:4).eq.imode1.conmod(17:20))) then
  336.                  ijlcon = ijlcon + 1
  337.                  lilcon(ijlcon) = deche
  338.                endif
  339.              endif
  340.            enddo
  341.          endif
  342.          endif
  343.          if (indec.ge.2.and.imadec.eq.imamod) then
  344.                  ijlcon = ijlcon + 1
  345.                  lilcon(ijlcon) = deche
  346.          endif
  347.  910    continue
  348.         iilcon = ijlcon
  349.         segadj lilcon
  350.         iilcon0 = iilcon
  351.  
  352.        else
  353. c cas general
  354. C       write(6,*) ' passage a la cloche mfr2 ', mfr2,lilmel(/1)
  355.         do 200 iol=1,iinomp
  356.           deche = linomp(iol)
  357. *
  358. * on change eventuellement sur les points d integration
  359. * convenables ... ce qui suppose en fait que l information
  360. * fournie a COMP n est pas redondante
  361. * en mecanique on utilise directement les champs fournis aux pgauss rigidite
  362.           lome1 = infdec(6).eq.3.and.lesupp.eq.5
  363.           lome2 = nomdec(1:4).eq.'TEMP'.or.
  364.      &            nomdec(1:4).eq.'LX  '.or.
  365.      &            nomdec(1:4).eq.'FLX '
  366.           if (infdec(6).ne.lesupp.and..not.lome1.and..not.lome2) then
  367. c             write(6,*) 'change ', deche, nomdec
  368.             iem = indec
  369. * cree un mchaml
  370.             mchelm = IPOI1
  371.             ifoche=ifodec
  372.             conche(1) = condec
  373.             imache(1) = imadec
  374.             do j = 1,infdec(/1)
  375.               infche(1,j) = infdec(j)
  376.             enddo
  377.             mchaml = ichaml(1)
  378.             nomche(1) = nomdec
  379.             typche(1) = typdec
  380.             ielval(1) =ABS(ieldec)
  381. *           write(6,*) ' changement de support  nomdec ',nomdec
  382.             call CHASUP(IPMOD1,IPOI1,IPOI2,IRET,lesupp)
  383.             if (IRET.NE.0) then
  384.               CALL ERREUR(IRET)
  385.               return
  386.             endif
  387.             if (ierr.ne.0) return
  388.             mchelm = ipoi2
  389.             n1 = ichaml(/1)
  390.             if (n1.ne.1) then
  391. * bizarre , contacter support
  392.               moterr(17:24) = 'COML2'
  393.               interr(1) = 1
  394.               call erreur(943)
  395.               return
  396.             endif
  397.             mchaml = ichaml(1)
  398.             n2 = ielval(/1)
  399.             if (n2.ne.1) then
  400. * bizarre , contacter support
  401.               moterr(17:24) = 'COML2'
  402.               interr(1) = 2
  403.               call erreur(943)
  404.               return
  405.             endif
  406. * creer un deche
  407.             n3 = infche(/2)
  408.             segini deche
  409.             indec = iem
  410.             ieldec = ielval(1)
  411.             typdec = typche(1)
  412.             typree = typdec(1:6).eq.'REAL*8'
  413.             nomdec = nomche(1)
  414.             imadec = imache(1)
  415.             condec = conche(1)
  416.             ifodec = ifoche
  417.             do in3 = 1, n3
  418.               infdec(in3) = infche(1,in3)
  419.             enddo
  420.             segsup mchaml,mchelm
  421. * mettre dans une pile
  422.             ijchan=ijchan+1
  423.             if(ijchan.gt.iichan) then
  424.               iichan=iichan+100
  425.               segadj lichan
  426.             endif
  427.             lichan(ijchan) = deche
  428.           endif
  429. C
  430. C         write(6,*) 'lilcon ',deche,nomdec,typdec,condec,imadec,indec
  431.           ijlcon=ijlcon+1
  432.           if(ijlcon.gt.iilcon) then
  433.             iilcon=iilcon+100
  434.             segadj lilcon
  435.           endif
  436.           lilcon(ijlcon) = deche
  437.   200   CONTINUE
  438.        endif
  439. C
  440.   201   CONTINUE
  441. C
  442.         imodel = iqmod
  443.         if (ijchan.ne.iichan) then
  444.           iichan = ijchan
  445.           segadj lichan
  446.         endif
  447. C
  448.         if (ijlcon.ne.iilcon) then
  449.           iilcon=ijlcon
  450.           segadj lilcon
  451.         endif
  452. C
  453. C       ===============================================================
  454. C       INTEGRATION DE LA LOI DE COMPORTEMENT
  455. C       ===============================================================
  456.         if (lilcon(/1).ge.1) then
  457. *         call gibtem(xkt)
  458. *         write(6,*) ' coml2 : appel a coml6 ', xkt
  459. *         do ioup=1,lilcon(/1)
  460. *           deche=lilcon(ioup)
  461. *           write(6,*)deche,' ',nomdec,' ',imadec,' ',indec,' ',condec
  462. *         enddo
  463. *         WRITE(*,*) 'APPEL A COML6 ',conmod,cmatee,inatuu
  464.        call coml6(iqmod,ipmel,ipcon,ipinf,indeso,lesupp,jtruli,lformu,
  465.      &IRETOU)
  466.  
  467. *         call gibtem(xkt)
  468. *         write(6,*) ' coml2 : retour de coml6 ',xkt
  469.         else
  470. c         write(6,*) 'pas de composante pour le sous-model ',imodel
  471.         endif
  472. *       write(6,*) 'coml2 : ierr ', ierr , 'iretou ', iretou
  473.         if (ierr.gt.1) return
  474. C
  475. C       ===============================================================
  476. * complete la pile des deche en sortie / desactive les DECHE et les MELVAL
  477.         lilcon = ipcon
  478.         ijmel=lilmel(/1)
  479.         do 800 ioc =iilcon+1,lilcon(/1)
  480.           deche = lilcon(ioc)
  481.           if (indec.lt.indeso) then
  482.           else if (indec.eq.indeso.and.
  483.      &            condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  484. * si on a ete coherent on ne peut creer 2 fois le meme deche
  485. * on ne rajoute que les deche crees sur le constituant
  486. * on ne met pas dans lilmel les deches intermediaires
  487.             if (ijchan.gt.0) then
  488.               do iyf = 1,ijchan
  489.                 if (lichan(iyf).eq.deche) goto 800
  490.               enddo
  491.             endif
  492.             ijmel=ijmel+1
  493.             if(ijmel.gt.iimel) then
  494.               iimel=iimel+100
  495.               segadj lilmel
  496.             endif
  497.             lilmel(ijmel) = deche
  498.           else
  499.           endif
  500.   800   continue
  501.         iimel=ijmel
  502.         segadj lilmel
  503.         segsup lilcon,linomp
  504.  
  505. * supprime melval intermediaire
  506.         if (ijchan.gt.0) then
  507.         do iop = 1,ijchan
  508.           deche = lichan(iop)
  509. c         write(6,*) 'deche ', nomdec , indec, ieldec
  510.           do il = 1,lilmel(/1)
  511.             dec1 = lilmel(il)
  512. c           write(6,*) 'de1 ', dec1.nomdec , dec1.indec, dec1.ieldec
  513.             if (dec1.indec.eq.indeso.and.dec1.ieldec.eq.ieldec) goto 810
  514.           enddo
  515.           melval =ABS(ieldec)
  516. c         write(6,*) 'supprime deche ',nomdec,melval,deche
  517.           segsup melval
  518.  810      continue
  519.           segsup deche
  520.         enddo
  521.         endif
  522.         segsup lichan
  523.  
  524.         if (ierr.ne.0) return
  525.         if (iretou.ne.0) return
  526.  
  527. c*of
  528.         if (ipinf.ne.0) then
  529.           info = ipinf
  530.           segsup info
  531.         endif
  532.  
  533.  1000 CONTINUE
  534. C     ----------------------------------------------
  535. C     Fin de boucle (1000) sur les modeles elementaires
  536. C     ----------------------------------------------
  537. C
  538. C     Destruction du segment struli (si utilise)
  539.       if (itruli.ne.0) then
  540.         if (momoda.gt.0) then
  541.           mmode2 = momoda
  542.           segsup mmode2
  543.         endif
  544.         if (mostat.gt.0) then
  545.           mmode2 = mostat
  546.           segsup mmode2
  547.         endif
  548.         if (itbmod.gt.0) then
  549.           mmode2 = itbmod
  550.           segsup mmode2
  551.         endif
  552.         if (itlia.gt.0) then
  553.           mmode2 = itlia
  554.           segsup mmode2
  555.         endif
  556.         if (ichain.gt.0) then
  557.           mlent3 = ichain
  558.           segsup mlent3
  559.         endif
  560.         segsup struli
  561.       endif
  562.  
  563. C     Destruction autres segments
  564.       mmode1 = IPMOD1
  565.       segsup mmode1
  566.       mchelm = IPOI1
  567.       mchaml = ichaml(1)
  568.       segsup,mchaml,mchelm
  569.  
  570. c      write(ioimp,*) ' sortie coml2 ' , xkt
  571. c      return
  572.       END
  573.  
  574.  
  575.  
  576.  
  577.  

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