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