Télécharger la plaquette Cast3M


fr en

Télécharger surfp1.eso

Retour à la liste

Numérotation des lignes : 

surfp1

  1. C SURFP1    SOURCE    PV        22/04/26    21:15:08     11344          
  2.       SUBROUTINE SURFP1 (OPERAU,LIGN01,LIGN02,LIGN03,LIGN04,
  3.      $ L0TOUR,msurr)
  4. ************************************************************************
  5. *
  6. *                             S U R F P 1
  7. *                             -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. *     1) LECTURE DES OPERANDES DES OPERATEURS "DALLER" ET "SURFACE" AVEC
  13. *        L'OPTION "POLYNOME" (SURFACE PARAMETREE).
  14. *
  15. *     2) MAILLAGE DES COTES DE LA SURFACE (APPEL "SURFP2").
  16. *
  17. *     3) (EVENTUELLEMENT) DEFINITION DU CONTOUR DE LA SURFACE (APPEL
  18. *        "SURFP3").
  19. *
  20. * PHRASE D'APPEL (EN GIBIANE):
  21. * ----------------------------
  22. *
  23. *            | SURFACE |
  24. *     LILI = | DALLER  | POLYNOME N M P00  P01 (P02 (P03 ...) )
  25. *                                     P10  P11 (P12 (P13 ...) )
  26. *                                    (P20 (P21 (P22 (P23 ...) )
  27. *                                    (         ...            )
  28. *                       (PARAMETRE U1 U2 V1 V2) (REGULIER) ;
  29. *
  30. *     LE RESULTAT "LILI" EST LE MAILLAGE DE LA SURFACE D'EQUATION:
  31. *
  32. *                                   | P00 P01 P02 P03 .. |   |   1    |
  33. *                    2     (M-1)    | P10 P11 P12 P13 .. |   |   U    |
  34. *     P(U,V) = (1 V V  ...V     ) X | P20 P21 P22 P23 .. | X |  ..    |
  35. *                                   |         ...        |   |U**(N-1)|
  36. *
  37. * OPERANDES EN GIBIANE:
  38. * ---------------------
  39. *
  40. *     N         'ENTIER  '  NOMBRE DE COLONNES DE LA MATRICE DE POINTS.
  41. *                           = (DEGRE EN "U" DU POLYNOME) + 1
  42. *                           >= 2
  43. *     M         'ENTIER  '  NOMBRE DE LIGNES DE LA MATRICE DE POINTS.
  44. *                           = (DEGRE EN "V" DU POLYNOME) + 1
  45. *                           >= 2
  46. *     P00,      'POINT   '  COEFFICIENTS DU POLYNOME REPRESENTANT LA
  47. *     P01, ...              SURFACE PARAMETREE. LES ABSCISSES DES POINTS
  48. *                           DONNENT LA REPRESENTATION PARAMETRIQUE DES
  49. *                           ABSCISSES DES POINTS DE LA SURFACE, ETC...
  50. *     U1, U2    'FLOTTANT'  BORNES DU PARAMETRE "U" = (0,1) PAR DEFAUT.
  51. *     V1, V2    'FLOTTANT'  BORNES DU PARAMETRE "V" = (0,1) PAR DEFAUT.
  52. *     REGULIER  'MOT     '  LES POINTS DOIVENT ETRE REGULIEREMENT
  53. *                           REPARTIS DANS L'ESPACE GEOMETRIQUE (EU EGARD
  54. *                           AUX DENSITES EXISTANTES) PLUTOT QUE DANS
  55. *                           L'ESPACE PARAMETRIQUE.
  56. *
  57. * MODULES UTILISES:
  58. * -----------------
  59. *
  60.       IMPLICIT INTEGER(I-N)
  61.       IMPLICIT real*8 (a-h,o-z)
  62.  
  63. -INC PPARAM
  64. -INC CCOPTIO
  65. -INC SMCOORD
  66. -INC TMSURFP
  67. *
  68. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  69. * -----------
  70. *
  71. *     OPERAT  (E)  NOM DE L'OPERATEUR UTILISE.
  72. *    +IDIM    (E)  VOIR LE COMMUN "COPTIO".
  73. *    +MCOORD  (E)  VOIR LE COMMUN "COPTIO".
  74. *     LIGN01  (S)  COTE N.1 DE LA SURFACE A MAILLER (OBJET "MAILLAGE").
  75. *     LIGN02  (S)  COTE N.2 DE LA SURFACE A MAILLER (OBJET "MAILLAGE").
  76. *     LIGN03  (S)  COTE N.3 DE LA SURFACE A MAILLER (OBJET "MAILLAGE").
  77. *     LIGN04  (S)  COTE N.4 DE LA SURFACE A MAILLER (OBJET "MAILLAGE").
  78. *     L0TOUR  (S)  CONTOUR DE LA SURFACE A MAILLER (OBJET "MAILLAGE").
  79. *                  FOURNI UNIQUEMENT POUR L'OPERATEUR "SURFACE".
  80. *    +MSURFP  (S)  POINTEUR DE LA SURFACE PARAMETREE.
  81. *                  LAISSE DANS L'ETAT ACTIF.
  82. *
  83.       CHARACTER*4 OPERAT
  84.       CHARACTER*(*) OPERAU
  85.       INTEGER LIGN01,LIGN02,LIGN03,LIGN04,L0TOUR
  86.       REAL*8 XBID(3)
  87. *
  88. * VARIABLES:
  89. * ----------
  90. *
  91. *     LIGNE. = COPIES LOCALES DES ARGUMENTS "LIGN0.", AVEC "."=1,2,3,4.
  92. *     LETOUR = COPIE LOCALE DE L'ARGUMENT "L0TOUR".
  93. *
  94.       INTEGER LIGNE1,LIGNE2,LIGNE3,LIGNE4,LETOUR
  95.        real*8 bidsp
  96.       SEGMENT,MTEMP
  97.          INTEGER ITEMP(N1*N2)
  98.       ENDSEGMENT
  99.       POINTEUR MTEMP1.MTEMP
  100. *
  101. * CONSTANTES:
  102. * -----------
  103. *
  104. *     MOTCLE = LISTE DES MOT-CLES RECONNUS.
  105. *
  106.       PARAMETER (LMOTCL = 2)
  107.       CHARACTER*4 MOTCLE(LMOTCL)
  108.       CHARACTER*4 SURF
  109.       PARAMETER (SURF = 'SURF')
  110. *
  111. * AUTEUR, DATE DE CREATION:
  112. * -------------------------
  113. *
  114. *     PASCAL MANIGOT     05 MARS 1987
  115. *
  116. * LANGAGE:
  117. * --------
  118. *
  119. *     ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
  120. *
  121. ************************************************************************
  122. *
  123.       DATA MOTCLE/'PARA','REGU'/
  124. *
  125.       SEGINI,MSURFP
  126.       msurr=msurfp
  127.       ICOFSU = 0
  128.       IUVSUR = 0
  129.       IPRSUR = 0
  130. *
  131. *     VALEURS PAR DEFAUT DES PARAMETRES
  132.       U1SUR = 0.D0
  133.       U2SUR = 1.D0
  134.       V1SUR = 0.D0
  135.       V2SUR = 1.D0
  136.       REGSUR = .FALSE.
  137. *
  138. *     -- DIMENSIONS DE LA MATRICE --
  139. *
  140.       CALL LIRE03 (2,I,1,IRETOU)
  141.       IF (IERR .NE. 0) RETURN
  142.       NCOSUR = I
  143.       CALL LIRE03 (2,I,1,IRETOU)
  144.       IF (IERR .NE. 0) RETURN
  145.       NLISUR = I
  146. *
  147. *     -- LECTURE DES PARAMETRES PARTICULIERS --
  148. *
  149. *     DO
  150.   205    CONTINUE
  151. *
  152.          CALL LIRMOT (MOTCLE,LMOTCL,IRETOU,0)
  153.          IF (IRETOU .LE. 0) THEN
  154. *           --> SORTIE DE BOUCLE
  155.             GOTO 206
  156.          END IF
  157. *
  158.          GOTO (101,102) IRETOU
  159.   101    CONTINUE
  160.             CALL LIRREE (BIDSP,1,IRETOU)
  161.             IF (IERR .NE. 0) RETURN
  162.             U1SUR = BIDSP
  163.             CALL LIRREE (BIDSP,1,IRETOU)
  164.             IF (IERR .NE. 0) RETURN
  165.             U2SUR = BIDSP
  166.             IF (U1SUR.EQ.U2SUR) THEN
  167.                CALL ERREUR(402)
  168.                RETURN
  169.             END IF
  170. *           RQ: AUCUNE RELATION D'ORDRE ENTRE "U1SUR" ET "U2SUR" POUR
  171. *               NE PAS IMPOSER, PAR EXEMPLE, AU COTE 1 DE CORRESPONDRE
  172. *               A LA PLUS PETITE VALEUR DE PARAMETRE.
  173.             CALL LIRREE (BIDSP,0,IRETOU)
  174.             IF (IRETOU .EQ. 1) V1SUR = BIDSP
  175.             CALL LIRREE (BIDSP,0,IRETOU)
  176.             IF (IRETOU .EQ. 1) V2SUR = BIDSP
  177.             IF (V1SUR.EQ.V2SUR) THEN
  178.                CALL ERREUR(402)
  179.                RETURN
  180.             END IF
  181.             GOTO 200
  182.   102    CONTINUE
  183.             REGSUR = .TRUE.
  184.             GOTO 200
  185.   200    CONTINUE
  186. *
  187.          GOTO 205
  188. *     END DO
  189.   206 CONTINUE
  190. *
  191. *     -- LECTURE DES POINTS DE LA MATRICE --
  192. *
  193.       N1 = NCOSUR
  194.       N2 = NLISUR
  195.       SEGINI,MTEMP
  196.       N3 = N1 * N2
  197.       DO 250 IB=1,N3
  198.          CALL LIROBJ ('POINT   ',IP,1,IRETOU)
  199.          IF (IERR .NE. 0) RETURN
  200.          ITEMP(IB) = IP
  201.   250    CONTINUE
  202. *     END DO
  203. *
  204. *     LA MATRICE A ETE DONNEE LIGNE PAR LIGNE. MAIS C'EST UN RANGEMENT
  205. *     COLONNE PAR COLONNE QUI EST INTERESSANT EN FORTRAN (EQUIVALENCE
  206. *     AVEC MATRICE RECTANGULAIRE).
  207.       SEGINI,MTEMP1
  208.       CALL TRSPOS (ITEMP,N1,N2,  MTEMP1.ITEMP)
  209.       SEGSUP,MTEMP
  210. *
  211. *     ECLATEMENT DE LA MATRICE EN MATRICES REELLES:
  212.       N = NCOSUR
  213.       M = NLISUR
  214.       SEGINI,MCOFSU
  215.       ICOFSU = MCOFSU
  216.       SEGACT,MCOORD
  217.       IF (IDIM .EQ. 3) THEN
  218.          CALL DCOMP1 (MTEMP1.ITEMP,N3,XCOOR,
  219.      &               COFSUR(1,1,1),COFSUR(1,1,2),COFSUR(1,1,3))
  220.       ELSE
  221.          CALL DCOMP1 (MTEMP1.ITEMP,N3,XCOOR,
  222.      &               COFSUR(1,1,1),COFSUR(1,1,2),XBID)
  223.       END IF
  224.       SEGSUP,MTEMP1
  225.       SEGDES,MCOFSU
  226. *
  227. *     -- DEFINITION DES 4 COTES EN APPLIQUANT LA MATRICE DE POINTS --
  228. *     --   ET DEFINITION DU CONTOUR, POUR L'OPERATEUR "SURFACE"    --
  229. *
  230.       OPERAT=OPERAU
  231.       CALL SURFP2 (OPERAT,LIGNE1,LIGNE2,LIGNE3,LIGNE4,msurfp)
  232.       IF (IERR .NE. 0) RETURN
  233. *
  234.       IF (OPERAT .EQ. SURF) THEN
  235.          CALL SURFP3 (LIGNE1,LIGNE2,LIGNE3,LIGNE4, LETOUR,msurfp)
  236.          L0TOUR = LETOUR
  237.          IF (IIMPI.EQ.1804) THEN
  238.             CALL ECMAI1(L0TOUR,0)
  239.          END IF
  240. *>>>>> P.M. 04/10/90
  241. *+*   ELSE
  242.       END IF
  243. *<<<<<
  244.          LIGN01 = LIGNE1
  245.          LIGN02 = LIGNE2
  246.          LIGN03 = LIGNE3
  247.          LIGN04 = LIGNE4
  248. *>>>>> P.M. 04/10/90
  249. *+*   END IF
  250. *<<<<<
  251. *
  252.       END
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  

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