1 : C SURFP2 SOURCE PV 07/11/23 21:19:29 5978 2 : SUBROUTINE SURFP2 (OPERAT,LIGNE1,LIGNE2,LIGNE3,LIGNE4,msurfp) 3 : ************************************************************************ 4 : * 5 : * S U R F P 2 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * CREER LES 4 COTES D'UNE SURFACE PARAMETREE. 12 : * 13 : * MODULES UTILISES: 14 : * ----------------- 15 : * 16 : IMPLICIT REAL*8(A-H,O-Z) 17 : IMPLICIT INTEGER(I-N) 18 : -INC CCOPTIO 19 : -INC SMCOORD 20 : -INC TMSURFP 21 : * 22 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 23 : * ----------- 24 : * 25 : * OPERAT (E) NOM DE L'OPERATEUR COURANT. 26 : * LIGNE1 (S) POINTEUR DE "MAILLAGE". COTE N.1 DE LA SURFACE. 27 : * LIGNE2 (S) POINTEUR DE "MAILLAGE". COTE N.2 DE LA SURFACE. 28 : * LIGNE3 (S) POINTEUR DE "MAILLAGE". COTE N.3 DE LA SURFACE. 29 : * LIGNE4 (S) POINTEUR DE "MAILLAGE". COTE N.4 DE LA SURFACE. 30 : * +MSURFP (E) POINTEUR DE LA SURFACE PARAMETREE. 31 : * (S) LAISSE DANS L'ETAT ACTIF. 32 : * COMPLETION DU SEGMENT. 33 : * +IDIM (E) VOIR LE COMMUN "COPTIO". 34 : * +MCOORD (E) VOIR LE COMMUN "COPTIO". 35 : * (S) LE SEGMENT ASSOCIE EST ETENDU (AVEC TOUS LES POINTS 36 : * DU CONTOUR DE LA SURFACE). 37 : * 38 : INTEGER LIGNE1,LIGNE2,LIGNE3,LIGNE4 39 : CHARACTER*4 OPERAT 40 : * 41 : * VARIABLES: 42 : * ---------- 43 : * 44 : INTEGER PT0 45 : REAL*8 U0,V0 46 : * 47 : * CONSTANTES: 48 : * ----------- 49 : * 50 : REAL*8 ZERO8 51 : PARAMETER (ZERO8 = 0.D0) 52 : * 53 : * AUTEUR, DATE DE CREATION: 54 : * ------------------------- 55 : * 56 : * PASCAL MANIGOT 3 MARS 1987 57 : * 58 : * LANGAGE: 59 : * -------- 60 : * 61 : * ESOPE77 FORTRAN77 62 : * 63 : ************************************************************************ 64 : * 65 : SEGACT,MCOORD*MOD 66 : * 67 : SEGACT,MSURFP*MOD 68 : MCOFSU = ICOFSU 69 : * 70 : * -- CREATION DES 4 SOMMETS DE LA SURFACE -- 71 : * 72 : NBPTA = XCOOR(/1) / (IDIM+1) 73 : NBPTS = NBPTA + 4 74 : SEGADJ,MCOORD 75 : LONG = 4 76 : SEGINI,MUVSUR 77 : IUVSUR = MUVSUR 78 : NU0SUR = NBPTA 79 : * ACTIVATION POUR SURFP9: 80 : SEGACT,MCOFSU*MOD 81 : * 82 : PT0 = NBPTA + 1 83 : U0 = U1SUR 84 : V0 = V1SUR 84 : CALL SURFP9 (PT0,U0,V0,ZERO8,msurfp) 85 : PT1SUR = PT0 86 : USUR(1) = U0 87 : VSUR(1) = V0 88 : * 89 : PT0 = NBPTA + 2 90 : U0 = U2SUR 91 : V0 = V1SUR 91 : CALL SURFP9 (PT0,U0,V0,ZERO8,msurfp) 92 : PT2SUR = PT0 93 : USUR(2) = U0 94 : VSUR(2) = V0 95 : * 96 : PT0 = NBPTA + 3 97 : U0 = U2SUR 98 : V0 = V2SUR 98 : CALL SURFP9 (PT0,U0,V0,ZERO8,msurfp) 99 : PT3SUR = PT0 100 : USUR(3) = U0 101 : VSUR(3) = V0 102 : * 103 : PT0 = NBPTA + 4 104 : U0 = U1SUR 105 : V0 = V2SUR 105 : CALL SURFP9 (PT0,U0,V0,ZERO8,msurfp) 106 : PT4SUR = PT0 107 : USUR(4) = U0 108 : VSUR(4) = V0 109 : * 110 : SEGDES,MCOFSU 111 : SEGDES,MUVSUR 112 : * 113 : * -- CREATION DES COTES -- 114 : * 114 : CALL SURFP4 (OPERAT,.TRUE.,LIGNE1,LIGNE3,msurfp) 114 : * call ecmail ( ligne1 , 0) 114 : * call ecmail(ligne3,0) 115 : IF (IERR .NE. 0) RETURN 115 : CALL SURFP4 (OPERAT,.FALSE.,LIGNE2,LIGNE4,msurfp) 115 : * call ecmail ( ligne2 , 0) 115 : * call ecmail(ligne3,0) 116 : IF (IERR .NE. 0) RETURN 117 : * 118 : END 119 : 120 : 121 : 122 :
© Cast3M 2003 - All rights reserved.
Disclaimer