Télécharger la plaquette Cast3M


fr en

Télécharger prdiff.eso

Retour à la liste

Numérotation des lignes : 

prdiff

  1. C PRDIFF    SOURCE    CB215821  24/04/12    21:16:54     11897          
  2. C    INTERFACE ENTRE LA DIRECTIVE "DIFF" (DIFFERENCE SYMETRIQUE) ET LE
  3. C    SOUS PROGRAMME OUEXCL
  4. C
  5. C    Modif : 2014 C. BERTHINIER
  6. C            Dans le cas de la DIFF de 2 MELEME SIMPLE du meme TYPE, si
  7. C            Le résultat est VIDE il est du même type que le MELEME
  8. C            SIMPLE donné en argument
  9. C
  10.       SUBROUTINE PRDIFF
  11.  
  12.       IMPLICIT INTEGER(I-N)
  13.  
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMELEME
  18. -INC SMMODEL
  19. -INC SMRIGID
  20.  
  21. C
  22. C---- OBJETS DE TYPE RIGIDITE
  23. C
  24.       CALL LIROBJ('RIGIDITE',IPRIG1,0,IRETOU)
  25.       IF (IERR.NE.0) RETURN
  26.  
  27.       IF (IRETOU.EQ.1) THEN
  28.  
  29.         CALL LIROBJ('RIGIDITE',IPRIG2,1,IRETOU)
  30.         IF (IERR.NE.0) RETURN
  31.  
  32.         CALL DIFRIG(IPRIG1,IPRIG2)
  33.         RETURN
  34.  
  35.       ENDIF
  36.  
  37. C
  38. C---- OBJETS DE TYPE MODELE
  39. C
  40.       CALL LIROBJ('MMODEL',IPMOD1,0,IRETOU)
  41.       IF (IERR.NE.0) RETURN
  42.  
  43.       IF (IRETOU.EQ.1) THEN
  44.  
  45.         CALL LIROBJ('MMODEL',IPMOD2,1,IRETOU)
  46.         IF (IERR.NE.0) RETURN
  47.  
  48.         CALL DIFMOD(IPMOD1,IPMOD2)
  49.         RETURN
  50.  
  51.       ENDIF
  52.  
  53. C
  54. C---- OBJETS DE TYPE MAILLAGE 
  55. C
  56.       NBSOUS =0
  57.  
  58.       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  59.       IF (IERR.NE.0) RETURN
  60.       CALL ACTOBJ('MAILLAGE',IPT1,1)
  61.       CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  62.       IF (IERR.NE.0) RETURN
  63.       CALL ACTOBJ('MAILLAGE',IPT2,1)
  64.  
  65.       IF (IPT1.LISOUS(/1).NE.0) GOTO 10
  66.       IF (IPT2.LISOUS(/1).NE.0) GOTO 11
  67.  
  68.  
  69.  
  70.       IF ((IPT1.ITYPEL  .EQ. IPT2.ITYPEL) .AND.
  71.      &     (IPT1.NUM(/1) .EQ. IPT2.NUM(/1))     ) THEN
  72. C     Cas de deux MAILLAGES SIMPLES, de même TYPE et même NBNN
  73.  
  74.         IF (IPT1.EQ.IPT2) THEN
  75. C     Les deux maillages sont identiques : résultat vide du même type
  76.            ity=ipt1.itypel
  77.            call melvid(ity,IPT3)
  78.         ELSE
  79. C         OU Exclusif sur IPT1 et IPT2
  80.            CALL OUEXCL(IPT1,IPT2,IPT3)
  81.  
  82.            IF (IPT3.EQ.0) THEN
  83. C         le résultat est vide on lui met le même type
  84.               ity=ipt1.itypel
  85.               call melvid(ity,IPT3)
  86.            ENDIF
  87.         ENDIF
  88.       ELSE
  89. C     Cas de deux MAILLAGES SIMPLES, de TYPE ou NBNN différent
  90. C     Adjonction directe des deux sous-maillages simples de structure différente
  91. C     C'est le cas des maillages polyedriques dont NBNN peut varier pour le même ITYPEL
  92.         NBELEM =0
  93.         NBNN   =0
  94.         NBREF  =0
  95.         NBSOUS =2
  96.         SEGINI IPT3
  97.         IPT3.LISOUS(1)=IPT1
  98.         IPT3.LISOUS(2)=IPT2
  99.       ENDIF
  100.  
  101.       IF (IERR.NE.0) RETURN
  102.       GOTO 1000
  103.  
  104.  
  105.  
  106. C     Cas d'un MAILLAGE SIMPLE et l'autre COMPLEXE
  107.  
  108. C     On intervertit pour que le premier soit le MAILLAGE COMPLEXE
  109. C      IPT1 : MELEME COMPLEXE
  110. C      IPT2 : MELEME SIMPLE
  111.   10  IF (IPT2.LISOUS(/1).NE.0) GOTO 20
  112.       GOTO 12
  113.  
  114.   11  IP=IPT2
  115.       IPT2=IPT1
  116.       IPT1=IP
  117.  
  118.   12  CONTINUE
  119.       DO 13 IS=1,IPT1.LISOUS(/1)
  120.          IPT4=IPT1.LISOUS(IS)
  121.          IF (IPT2.NUM(/1).EQ.IPT4.NUM(/1)) THEN
  122.             IF (IPT2.ITYPEL.EQ.IPT4.ITYPEL) GOTO 14
  123.          ENDIF
  124.   13  CONTINUE
  125.  
  126.       NBELEM=0
  127.       NBNN  =0
  128.       NBREF =0
  129.       NBSOU1=IPT1.LISOUS(/1)
  130.       NBSOUS=NBSOU1+1
  131.       SEGINI IPT3
  132.  
  133. C     LES MELEME SIMPLES de IPT1 et IPT2 sont placés dans IPT3
  134.       DO 15 IS=1,NBSOU1
  135.          IPT3.LISOUS(IS)=IPT1.LISOUS(IS)
  136.   15  CONTINUE
  137.  
  138.       IPT3.LISOUS(NBSOUS)=IPT2
  139.       GOTO 1000
  140.  
  141.   14  IF (IPT2.EQ.IPT4) GOTO 17
  142.  
  143.       CALL OUEXCL(IPT2,IPT4,IPT5)
  144.       IF (IERR.NE.0) RETURN
  145.       IF (IPT5.EQ.0) GOTO 17
  146.  
  147.       NBSOUS=IPT1.LISOUS(/1)
  148.       NBNN=0
  149.       NBREF=0
  150.       NBELEM=0
  151.       SEGINI IPT3
  152.       DO 16 IS2=1,NBSOUS
  153.          IPT3.LISOUS(IS2)=IPT1.LISOUS(IS2)
  154.          IF (IS.EQ.IS2) IPT3.LISOUS(IS2)=IPT5
  155.   16  CONTINUE
  156.       GOTO 1000
  157.  
  158.   17  CONTINUE
  159.  
  160. C-------- Cas d'un maillage vide ---------------------------------
  161.  
  162.       NBSOUS=IPT1.LISOUS(/1)
  163.       IF (NBSOUS.EQ.0) THEN
  164.          CALL melvid(0,ipt3)
  165.       ELSE
  166.          NBNN  =0
  167.          NBREF =0
  168.          NBELEM=0
  169.          NBSOUS=IPT1.LISOUS(/1)-1
  170.          SEGINI IPT3
  171.          IS3=0
  172.          DO 18 IS2=1,(NBSOUS + 1)
  173.             IF (IS2.EQ.IS) GOTO 18
  174.             IS3=IS3+1
  175.             IPT3.LISOUS(IS3)=IPT1.LISOUS(IS2)
  176.  18      CONTINUE
  177.       ENDIF
  178.  
  179.       GOTO 1000
  180.  
  181. C---- Les deux maillages entrés sont complexes
  182.   20  CONTINUE
  183.       NBSOU1=IPT1.LISOUS(/1)
  184.       NBSOU2=IPT2.LISOUS(/1)
  185.       NBELEM=0
  186.       NBNN  =0
  187.       NBREF =0
  188.       NBSOUS=NBSOU1+NBSOU2
  189.       SEGINI IPT4
  190.       DO 21 I1=1,NBSOU1
  191.          IPT4.LISOUS(I1)=IPT1.LISOUS(I1)
  192.   21  CONTINUE
  193.       ISUP=0
  194.       DO 22 I2=1,NBSOU2
  195.          IPT5=IPT2.LISOUS(I2)
  196.          ITYP=IPT5.ITYPEL
  197.          DO 23 I1=1,NBSOU1
  198.             IPT6=IPT4.LISOUS(I1)
  199.             IF (IPT6.EQ.0) GOTO 23
  200.  
  201.             IF (IPT6.ITYPEL .NE. ITYP)        GOTO 23
  202.             IF (IPT6.NUM(/1).NE.IPT5.NUM(/1)) GOTO 23
  203.             IF (IPT5.EQ.IPT6)                 GOTO 25
  204.  
  205.             CALL OUEXCL(IPT5,IPT6,IPT7)
  206.             IF (IERR.NE.0) RETURN
  207.             IF (IPT7.EQ.0) GOTO 25
  208.             IPT4.LISOUS(I1)=IPT7
  209.             IPT4.LISOUS(NBSOU1+I2)=0
  210.             ISUP=ISUP+1
  211.             GOTO 22
  212.  
  213.   25        ISUP=ISUP+2
  214.             IPT4.LISOUS(I1)=0
  215.             IPT4.LISOUS(NBSOU1+I2)=0
  216.             GOTO 22
  217.   23     CONTINUE
  218.          IPT4.LISOUS(NBSOU1+I2)=IPT5
  219.   22  CONTINUE
  220.  
  221.       IF (ISUP.EQ.0) GOTO 30
  222.       NBSOUS=NBSOUS-ISUP
  223.  
  224. C-------- Cas d'un maillage vide ---------------------------------
  225.  
  226.       IF (NBSOUS.EQ.0) THEN
  227.          call melvid(0,ipt3)
  228.          segact ipt3
  229.          GOTO 1000
  230.       ENDIF
  231.  
  232.       SEGINI IPT3
  233.       JS=0
  234.       DO 35 IS=1,NBSOUS
  235.   36     JS=JS+1
  236.          IF (IPT4.LISOUS(JS).EQ.0) GOTO 36
  237.          IPT3.LISOUS(IS)=IPT4.LISOUS(JS)
  238.   35  CONTINUE
  239.       SEGSUP IPT4
  240.       IF (NBSOUS.NE.1) GOTO 1000
  241.  
  242.       IPT4=IPT3.LISOUS(1)
  243.       SEGSUP IPT3
  244.   30  IPT3=IPT4
  245.  
  246.  1000 CONTINUE
  247.  
  248. C
  249. C     Nettoyage du maillage dans le cas ou il contient des sous-parties vides
  250. C
  251.       NBSOUS = IPT3.LISOUS(/1)
  252.       IF (NBSOUS .NE. 0) THEN
  253. C     Cas du maillage résultat ayant plusieurs sous zones
  254.         DO 1010 I=1,IPT3.LISOUS(/1)
  255.           MELEME = IPT3.LISOUS(I)
  256.           IF (NUM(/2) .EQ. 0) THEN
  257. C         la sous partie vide est supprimée + tassement du tableau LISOUS
  258.             DO 1020 J=I+1,IPT3.LISOUS(/1)
  259.               IPT3.LISOUS(J-1)=IPT3.LISOUS(J)
  260.  1020       CONTINUE
  261.  
  262.             NBSOUS = NBSOUS - 1
  263.           ENDIF
  264.  
  265.  1010   CONTINUE
  266.  
  267.         IF ( NBSOUS .EQ. 0 ) THEN
  268.            call melvid(0,ipt3)
  269.         ELSEIF ( NBSOUS .EQ. 1 ) THEN
  270. C       Passage en MELEME SIMPLE à nouveau
  271.            IPT3 = IPT3.LISOUS(1)
  272.            IF(IPT3.NUM(/2) .EQ. 0) THEN
  273.               call melvid(0,ipt3)
  274.            ENDIF
  275.         ELSEIF ( NBSOUS .NE. IPT3.LISOUS(/1) ) THEN
  276. C     Le segment MELEME COMPLEXE est ajusté
  277.            NBNN   = 0
  278.            NBELEM = 0
  279.            NBREF  = 0
  280.            SEGADJ IPT3
  281.         ENDIF
  282.       ENDIF
  283.  
  284.       CALL ACTOBJ('MAILLAGE',IPT3,1)
  285.       CALL ECROBJ('MAILLAGE',IPT3)
  286.  
  287.       END
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  

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