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

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