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    JK148537  24/10/29    21:15:03     12056          
  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.  
  19. -INC SMCHAML
  20. -INC SMMODEL
  21.       POINTEUR IMOSTA.IMODEL
  22. -INC SMINTE
  23. -INC SMLENTI
  24. * segment deroulant le mcheml
  25. -INC DECHE
  26.  
  27. c*of
  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.  
  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.  
  64. c      call  gibtem (xkt)
  65. c      write(ioimp,*) ' entree coml2 '
  66.  
  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. c*      infche(1,6) = 1
  126.       n2 = 1
  127.       SEGINI,mchaml
  128.       ichaml(1) = mchaml
  129.       nomche(1) = ' '
  130.       typche(1) = ' '
  131. c*      ielval(1) = 0
  132.       IPOI1 = mchelm
  133. C
  134. C     ----------------------------------------
  135. C     Boucle (1000) sur les modeles elementaires
  136. C     ----------------------------------------
  137.       DO 1000 isous = 1, NSOUS
  138.  
  139.         imodel = kmodel(isous)
  140.         iqmod = imodel
  141.  
  142.         mmode1 = IPMOD1
  143.         mmode1.kmodel(1) = iqmod
  144. *       write(*,*) 'INPLAS = ',inatuu
  145. *
  146. *       write(ioimp,*) 'coml2 modele elementaire numero ',isous
  147. *       write(6,*) 'coml2 formulation ',formod(1),' cons ',conmod
  148. *       moterr(1:6) = 'COML2  '
  149. *       moterr(7:15) = 'IMODEL  '
  150. *       interr(1) = im
  151. *       call erreur(-329)
  152. C
  153. C       ===============================================================
  154. C       DETERMINATION DE LA FORMULATION DU MODELE
  155. C       ===============================================================
  156.         NFORMU = FORMOD(/2)
  157.         iform1 = 0
  158.         CALL PLACE(LISFOR,MFORMU,iform1,FORMOD(1))
  159.         lformu = iform1
  160.         IF (nformu.EQ.2) THEN
  161.           iform2 = 0
  162.           CALL PLACE(LISFOR,MFORMU,iform2,FORMOD(2))
  163.           lformu = 0
  164.           IF ( (iform1.eq.2 .and. iform2.eq.3) .or.
  165.      &         (iform1.eq.3 .and. iform2.eq.2) )  lformu = 19
  166.         ENDIF
  167.  
  168. C       Normalement coml a fait le tri
  169.         IF (lformu.EQ.0) THEN
  170.           WRITE(IOIMP,*) 'COML2 : FORMULATION NON PREVUE ICI'
  171.           GOTO 1000
  172.         ENDIF
  173.  
  174. C       NE TRAITER QUE LES FORMULATIONS CONCERNEES PAR L'INTEGRATION
  175.         IF ((lformu.NE. 2).AND.(lformu.NE. 3).AND.(lformu.NE. 5).AND.
  176.      &      (lformu.NE.11).AND.(lformu.NE.14).AND.(lformu.NE.17).AND.
  177.      &      (lformu.NE.18).AND.(lformu.NE.19)) GOTO 1000
  178. C
  179. C       ===============================================================
  180. C       DETERMINATION DU SUPPORT DES CHAMPS (PAR DEFAUT A 5)
  181. C       ===============================================================
  182. cof : a stocker dans un segment de travail pour la suite ?
  183.         lesupp = 5
  184.         jtruli = 0
  185. C       Formulation METALLURGIE
  186.         if (lformu.EQ.18) then
  187.           lesupp = 6
  188. C       Formulation MELANGE
  189.         else if (lformu.eq.11) then
  190.           lesupp = 3
  191.           if (ivamod(/1).gt.0) then
  192.             lesupp = 5
  193.           endif
  194. C       Formulation LIAISON
  195.         else if (lformu.EQ.14) then
  196.           lesupp = 1
  197.           jtruli = itruli
  198.         endif
  199. C
  200. C       ===============================================================
  201. C       INFORMATION SUR L'ELEMENT FINI
  202. C       ===============================================================
  203. c*of
  204.         MELE1 = imodel.NEFMOD
  205.         if (infmod(/1).lt.2+lesupp) then
  206. c*of          write(ioimp,*) 'COML2:',imodel,lformu,formod(1),infmod(/1),mele1
  207.           CALL ELQUOI(MELE1,0,lesupp,ipinf,IMODEL)
  208.           IF (IERR.NE.0) RETURN
  209.           info = ipinf
  210.           MFR2 = INFELL(13)
  211. c*of          call erreur(5)
  212.         ELSE
  213.           ipinf = 0
  214.           info = ipinf
  215.           MFR2 = imodel.INFELE(13)
  216.         ENDIF
  217.  
  218. C stationnaire
  219.         imosta = 0
  220.            do im = 1,matmod(/2)
  221.              if (matmod(im).eq.'STATIONNAIRE') then
  222.                do jn = ivamod(/1),1
  223. * jk148537 plutôt dernier rangé
  224.                  if (tymode(jn).eq.'IMODEL') then
  225.                    imosta = ivamod(jn)
  226.                    goto 150
  227.                  endif
  228.                enddo
  229.              endif
  230.            enddo
  231.   150   CONTINUE    
  232.  
  233. C       ===============================================================
  234. C       CHAMPS QUI CONCERNENT LE MODELE ELEMENTAIRE
  235. C       ===============================================================
  236. C       REDUAF a mis en correspondance les maillages supports des
  237. C       modeles elementaires et ceux du mchaml. Il suffit de tester
  238. C       l'egalite des pointeurs .
  239.         iinomp=iimel
  240.         ijnomp=0
  241.         segini linomp
  242.         DO 90 ICHMP = 1, IIMEL
  243.           DECHE = LILMEL(ICHMP)
  244.           IF (IMAMOD.EQ.IMADEC) THEN
  245. *jk148537 : très laxiste, ça laisse tout le travail a faire ...
  246.             ijnomp = ijnomp + 1
  247.             linomp(ijnomp) = DECHE
  248.           ENDIF
  249.  
  250.           if (imosta.gt.0) then
  251.         if (cmatee.eq.'ZTMAX'.and.nomdec.eq.'T'.and.
  252.      &imosta.imamod.eq.imadec.and.indec.eq.2) then
  253.         endif
  254.  
  255.            if ((imosta.imamod.eq.imadec.and.indec.eq.3.and.
  256.      &imosta.conmod.eq.condec).OR.(nomdec(1:1).eq.'T'.and.
  257.      &imosta.imamod.eq.imadec.and.indec.eq.2))          then
  258. * on initialise avec les resultats / l etat 2
  259.             segini,dec1=deche
  260.             dec1.condec = conmod
  261.             dec1.indec = 1 
  262.             dec1.imadec = imamod
  263.             ijnomp = ijnomp + 1
  264.             linomp(ijnomp) = dec1
  265.            endif
  266.           endif
  267.   90    CONTINUE
  268.         IF (IJNOMP.NE.IINOMP) THEN
  269.           IINOMP=IJNOMP
  270.           SEGADJ LINOMP
  271.         ENDIF
  272. C
  273. C       Segment pour changer les supports d integration
  274.         iichan=iinomp
  275.         ijchan=0
  276.         segini lichan
  277. C
  278. C       Segment contenant les deche sur les bons supports
  279.         iilcon=iinomp
  280.         ijlcon=0
  281.         segini lilcon
  282.         ipcon = lilcon
  283. c
  284. c pour gagner du temps
  285. c --- on vise les etudes d ingenierie donc la selection est faite sur
  286. c la formulation ---  on ne passe dans coml6 que les deche qui correspondent
  287. c au support. ce n est pas bien parce que la philosophie de COMP
  288. c est justement de faire descendre le maximum d info. o tristesse.kich (05/01)
  289. c
  290.         if (((mfr2.ge.11.or.mfr2.eq.7).and.mfr2.ne.33) .or.
  291.      &      lformu.eq.14) then
  292.           do ldn=1,iinomp
  293.             lilcon(ldn) = linomp(ldn)
  294.           enddo
  295.           ijlcon=iinomp
  296.           goto 201
  297.         endif
  298. c
  299. c tri sommaire des deche : support geometrique
  300. c
  301.        if(lformu.eq.11.and.cmatee.eq.'PARALLEL') then
  302. *
  303.         if (ivamod(/1).le.0) then
  304.           call erreur(21)
  305.           return
  306.         endif
  307. c
  308. c rassemble les deche lies aux phases
  309.         do 910 ide = 1,lilmel(/1)
  310.          deche = lilmel(ide)
  311.          if (.false.) then
  312.          if (indec.eq.indeso.and.imadec.eq.imamod) then
  313.           if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  314.                  ijlcon = ijlcon + 1
  315.                  lilcon(ijlcon) = deche
  316.           else
  317.            do im = 1,ivamod(/1)
  318.              if (tymode(im).eq.'IMODEL  ') then
  319.                imode1 = ivamod(im)
  320.                if ((condec(1:LCONMO).eq.imode1.conmod(1:LCONMO)).or.
  321.      &(nomdec(1:4).eq.imode1.conmod(17:20))) then
  322.                  ijlcon = ijlcon + 1
  323.                  lilcon(ijlcon) = deche
  324.                endif
  325.              endif
  326.            enddo
  327.           endif
  328.          elseif (indec.eq.2.and.imadec.eq.imamod.and.
  329.      &           condec(1:LCONMO).ne.conmod(1:LCONMO)) then
  330.            do im = 1,ivamod(/1)
  331.              if (tymode(im).eq.'IMODEL  ') then
  332.                imode1 = ivamod(im)
  333.                if ((condec(1:LCONMO).eq.imode1.conmod(1:LCONMO)).or.
  334.      &(nomdec(1:4).eq.imode1.conmod(17:20))) then
  335.                  ijlcon = ijlcon + 1
  336.                  lilcon(ijlcon) = deche
  337.                endif
  338.              endif
  339.            enddo
  340.          endif
  341.          endif
  342.          if (indec.ge.2.and.imadec.eq.imamod) then
  343.                  ijlcon = ijlcon + 1
  344.                  lilcon(ijlcon) = deche
  345.          endif
  346.  910    continue
  347.         iilcon = ijlcon
  348.         segadj lilcon
  349.         iilcon0 = iilcon
  350.  
  351.        else
  352. c cas general
  353. C       write(6,*) ' passage a la cloche mfr2 ', mfr2,lilmel(/1)
  354.         do 200 iol=1,iinomp
  355.           deche = linomp(iol)
  356. *
  357. * on change eventuellement sur les points d integration
  358. * convenables ... ce qui suppose en fait que l information
  359. * fournie a COMP n est pas redondante
  360. * en mecanique on utilise directement les champs fournis aux pgauss rigidite
  361.           lome1 = infdec(6).eq.3.and.lesupp.eq.5
  362.           lome2 = nomdec(1:4).eq.'TEMP'.or.
  363.      &            nomdec(1:4).eq.'LX  '.or.
  364.      &            nomdec(1:4).eq.'FLX '
  365.           if (infdec(6).ne.lesupp.and..not.lome1.and..not.lome2) then
  366. c             write(6,*) 'change ', deche, nomdec
  367.             iem = indec
  368. * cree un mchaml
  369.             mchelm = IPOI1
  370.             ifoche=ifodec
  371.             conche(1) = condec
  372.             imache(1) = imadec
  373.             do j = 1,infdec(/1)
  374.               infche(1,j) = infdec(j)
  375.             enddo
  376.             mchaml = ichaml(1)
  377.             nomche(1) = nomdec
  378.             typche(1) = typdec
  379.             ielval(1) =ABS(ieldec)
  380. *           write(6,*) ' changement de support  nomdec ',nomdec
  381.             call CHASUP(IPMOD1,IPOI1,IPOI2,IRET,lesupp)
  382.             if (IRET.NE.0) then
  383.               CALL ERREUR(IRET)
  384.               return
  385.             endif
  386.             if (ierr.ne.0) return
  387.             mchelm = ipoi2
  388.             n1 = ichaml(/1)
  389.             if (n1.ne.1) then
  390. * bizarre , contacter support
  391.               moterr(17:24) = 'COML2'
  392.               interr(1) = 1
  393.               call erreur(943)
  394.               return
  395.             endif
  396.             mchaml = ichaml(1)
  397.             n2 = ielval(/1)
  398.             if (n2.ne.1) then
  399. * bizarre , contacter support
  400.               moterr(17:24) = 'COML2'
  401.               interr(1) = 2
  402.               call erreur(943)
  403.               return
  404.             endif
  405. * creer un deche
  406.             n3 = infche(/2)
  407.             segini deche
  408.             indec = iem
  409.             ieldec = ielval(1)
  410.             typdec = typche(1)
  411.             typree = typdec(1:6).eq.'REAL*8'
  412.             nomdec = nomche(1)
  413.             imadec = imache(1)
  414.             condec = conche(1)
  415.             ifodec = ifoche
  416.             do in3 = 1, n3
  417.               infdec(in3) = infche(1,in3)
  418.             enddo
  419.             segsup mchaml,mchelm
  420. * mettre dans une pile
  421.             ijchan=ijchan+1
  422.             if(ijchan.gt.iichan) then
  423.               iichan=iichan+100
  424.               segadj lichan
  425.             endif
  426.             lichan(ijchan) = deche
  427.           endif
  428. C
  429. C         write(6,*) 'lilcon ',deche,nomdec,typdec,condec,imadec,indec
  430.           ijlcon=ijlcon+1
  431.           if(ijlcon.gt.iilcon) then
  432.             iilcon=iilcon+100
  433.             segadj lilcon
  434.           endif
  435.           lilcon(ijlcon) = deche
  436.   200   CONTINUE
  437.        endif
  438. C
  439.   201   CONTINUE
  440. C
  441.         imodel = iqmod
  442.         if (ijchan.ne.iichan) then
  443.           iichan = ijchan
  444.           segadj lichan
  445.         endif
  446. C
  447.         if (ijlcon.ne.iilcon) then
  448.           iilcon=ijlcon
  449.           segadj lilcon
  450.         endif
  451. C
  452. C       ===============================================================
  453. C       INTEGRATION DE LA LOI DE COMPORTEMENT
  454. C       ===============================================================
  455.         if (lilcon(/1).ge.1) then
  456. *         call gibtem(xkt)
  457. *         write(6,*) ' coml2 : appel a coml6 ', xkt
  458. *         do ioup=1,lilcon(/1)
  459. *           deche=lilcon(ioup)
  460. *           write(6,*)deche,' ',nomdec,' ',imadec,' ',indec,' ',condec
  461. *         enddo
  462. *         WRITE(*,*) 'APPEL A COML6 ',conmod,cmatee,inatuu
  463.        call coml6(iqmod,ipmel,ipcon,ipinf,indeso,lesupp,jtruli,lformu,
  464.      &IRETOU)
  465.  
  466. *         call gibtem(xkt)
  467. *         write(6,*) ' coml2 : retour de coml6 ',xkt
  468.         else
  469. c         write(6,*) 'pas de composante pour le sous-model ',imodel
  470.         endif
  471. *       write(6,*) 'coml2 : ierr ', ierr , 'iretou ', iretou
  472.         if (ierr.gt.1) return
  473. C
  474. C       ===============================================================
  475. * complete la pile des deche en sortie / desactive les DECHE et les MELVAL
  476.         lilcon = ipcon
  477.         ijmel=lilmel(/1)
  478.         do 800 ioc =iilcon+1,lilcon(/1)
  479.           deche = lilcon(ioc)
  480.           if (indec.lt.indeso) then
  481.           else if (indec.eq.indeso.and.
  482.      &            condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  483. * si on a ete coherent on ne peut creer 2 fois le meme deche
  484. * on ne rajoute que les deche crees sur le constituant
  485. * on ne met pas dans lilmel les deches intermediaires
  486.             if (ijchan.gt.0) then
  487.               do iyf = 1,ijchan
  488.                 if (lichan(iyf).eq.deche) goto 800
  489.               enddo
  490.             endif
  491.             ijmel=ijmel+1
  492.             if(ijmel.gt.iimel) then
  493.               iimel=iimel+100
  494.               segadj lilmel
  495.             endif
  496.             lilmel(ijmel) = deche
  497.           else
  498.           endif
  499.   800   continue
  500.         iimel=ijmel
  501.         segadj lilmel
  502.         segsup lilcon,linomp
  503.  
  504. * supprime melval intermediaire
  505.         if (ijchan.gt.0) then
  506.         do iop = 1,ijchan
  507.           deche = lichan(iop)
  508. c         write(6,*) 'deche ', nomdec , indec, ieldec
  509.           do il = 1,lilmel(/1)
  510.             dec1 = lilmel(il)
  511. c           write(6,*) 'de1 ', dec1.nomdec , dec1.indec, dec1.ieldec
  512.             if (dec1.indec.eq.indeso.and.dec1.ieldec.eq.ieldec) goto 810
  513.           enddo
  514.           melval =ABS(ieldec)
  515. c         write(6,*) 'supprime deche ',nomdec,melval,deche
  516.           segsup melval
  517.  810      continue
  518.           segsup deche
  519.         enddo
  520.         endif
  521.         segsup lichan
  522.  
  523.         if (ierr.ne.0) return
  524.         if (iretou.ne.0) return
  525.  
  526. c*of
  527.         if (ipinf.ne.0) then
  528.           info = ipinf
  529.           segsup info
  530.         endif
  531.  
  532.  1000 CONTINUE
  533. C     ----------------------------------------------
  534. C     Fin de boucle (1000) sur les modeles elementaires
  535. C     ----------------------------------------------
  536. C
  537. C     Destruction du segment struli (si utilise)
  538.       if (itruli.ne.0) then
  539.         if (momoda.gt.0) then
  540.           mmode2 = momoda
  541.           segsup mmode2
  542.         endif
  543.         if (mostat.gt.0) then
  544.           mmode2 = mostat
  545.           segsup mmode2
  546.         endif
  547.         if (itbmod.gt.0) then
  548.           mmode2 = itbmod
  549.           segsup mmode2
  550.         endif
  551.         if (itlia.gt.0) then
  552.           mmode2 = itlia
  553.           segsup mmode2
  554.         endif
  555.         if (ichain.gt.0) then
  556.           mlent3 = ichain
  557.           segsup mlent3
  558.         endif
  559.         segsup struli
  560.       endif
  561.  
  562. C     Destruction autres segments
  563.       mmode1 = IPMOD1
  564.       segsup mmode1
  565.       mchelm = IPOI1
  566.       mchaml = ichaml(1)
  567.       segsup,mchaml,mchelm
  568.  
  569. c      write(ioimp,*) ' sortie coml2 ' , xkt
  570. c      return
  571.       END
  572.  
  573.  
  574.  
  575.  

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