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

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