Télécharger la plaquette Cast3M


fr en

Télécharger surfp6.eso

Retour à la liste

Numérotation des lignes : 

surfp6

  1. C SURFP6    SOURCE    PV        20/03/24    21:22:19     10554          
  2. *>>>>> P.M. 04/10/90
  3.       SUBROUTINE SURFP6 (OPERAT,XPROJ,NDEB,NUMNP,ISUPPR,msurfp)
  4. ************************************************************************
  5. *
  6. *                             S U R F P 6
  7. *                             -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. *     HOMOLOGUE DE "PPLAN", "PCYLI" ET CIE, AVEC L'OPTION IOP=2,
  13. *     UTILISE DANS LE CAS DU TRAITEMENT D'UNE SURFACE AVEC L'OPTION
  14. *     "POLYNOME".
  15. *     PASSAGE AUX COORDONNEES REELLES POUR LES POINTS INTERIEURS CREES.
  16. *
  17. * MODULES UTILISES:
  18. * -----------------
  19. *
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21.       IMPLICIT INTEGER(I-N)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMCOORD
  26. -INC TMSURFP
  27. *
  28. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  29. * -----------
  30. *
  31. *     OPERAT  (E)  NOM DE L'OPERATEUR UTILISE
  32. *     XPROJ   (E)  COORDONNEES PARAMETRIQUES DES POINTS DE LA SURFACE.
  33. *     NDEB    (E)  INDICE, DANS "XPROJ", DU PREMIER NOEUD INTERIEUR DE
  34. *                  LA SURFACE.
  35. *     NUMNP   (E)  INDICE, DANS "XPROJ", DU DERNIER NOEUD INTERIEUR DE
  36. *                  LA SURFACE.
  37. *     ISUPPR  (E)  = 1 POUR SUPPRIMER LES SEGMENTS DE TRAVAIL "XPROJ",
  38. *                  "MSURFP" ET SEGMENTS SOUS-JACENTS.
  39. *                  = 0 SINON.
  40. *    +IDIM    (E)  VOIR LE COMMUN "COPTIO".
  41. *    +MSURFP  (E)  POINTEUR DE SURFACE PARAMETREE.
  42. *    +MCOORD  (S)  REMPLISSAGE DES COORDONNEES DES NOEUDS INTERIEURS
  43. *                  A LA SURFACE.
  44. *<<<<<
  45. *
  46.       CHARACTER*(*) OPERAT
  47.       SEGMENT XPROJ(3,IMAX)
  48. *
  49. * VARIABLES:
  50. * ---------
  51. *
  52. *     ASUR( ) : 1ERE COORDONNEE PARAMETRIQUE DES POINTS DE LA SURFACE
  53. *     BSUR( ) : 2EME COORDONNEE PARAMETRIQUE DES POINTS DE LA SURFACE
  54. *     DSUR( ) : DENSITE DES POINTS DE LA SURFACE, CALCULEE DANS SURFP5
  55. *
  56.       INTEGER LONG,NOMB1,NOMB2,NOMB3,NOMB4
  57.       REAL*8 R1,R2,R3
  58.       SEGMENT,MTRAV
  59.          REAL*8 ASUR(LONG),BSUR(LONG),DSUR(LONG)
  60.       ENDSEGMENT
  61. *
  62. * FONCTIONS:
  63. * ----------
  64. *
  65.       REAL*8 POLYN2
  66. *
  67. * AUTEUR, DATE DE CREATION:
  68. * -------------------------
  69. *
  70. *     PASCAL MANIGOT     26 FEVRIER 1987
  71. *
  72. * LANGAGE:
  73. * --------
  74. *
  75. *     ESOPE77 FORTRAN77 + EXTENSION: DECLARATION "REAL*8".
  76. *
  77. ************************************************************************
  78. *
  79.       SEGACT,MSURFP*MOD
  80.       SEGACT,XPROJ*MOD
  81. *
  82.       SEGACT,MCOORD*MOD
  83.       NBPTA = nbpts
  84.       NBPTS = NBPTA + NUMNP - NDEB + 1
  85. *
  86.       IF (NBPTS .GT. NBPTA) THEN
  87. *
  88.          SEGADJ,MCOORD
  89.          IF (OPERAT(1:4).EQ.'SURF') THEN
  90.             LONG=NUMNP-NDEB+1
  91.             SEGINI,MTRAV
  92.             DO 500 IB=NDEB,NUMNP
  93.                ASUR(IB-NDEB+1) = XPROJ(1,IB)
  94.                BSUR(IB-NDEB+1) = XPROJ(2,IB)
  95.                DSUR(IB-NDEB+1) = XPROJ(3,IB)
  96. 500            CONTINUE
  97. *           END DO
  98.             CALL SURFP8(.FALSE.,ASUR,BSUR,DSUR,LONG,U1SUR,U2SUR,V1SUR,
  99.      &                  V2SUR,NOMB1,NOMB2,NOMB3,NOMB4)
  100.             NUPT = NBPTA
  101.             DO 510 IB=1,LONG
  102.                NUPT = NUPT + 1
  103.                R1 = ASUR(IB)
  104.                R2 = BSUR(IB)
  105.                R3 = - DSUR(IB)
  106.                CALL SURFP9 (NUPT,R1,R2,R3,msurfp)
  107.  510           CONTINUE
  108. *           END DO
  109.             SEGSUP,MTRAV
  110.          ELSE
  111.             NUPT = NBPTA
  112.             DO 520 IB=NDEB,NUMNP
  113.                NUPT = NUPT + 1
  114.                R1 = XPROJ(1,IB)
  115.                R2 = XPROJ(2,IB)
  116.                R3 = - XPROJ(3,IB)
  117.                CALL SURFP9 (NUPT,R1,R2,R3,msurfp)
  118.  520           CONTINUE
  119. *           END DO
  120.          END IF
  121.       END IF
  122. *
  123. *>>>>> P.M. 04/10/90
  124.       IF (ISUPPR .EQ. 1) THEN
  125. *<<<<<
  126. *     DESTRUCTION DES SEGMENTS DE TRAVAIL:
  127.       SEGSUP,XPROJ
  128.       MUVSUR = IUVSUR
  129.       SEGSUP,MUVSUR
  130.       MCOFSU = ICOFSU
  131.       SEGSUP,MCOFSU
  132.       SEGSUP,MSURFP
  133. *>>>>> P.M. 04/10/90
  134.       END IF
  135. *<<<<<
  136. *
  137.       END
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  

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