Télécharger la plaquette Cast3M


fr en

Télécharger pimodl.eso

Retour à la liste

Numérotation des lignes : 

pimodl

  1. C PIMODL    SOURCE    JK148537  24/10/29    21:15:08     12056          
  2.  
  3. *=======================================================================
  4. *= SOUS-PROGRAMME PERMETTANT DE DEROULER UN MMODEL                     =
  5. *= (UTILE SURTOUT EN CAS DE MODELE MELANGE)                            =
  6. *=                                                                     =
  7. *= IPMOD0  MMODEL initial complet                                      =
  8. *= IPMOD1  MMODEL "deroule" contenant, de maniere unitaire, les sous-  =
  9. *=         modeles de formulation 'MECANIQUE', 'LIQUIDE' et 'POREUX'   =
  10. *=         vaut 0 en cas d'ERREUR (MMODEL "deroule" vide)              =
  11. *= IPMAI1  MAILLAGE "deroule" contenant, pour chaque sous-modele de    =
  12. *=         IPMOD1, le maillage support (type 28) si le mode de calcul  =
  13. *=         est de type DPGE (2D/1D)                                    =
  14. *=         vaut 0 si non utile/defini                                  =
  15. *= INIVE = 0 sans 'MELANGE'  avec sous-modeles encapsules              =
  16. *=       = 1 avec 'MELANGE' et sous-modeles encapsules sauf 'PARALLELE'=
  17. *=       = 2 avec 'MELANGE' et sous-modeles encapsules si 'PARALLELE'  =
  18. *= Nota : - IPMOD0 / IPMOD1 est ACTIF en entree / sortie.              =
  19. *=        - Tous les sous-modeles de IPMOD1 sont ACTIFs en sortie !    =
  20. *=======================================================================
  21.  
  22.       SUBROUTINE PIMODL (IPMOD0,IPMOD1,IPMAI1,INIVE)
  23.  
  24.       IMPLICIT INTEGER (I-N)
  25.       IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCPRECO
  30.  
  31. -INC SMMODEL
  32. -INC SMELEME
  33.       POINTEUR ipt0.meleme
  34.  
  35.       SEGMENT limodl(0)
  36.  
  37.       CHARACTER*(16) moforg
  38.       LOGICAL lDPGE
  39.  
  40.       IPMOD1 = 0
  41.       IPMAI1 = 0
  42.  
  43.       iimpi0 = IIMPI
  44. c*dbg      iimpi0 = 1972
  45.  
  46.       mmodel = IPMOD0
  47. c*      segact,mmodel*nomod   <- Actif en E/S
  48.  
  49. C PRECOnditionnment "CMODPG" des MODELES mecaniques en mode DPGE (2D/1D)
  50. C ======================================================================
  51. C Recherche si le modele IPMOD0 n'a pas deja ete traite :
  52. C Verification si presence dans le preconditionnement CCPRECO / "CMODPG"
  53.       ith   = oothrd
  54.       ith1  = ith + 1
  55.  
  56.       CALL OOOHO1(mmodel,ihorot)
  57.       ITAILL = NBMODP(ith1)
  58.       DO is = 1, ITAILL
  59.         IF ( PMODPE(is,ith1) .EQ. mmodel .AND.
  60.      &       PMODPH(is,ith1) .EQ. ihorot ) THEN
  61.           mmode1 = PMODPS(is,ith1)
  62.           meleme = PMADPS(is,ith1)
  63.           if (iimpi0.eq.1972) then
  64.             write(ioimp,*) 'Preconditionnement PIMODL trouve',
  65.      &                     mmodel,mmode1,meleme,is
  66.           endif
  67. C       Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1
  68.           IF (is .GT. 1) THEN
  69.             DO js = is, 2, -1
  70.               PMODPE(js,ith1) = PMODPE(js - 1,ith1)
  71.               PMODPH(js,ith1) = PMODPH(js - 1,ith1)
  72.               PMODPS(js,ith1) = PMODPS(js - 1,ith1)
  73.               PMADPS(js,ith1) = PMADPS(js - 1,ith1)
  74.             ENDDO
  75.             PMODPE(1,ith1) = mmodel
  76.             PMODPH(1,ith1) = ihorot
  77.             PMODPS(1,ith1) = mmode1
  78.             PMADPS(1,ith1) = meleme
  79.           ENDIF
  80.           IF (mmode1.NE.0 .AND. mmode1.NE.mmodel)
  81.      &      CALL ACTOBJ('MMODEL  ',mmode1,1)
  82.           IF (meleme.NE.0) CALL ACTOBJ('MAILLAGE',meleme,1)
  83.           IPMOD1 = mmode1
  84.           IPMAI1 = meleme
  85.           if (iimpi0.eq.1972)
  86.      &      write(ioimp,*) 'PIMODL : IPMOD1 avec NSOU1 =',
  87.      &                     mmode1.kmodel(/1)
  88.           GOTO 100
  89.         ENDIF
  90.       ENDDO
  91.  
  92. C On deroule le MODELE des MODELES mecaniques en mode DPGE (2D/1D)
  93. C ======================================================================
  94. * On met dans le segment limodl tous les sous-modeles utiles.
  95.       NSOUS = mmodel.kmodel(/1)
  96.  
  97.       N1   = 0
  98.       N1SM = 0
  99.  
  100.       SEGINI,limodl
  101.  
  102.       DO is = 1, NSOUS
  103.         imodel = mmodel.kmodel(is)
  104. c*        segact imodel
  105.  
  106.         moforg = imodel.FORMOD(1)(1:16)
  107.         IF      (moforg.EQ.'MECANIQUE       ' .OR.
  108.      &           moforg.EQ.'CONTRAINTE      ' .OR.
  109.      &           moforg.EQ.'POREUX          ' .OR.
  110.      &           moforg.EQ.'ELECTROSTATIQUE ' .OR.
  111.      &           moforg.EQ.'DIFFUSION       ' .OR.
  112.      &           moforg.EQ.'LIQUIDE         ' ) THEN
  113.           N1 = N1 + 1
  114.           limodl(**) = imodel
  115.         ELSE IF (moforg.EQ.'NAVIER_STOKES   ') THEN
  116.           IF (imodel.MATMOD(1).EQ.'NLIN') THEN
  117.             N1 = N1 + 1
  118.             limodl(**) = IMODEL
  119.           ENDIF
  120.         ELSE IF (moforg.EQ.'MELANGE         ') THEN
  121.           IF (imodel.MATMOD(1).NE.'SERIE') THEN
  122.             IF (INIVE.ge.1) THEN
  123.               limodl(**) = IMODEL
  124.               N1 = N1 + 1
  125.             ENDIF
  126.             IF (IVAMOD(/1).GE.1) THEN
  127.               DO j = 1,IVAMOD(/1)
  128.                 IF (TYMODE(j).EQ.'IMODEL  ') THEN
  129.                   IMODE1 = IVAMOD(j)
  130.                   SEGACT,IMODE1
  131.                   IF (IMODE1.FORMOD(1)(1:10).EQ.'MECANIQUE ' .OR.
  132.      &              IMODE1.FORMOD(1)(1:10).EQ.'POREUX    ' .OR.
  133.      &              IMODE1.FORMOD(1)(1:10).EQ.'LIQUIDE   ' ) THEN
  134.                     if (CMATEE.NE.'PARALLEL') then
  135.                      limodl(**) = IMODE1
  136.                      N1SM = N1SM + 1
  137.                     else
  138.                       if (inive.ne.2) then
  139.                        limodl(**) = IMODE1
  140.                        N1SM = N1SM + 1
  141.                       endif
  142.                     endif
  143.                   ELSE
  144. C                  SEGDES,IMODE1
  145.                   ENDIF
  146.                 ENDIF
  147.               ENDDO
  148.             ENDIF
  149.           ENDIF
  150. c        ELSE IF (moforg.EQ.'................') THEN
  151.         ENDIF
  152.       ENDDO
  153.  
  154. C- Le modele deroule contenu dans limodl correspond au modele de depart :
  155. C--------------------
  156.       IF (N1.EQ.NSOUS .AND. N1SM.EQ.0) THEN
  157.         mmode1 = mmodel
  158.         if (iimpi0.eq.1972) then
  159.           write(ioimp,*) 'Preconditionnement PIMODL IPMOD0 = IPMOD1'
  160.         endif
  161.  
  162. C- Moedele deroule plus petit et/ou incluant des sous-modeles
  163.       ELSE
  164. C- Test sur le nombre de sous-modeles de limodl qui doit etre non nul !
  165.         NSOUS = limodl(/1)
  166.         IF (NSOUS.LE.0) THEN
  167.           CALL ERREUR(-182)
  168.           GOTO 99
  169.         ENDIF
  170. * Test de non redondance si presence de sous-modeles MELANGE :
  171.         N1 = NSOUS
  172.         IF (N1SM .NE. 0) THEN
  173.           N1 = 1
  174.           DO is = NSOUS, 2, -1
  175.             imode1 = limodl(is)
  176.             DO js = (is-1),1,-1
  177.               imode2 = limodl(js)
  178.               IF (imode1.eq.imode2) THEN
  179.                 limodl(is) = 0
  180.                 GOTO 10
  181.               ELSE IF (imode1.IMAMOD.EQ.imode2.IMAMOD .AND.
  182.      &                 imode1.CONMOD.EQ.imode2.CONMOD) THEN
  183.                 limodl(is) = 0
  184.                 GOTO 10
  185.               ENDIF
  186.             ENDDO
  187.             N1 = N1 + 1
  188.  10         CONTINUE
  189.           ENDDO
  190.         ENDIF
  191. * Creation du MMODEL deroule :
  192.         is = 0
  193.         SEGINI,mmode1
  194.         DO js = 1, NSOUS
  195.           IF (limodl(js).GT.0) THEN
  196.             is = is + 1
  197.             mmode1.kmodel(is) = limodl(js)
  198.           ENDIF
  199.         ENDDO
  200.         SEGACT,mmode1*NOMOD
  201.         if (is.ne.N1) then
  202.           write(ioimp,*) 'PIMODL : N1 != is !',is,N1
  203.         endif
  204.       ENDIF
  205.  
  206.       NSOU1 = mmode1.kmodel(/1)
  207.       if (iimpi0.eq.1972)
  208.      &   write(ioimp,*) 'PIMODL : IPMOD1 avec NSOU1 =',NSOU1
  209.       IF (NSOU1.LE.0) THEN
  210.         write(ioimp,*) 'PIMODL : IPMOD1 vide - NSOU1 = 0'
  211.         CALL ERREUR(-182)
  212.         GOTO 99
  213.       ENDIF
  214.  
  215.       ipt1 = 0
  216.  
  217. C- Test si le mode de calcul courant est "DPGE"
  218.       mfr = 1
  219.       CALL INFDPG(mfr,IFOUR,lDPGE,ndpge)
  220.       IF (lDPGE) THEN
  221.         NBNN   = 0
  222.         NBELEM = 0
  223.         NBREF  = 0
  224.         NBSOUS = 0
  225.         SEGINI,ipt0
  226.         SEGACT,ipt0*NOMOD
  227.  
  228.         NBSOUS = NSOU1
  229.         SEGINI,ipt1
  230.  
  231.         N1 = 0
  232.         DO is = 1, NSOU1
  233.           imodel = mmode1.kmodel(is)
  234.           mfr  = imodel.INFELE(13)
  235.           CALL INFDPG(mfr,IFOUR,lDPGE,ndpge)
  236.           IF (lDPGE) THEN
  237.             IIPDPG = imodel.IPDPGE
  238.             IIPDPG = IPTPOI(IIPDPG)
  239.             IF (IIPDPG.LE.0) THEN
  240.               CALL ERREUR(925)
  241.               CALL ERREUR(5)
  242.               GOTO 99
  243.             ENDIF
  244.             ipt3 = imodel.imamod
  245.             NBNN3  = ipt3.NUM(/1)
  246.             NBNN   = NBNN3+1
  247.             NBELEM = ipt3.NUM(/2)
  248.             NBREF  = 0
  249.             NBSOUS = 0
  250.             SEGINI,meleme
  251.             meleme.ITYPEL=28
  252.             DO i = 1, NBELEM
  253.               DO j = 1, NBNN3
  254.                 meleme.NUM(j,i) = ipt3.NUM(j,i)
  255.               ENDDO
  256.               meleme.NUM(NBNN,i) = IIPDPG
  257.               meleme.ICOLOR(i) = ipt3.ICOLOR(i)
  258.             ENDDO
  259.             SEGACT,meleme*NOMOD
  260.             N1 = N1 + 1
  261.           ELSE
  262.             meleme = ipt0
  263.           ENDIF
  264.           ipt1.lisous(is) = meleme
  265.         ENDDO
  266.         SEGACT,ipt1*NOMOD
  267.         IF (N1.EQ.0) THEN
  268.           segsup,ipt1,ipt0
  269.           ipt1 = 0
  270.         ENDIF
  271.  
  272.       ENDIF
  273.  
  274.       IPMOD1 = mmode1
  275.       IPMAI1 = ipt1
  276.  
  277. C  Mise a jour du preconditionnement CCPRECO / "CMODPG"
  278. C  Si N1SM non nul et INIVE different de 1, pas de preco ... En attendant mieux !
  279.       if (N1SM.NE.0 .AND. INIVE.NE.1) then
  280.         if (iimpi0.eq.1972)
  281.      &    write(ioimp,*) 'PIMODL : Preconditionnement non retenu ',
  282.      &                   NSOU1,N1SM,INIVE
  283.         goto 99
  284.       endif
  285.  
  286.       ITAILL       = MIN(ITAILL + 1, NPMDPG)
  287.       NBMODP(ith1) = ITAILL
  288.       DO is = ITAILL, 2, -1
  289.         PMODPE(is,ith1) = PMODPE(is - 1,ith1)
  290.         PMODPH(is,ith1) = PMODPH(is - 1,ith1)
  291.         PMODPS(is,ith1) = PMODPS(is - 1,ith1)
  292.         PMADPS(is,ith1) = PMADPS(is - 1,ith1)
  293.       ENDDO
  294.       PMODPE(1,ith1) = mmodel
  295.       PMODPH(1,ith1) = ihorot
  296.       PMODPS(1,ith1) = mmode1
  297.       PMADPS(1,ith1) = ipt1
  298.       if (iimpi0.eq.1973) then
  299.         write(ioimp,*) 'PIMODL : Preconditionnement realise',
  300.      &                 mmodel,mmode1,ipt1,itaill
  301.       endif
  302.  
  303. C Sortie du sous-programme (menage...)
  304.  99   CONTINUE
  305.       SEGSUP,limodl
  306.  100  CONTINUE
  307.  
  308. c      RETURN
  309.       END
  310.  
  311.  
  312.  
  313.  

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