1 : C SURFP3 SOURCE PV 07/11/23 21:19:31 5978 2 : SUBROUTINE SURFP3 (LIGNE1,LIGNE2,LIGNE3,LIGNE4, LETOUR,msurfp) 3 : ************************************************************************ 4 : * 5 : * S U R F P 3 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * DEFINIR LE CONTOUR D'UNE SURFACE POLYNOMIALE A PARTIR DE SES 4 12 : * COTES. 13 : * 14 : * MODULES UTILISES: 15 : * ----------------- 16 : * 17 : IMPLICIT REAL*8(A-H,O-Z) 18 : IMPLICIT INTEGER(I-N) 19 : -INC CCOPTIO 20 : -INC SMELEME 21 : -INC TMSURFP 22 : * 23 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 24 : * ----------- 25 : * 26 : * LIGNE1 (E) POINTEUR DU MAILLAGE DU COTE 1. 27 : * LIGNE2 (E) POINTEUR DU MAILLAGE DU COTE 2. 28 : * LIGNE3 (E) POINTEUR DU MAILLAGE DU COTE 3. 29 : * LIGNE4 (E) POINTEUR DU MAILLAGE DU COTE 4. 30 : * +MSURFP (E) POINTEUR DE LA SURFACE PARAMETREE. 31 : * (S) LES POINTS "PT1SUR", ... , "PT4SUR" PEUVENT ETRE 32 : * MODIFIES (ET LES "USUR" ET "VSUR" ASSOCIES). 33 : * LETOUR (S) POINTEUR DU MAILLAGE DU CONTOUR. 34 : * 35 : INTEGER LIGNE1,LIGNE2,LIGNE3,LIGNE4,LETOUR 36 : * 37 : * VARIABLES: 38 : * ---------- 39 : * 40 : INTEGER PT1,PT2,LONG 41 : REAL*8 DSUR 42 : *>>>>> P.M. 21/09/90 43 : REAL*8 EPS1 44 : * 45 : * FONCTIONS: 46 : * ---------- 47 : * 48 : LOGICAL EGA1 49 : * 50 : *<<<<< 51 : * 52 : * AUTEUR, DATE DE CREATION: 53 : * ------------------------- 54 : * 55 : * PASCAL MANIGOT 03 MARS 1987 56 : * 57 : * LANGAGE: 58 : * -------- 59 : * 60 : * ESOPE77 FORTRAN77 61 : * 62 : ************************************************************************ 63 : * 64 : SEGACT,MSURFP 65 : * 66 : IPT1 = LIGNE1 67 : IPT2 = LIGNE2 68 : IPT3 = LIGNE3 69 : IPT4 = LIGNE4 70 : SEGACT IPT1,IPT2,IPT3,IPT4 71 : * 72 : ITPL = IPT1.ITYPEL 73 : *+* IF (ITPL.NE.IPT2.ITYPEL .OR. ITPL.NE.IPT3.ITYPEL 74 : *+* .OR. ITPL.NE.IPT4.ITYPEL) THEN 75 : * RQ: CE CAS NE POURRA SE PRODUIRE QUE LE JOUR OU L'ON POURRA 76 : * DONNER UN COTE EXPLICITEMENT. 76 : *+* CALL ERREUR(16) 77 : *+* RETURN 78 : *+* END IF 79 : * 80 : *>>>>> P.M. 21/09/90 81 : NOMB1 = IPT1.NUM(/2) 82 : NOMB2 = IPT2.NUM(/2) 83 : NOMB3 = IPT3.NUM(/2) 84 : NOMB4 = IPT4.NUM(/2) 85 : EPS1 = -1. 86 : IF (.NOT. ( 87 : & (EGA1(PT1SUR,PT2SUR,EPS1) .AND. EGA1(PT3SUR,PT4SUR,EPS1) 88 : & .AND. (NOMB2 .EQ. 1) .AND. (NOMB4 .EQ. 1)) 89 : &.OR. 90 : & (EGA1(PT2SUR,PT3SUR,EPS1) .AND. EGA1(PT4SUR,PT1SUR,EPS1) 91 : & .AND. (NOMB1 .EQ. 1) .AND. (NOMB3 .EQ. 1)) 92 : & )) THEN 93 : * SI SURFACE PAS TROP PETITE, ON REGARDE S'IL NE S'AGIT PAS D'UNE 94 : * SURFACE PARAMETREE DEGENEREE TELLE QUE: 95 : * - ZONE TRIANGULAIRE, 96 : * - ZONE EN FORME D'OEIL. 97 : * ET ON INTERVIENT EN CONSEQUENCE. 98 : *<<<<< 99 : * 100 : PT1 = PT1SUR 101 : PT2 = PT2SUR 101 : CALL SURFP7 (PT1,PT2,LIGNE1,LIGNE2,LIGNE3,LIGNE4, NOMB1,msurfp) 102 : * "PT2" A PU CHANGER DE VALEUR: 103 : PT2SUR = PT2 104 : PT1 = PT2SUR 105 : PT2 = PT3SUR 105 : CALL SURFP7 (PT1,PT2,LIGNE2,LIGNE3,LIGNE4,LIGNE1, NOMB2,msurfp) 106 : PT3SUR = PT2 107 : PT1 = PT3SUR 108 : PT2 = PT4SUR 108 : CALL SURFP7 (PT1,PT2,LIGNE3,LIGNE4,LIGNE1,LIGNE2, NOMB3,msurfp) 109 : PT4SUR = PT2 110 : PT1 = PT4SUR 111 : PT2 = PT1SUR 111 : CALL SURFP7 (PT1,PT2,LIGNE4,LIGNE1,LIGNE2,LIGNE3, NOMB4,msurfp) 112 : PT1SUR = PT2 113 : * 114 : *>>>>> P.M. 21/09/90 115 : END IF 116 : *<<<<< 117 : * 118 : MUVSUR=IUVSUR 119 : SEGACT,MUVSUR 120 : LONG=USUR(/1) 121 : IF (IIMPI.EQ.1804) THEN 122 : DO 800 I=1,LONG 123 : WRITE(IOIMP,'(I5,2(2X,G12.5))')I,USUR(I),VSUR(I) 124 : 800 CONTINUE 125 : * END DO 126 : END IF 126 : CALL SURFP8(.TRUE.,USUR,VSUR,DSUR,LONG,U1SUR,U2SUR,V1SUR,V2SUR, 127 : & NOMB1,NOMB2,NOMB3,NOMB4) 128 : IF (IIMPI.EQ.1804) THEN 129 : DO 810 I=1,LONG 130 : WRITE(IOIMP,'(I5,2(2X,G12.5))')I,USUR(I),VSUR(I) 131 : 810 CONTINUE 132 : * END DO 133 : END IF 134 : SEGDES,MUVSUR 135 : * 136 : NBNN = IPT1.NUM(/1) 137 : NBELEM = NOMB1 + NOMB2 + NOMB3 + NOMB4 138 : NBREF=0 139 : NBSOUS=0 140 : SEGINI IPT5 141 : IPT5.ITYPEL=ITPL 142 : * 143 : DO 110 J=1,NOMB1 144 : IPT5.ICOLOR(J) = IPT1.ICOLOR(J) 145 : DO 110 I=1,NBNN 146 : IPT5.NUM(I,J)=IPT1.NUM(I,J) 147 : 110 CONTINUE 148 : * END DO 149 : * END DO 150 : DO 120 J=1,NOMB2 151 : J1 = J + NOMB1 152 : IPT5.ICOLOR(J1) = IPT2.ICOLOR(J) 153 : DO 120 I=1,NBNN 154 : IPT5.NUM(I,J1)=IPT2.NUM(I,J) 155 : 120 CONTINUE 156 : * END DO 157 : * END DO 158 : DO 130 J=1,NOMB3 159 : J1 = J + NOMB1 + NOMB2 160 : IPT5.ICOLOR(J1) = IPT3.ICOLOR(J) 161 : DO 130 I=1,NBNN 162 : IPT5.NUM(I,J1)=IPT3.NUM(I,J) 163 : 130 CONTINUE 164 : * END DO 165 : * END DO 166 : DO 140 J=1,NOMB4 167 : J1 = J + NOMB1 + NOMB2 + NOMB3 168 : IPT5.ICOLOR(J1) = IPT4.ICOLOR(J) 169 : DO 140 I=1,NBNN 170 : IPT5.NUM(I,J1)=IPT4.NUM(I,J) 171 : 140 CONTINUE 172 : * END DO 173 : * END DO 174 : * 175 : SEGDES,IPT5 176 : LETOUR = IPT5 177 : *>>>>> P.M. 04/10/90 178 : *+* SEGSUP,IPT1,IPT2,IPT3,IPT4 179 : SEGDES,IPT1,IPT2,IPT3,IPT4 180 : *<<<<< 181 : * 182 : END 183 : 184 : 185 : 186 :
© Cast3M 2003 - All rights reserved.
Disclaimer