Télécharger la plaquette Cast3M


fr en

Télécharger fixmel.eso

Retour à la liste

Numérotation des lignes : 

fixmel

  1. C FIXMEL    SOURCE    CHAT      05/01/13    00:01:55     5004
  2.       SUBROUTINE FIXMEL(MELPRI,MELDUA,
  3.      $     MELPR2,MELDU2,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : FIXMEL
  9. C PROJET      : Noyau linéaire NLIN
  10. C DESCRIPTION : On corrige les maillages primaux et duaux s'ils n'ont
  11. C      pas le même nombre de sous-objets géométriques.
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES (UTIL.)  : RSETI
  18. C APPELE PAR       : PRASEM
  19. C***********************************************************************
  20. C ENTREES            : MELPRI, MELDUA
  21. C SORTIES            : MELPR2, MELDU2
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION    : v1, 16/11/99, version initiale
  25. C HISTORIQUE : v1, 16/11/99, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMELEME
  36.       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  37.       POINTEUR MELPRI.MELEME
  38.       POINTEUR MELDUA.MELEME
  39.       POINTEUR MELPR2.MELEME
  40.       POINTEUR MELDU2.MELEME
  41.       POINTEUR SMLPRI.MELEME
  42.       POINTEUR SMLDUA.MELEME
  43.       POINTEUR SMLPR2.MELEME
  44.       POINTEUR SMLDU2.MELEME
  45. -INC SMLENTI
  46.       INTEGER JG
  47.       POINTEUR NBLPRI.MLENTI
  48.       POINTEUR NBLDUA.MLENTI
  49.       POINTEUR NBLMIX.MLENTI
  50. *
  51.         INTEGER IDXPRI,IDXDUA
  52.         INTEGER NELPRI,NELDUA
  53.         INTEGER NUPRI,NUDUA,NUMIX
  54.         INTEGER ISOUS,ISOUP,ISOUD,ISOUM
  55.         INTEGER NSOUS,NSOUP,NSOUD,NSOUM
  56. *
  57.         INTEGER IMPR,IRET
  58. *
  59. * Executable statements
  60. *
  61.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans fixmel'
  62. *
  63. * Comptage des éléments dans chaque MELEME
  64. *
  65. * primal...
  66.       SEGACT MELPRI
  67.       NSOUS=MELPRI.LISOUS(/1)
  68.       JG=MAX(1,NSOUS)+1
  69.       SEGINI NBLPRI
  70.       NBLPRI.LECT(1)=1
  71.       DO 1 ISOUS=1,MAX(1,NSOUS)
  72.          IF (NSOUS.EQ.0) THEN
  73.             SMLPRI=MELPRI
  74.          ELSE
  75.             SMLPRI=MELPRI.LISOUS(ISOUS)
  76.             SEGACT SMLPRI
  77.          ENDIF
  78.          NBLPRI.LECT(ISOUS+1)=NBLPRI.LECT(ISOUS)+SMLPRI.NUM(/2)
  79.          IF (NSOUS.NE.0) SEGDES SMLPRI
  80.  1    CONTINUE
  81.       SEGDES MELPRI
  82. * ... et dual
  83.       SEGACT MELDUA
  84.       NSOUS=MELDUA.LISOUS(/1)
  85.       JG=MAX(1,NSOUS)+1
  86.       SEGINI NBLDUA
  87.       NBLDUA.LECT(1)=1
  88.       DO 3 ISOUS=1,MAX(1,NSOUS)
  89.          IF (NSOUS.EQ.0) THEN
  90.             SMLDUA=MELDUA
  91.          ELSE
  92.             SMLDUA=MELDUA.LISOUS(ISOUS)
  93.             SEGACT SMLDUA
  94.          ENDIF
  95.          NBLDUA.LECT(ISOUS+1)=NBLDUA.LECT(ISOUS)+SMLDUA.NUM(/2)
  96.          IF (NSOUS.NE.0) SEGDES SMLDUA
  97.  3    CONTINUE
  98.       SEGDES MELDUA
  99. *
  100. * D'où les nombres d'éléments (+1)...
  101. *
  102.       NSOUP=NBLPRI.LECT(/1)-1
  103.       NELPRI=NBLPRI.LECT(NSOUP+1)
  104.       NSOUD=NBLDUA.LECT(/1)-1
  105.       NELDUA=NBLDUA.LECT(NSOUD+1)
  106.       IF (NELPRI.NE.NELDUA) THEN
  107.          WRITE(IOIMP,*) 'Maillage primaux et duaux : nbel différents'
  108.          GOTO 9999
  109.       ENDIF
  110.       IF (NSOUP.EQ.NSOUD) THEN
  111.          MELPR2=MELPRI
  112.          MELDU2=MELDUA
  113.       ELSE
  114. *
  115. *     On détermine combien il faudra de sous-maillages
  116. *     avec quels nombres d'éléments par sous-maillage
  117. *
  118.          NSOUM=NSOUP*NSOUD
  119.          JG=NSOUM+1
  120.          SEGINI NBLMIX
  121.          ISOUP=1
  122.          ISOUD=1
  123.          ISOUM=0
  124.          NUPRI=NBLPRI.LECT(ISOUP+1)
  125.          NUDUA=NBLDUA.LECT(ISOUD+1)
  126.          NBLMIX.LECT(ISOUM+1)=1
  127.  5       CONTINUE
  128.          IF (NUPRI.LT.NUDUA) THEN
  129.             ISOUM=ISOUM+1
  130.             NBLMIX.LECT(ISOUM+1)=NUPRI
  131.             ISOUP=ISOUP+1
  132.             NUPRI=NBLPRI.LECT(ISOUP+1)
  133.             GOTO 5
  134.          ELSEIF (NUPRI.GT.NUDUA) THEN
  135.             ISOUM=ISOUM+1
  136.             NBLMIX.LECT(ISOUM+1)=NUDUA
  137.             ISOUD=ISOUD+1
  138.             NUDUA=NBLDUA.LECT(ISOUD+1)
  139.             GOTO 5
  140.          ELSE
  141.             ISOUM=ISOUM+1
  142.             NBLMIX.LECT(ISOUM+1)=NUDUA
  143.             IF (NUPRI.LT.NELPRI.AND.NUDUA.LT.NELDUA) THEN
  144.                ISOUP=ISOUP+1
  145.                ISOUD=ISOUD+1
  146.                NUPRI=NBLPRI.LECT(ISOUP+1)
  147.                NUDUA=NBLDUA.LECT(ISOUD+1)
  148.                GOTO 5
  149.             ELSEIF (.NOT.(NUPRI.EQ.NELPRI.AND.NUDUA.EQ.NELDUA)) THEN
  150.                WRITE(IOIMP,*) 'Erreur de programmation'
  151.                GOTO 9999
  152.             ENDIF
  153.          ENDIF
  154. *
  155. *     On remplit MELPR2 et MELDU2 (partitionnés) comme il faut.
  156. *
  157.          NBNN=0
  158.          NBELEM=0
  159.          NBSOUS=ISOUM
  160.          NBREF=0
  161.          SEGINI MELPR2
  162.          SEGINI MELDU2
  163.          ISOUP=1
  164.          ISOUD=1
  165.          ISOUM=0
  166.          SEGACT MELPRI
  167.          NSOUP=MELPRI.LISOUS(/1)
  168.          IF (NSOUP.EQ.0) THEN
  169.             SMLPRI=MELPRI
  170.          ELSE
  171.             SMLPRI=MELPRI.LISOUS(1)
  172.             SEGACT SMLPRI
  173.          ENDIF
  174.          SEGACT MELDUA
  175.          NSOUD=MELDUA.LISOUS(/1)
  176.          IF (NSOUD.EQ.0) THEN
  177.             SMLDUA=MELDUA
  178.          ELSE
  179.             SMLDUA=MELDUA.LISOUS(1)
  180.             SEGACT SMLDUA
  181.          ENDIF
  182.          NUPRI=NBLPRI.LECT(ISOUP+1)
  183.          NUDUA=NBLDUA.LECT(ISOUD+1)
  184.          NUMIX=NBLMIX.LECT(ISOUM+1)
  185.  7       CONTINUE
  186.          IF (NUPRI.LT.NUDUA) THEN
  187.             ISOUM=ISOUM+1
  188.             NBNN=SMLPRI.NUM(/1)
  189.             NBELEM=NUPRI-NUMIX
  190.             NBSOUS=0
  191.             NBREF=0
  192.             SEGINI SMLPR2
  193.             SMLPR2.ITYPEL=SMLPRI.ITYPEL
  194.             IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
  195.             CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
  196.             SEGDES SMLPR2
  197.             MELPR2.LISOUS(ISOUM)=SMLPR2
  198.             NBNN=SMLDUA.NUM(/1)
  199.             SEGINI SMLDU2
  200.             SMLDU2.ITYPEL=SMLDUA.ITYPEL
  201.             IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
  202.             CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
  203.             SEGDES SMLDU2
  204.             MELDU2.LISOUS(ISOUM)=SMLDU2
  205.             SEGDES SMLPRI
  206.             ISOUP=ISOUP+1
  207.             SMLPRI=MELPRI.LISOUS(ISOUP)
  208.             SEGACT SMLPRI
  209.             NUPRI=NBLPRI.LECT(ISOUP+1)
  210.             NUMIX=NBLMIX.LECT(ISOUM+1)
  211.             GOTO 7
  212.          ELSEIF (NUPRI.GT.NUDUA) THEN
  213.             ISOUM=ISOUM+1
  214.             NBNN=SMLPRI.NUM(/1)
  215.             NBELEM=NUDUA-NUMIX
  216.             NBSOUS=0
  217.             NBREF=0
  218.             SEGINI SMLPR2
  219.             SMLPR2.ITYPEL=SMLPRI.ITYPEL
  220.             IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
  221.             CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
  222.             SEGDES SMLPR2
  223.             MELPR2.LISOUS(ISOUM)=SMLPR2
  224.             NBNN=SMLDUA.NUM(/1)
  225.             SEGINI SMLDU2
  226.             SMLDU2.ITYPEL=SMLDUA.ITYPEL
  227.             IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
  228.             CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
  229.             SEGDES SMLDU2
  230.             MELDU2.LISOUS(ISOUM)=SMLDU2
  231.             SEGDES SMLDUA
  232.             ISOUD=ISOUD+1
  233.             SMLDUA=MELDUA.LISOUS(ISOUD)
  234.             SEGACT SMLDUA
  235.             NUDUA=NBLDUA.LECT(ISOUD+1)
  236.             NUMIX=NBLMIX.LECT(ISOUM+1)
  237.             GOTO 7
  238.          ELSE
  239.             ISOUM=ISOUM+1
  240.             NBNN=SMLPRI.NUM(/1)
  241.             NBELEM=NUDUA-NUMIX
  242.             NBSOUS=0
  243.             NBREF=0
  244.             SEGINI SMLPR2
  245.             SMLPR2.ITYPEL=SMLPRI.ITYPEL
  246.             IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
  247.             CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
  248.             SEGDES SMLPR2
  249.             MELPR2.LISOUS(ISOUM)=SMLPR2
  250.             NBNN=SMLDUA.NUM(/1)
  251.             SEGINI SMLDU2
  252.             SMLDU2.ITYPEL=SMLDUA.ITYPEL
  253.             IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
  254.             CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
  255.             SEGDES SMLDU2
  256.             MELDU2.LISOUS(ISOUM)=SMLDU2
  257.             IF (NUPRI.LT.NELPRI.AND.NUDUA.LT.NELDUA) THEN
  258.                SEGDES SMLPRI
  259.                ISOUP=ISOUP+1
  260.                SMLPRI=MELPRI.LISOUS(ISOUP)
  261.                SEGACT SMLPRI
  262.                SEGDES SMLDUA
  263.                ISOUD=ISOUD+1
  264.                SMLDUA=MELDUA.LISOUS(ISOUD)
  265.                SEGACT SMLDUA
  266.                NUPRI=NBLPRI.LECT(ISOUP+1)
  267.                NUDUA=NBLDUA.LECT(ISOUD+1)
  268.                NUMIX=NBLMIX.LECT(ISOUM+1)
  269.                GOTO 7
  270.             ELSEIF (.NOT.(NUPRI.EQ.NELPRI.AND.NUDUA.EQ.NELDUA)) THEN
  271.                WRITE(IOIMP,*) 'Erreur de programmation'
  272.                GOTO 9999
  273.             ENDIF
  274.          ENDIF
  275.          IF (NSOUD.NE.0) SEGDES SMLDUA
  276.          SEGDES MELDUA
  277.          IF (NSOUP.NE.0) SEGDES SMLPRI
  278.          SEGDES MELPRI
  279.          SEGDES MELDU2
  280.          SEGDES MELPR2
  281.          SEGSUP NBLMIX
  282.       ENDIF
  283.       SEGSUP NBLDUA
  284.       SEGSUP NBLPRI
  285. *
  286. * Normal termination
  287. *
  288.       IRET=0
  289.       RETURN
  290. *
  291. * Format handling
  292. *
  293. *
  294. * Error handling
  295. *
  296.  9999 CONTINUE
  297.       IRET=1
  298.       WRITE(IOIMP,*) 'An error was detected in subroutine fixmel'
  299.       RETURN
  300. *
  301. * End of subroutine FIXMEL
  302. *
  303.       END
  304.  
  305.  
  306.  
  307.  

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