1 : C SURFP5 SOURCE PV 07/11/23 21:19:35 5978 2 : SUBROUTINE SURFP5 (FER,XPROJ,NDEB,msurfp) 3 : ************************************************************************ 4 : * 5 : * S U R F P 5 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * HOMOLOGUE DE "PPLAN", "PCYLI" ET CIE, AVEC L'OPTION IOP=1, 12 : * UTILISE DANS LE CAS DU TRAITEMENT D'UNE SURFACE AVEC L'OPTION 13 : * "POLYNOME". 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : IMPLICIT REAL*8(A-H,O-Z) 19 : IMPLICIT INTEGER(I-N) 20 : -INC CCOPTIO 21 : -INC TMSURFP 22 : * 23 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 24 : * ----------- 25 : * 26 : * FER (E) SEGMENT SUPPOSE ACTIF. 27 : * NFI (E) NUMEROS DES NOEUDS DU CONTOUR DE LA SURFACE, DANS 28 : * L'ORDRE SUIVANT: 29 : * 1. NUMEROS DES POINTS-MILIEUX (SI "SEG3"), 30 : * 2. NUMEROS DES POINTS-EXTREMITES DES SEGMENTS DU 31 : * CONTOUR. 32 : * 3. NUMERO DU 1ER POINT-EXTREMITE (FERMETURE DU 33 : * CONTOUR ?). 34 : * (S) LES NUMEROS DES POINTS-EXTREMITES SONT REMPLACES PAR 35 : * LA PLACE DE CES POINTS DANS "XPROJ". 36 : * MAI (E) MAI(1) = NOMBRE DE POINTS-MILIEUX DU CONTOUR. 37 : * MAI(1+ITOUR) = NOMBRE DE POINTS DU CONTOUR. 38 : * ITOUR (E) NOMBRE DE CONTOURS (= 1 ACTUELLEMENT POUR LES 39 : * SURFACES PARAMETREES). 40 : * NDEB (S) NOMBRE DE POINTS DU CONTOUR + 1 . 41 : * XPROJ (S) COORDONNEES PARAMETRIQUES DES POINTS-EXTREMITES DES 42 : * SEGMENTS DU CONTOUR. 43 : * ELLES SONT RANGEES A PARTIR DE LA PLACE "N+1", "N" 44 : * ETANT LE NOMBRE DE POINTS-MILIEUX. 45 : * +MSURFP (E) POINTEUR DE SURFACE PARAMETREE. 46 : * 47 : SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR) 48 : SEGMENT XPROJ(3,IMAX) 49 : * 50 : * VARIABLES: 51 : * ---------- 52 : * 53 : * IMCT = NOMBRE DE NOEUDS DU CONTOUR (1 SEUL CONTOUR POUR UNE 54 : * SURFACE PARAMETREE), POINTS-MILIEUX COMPRIS. 55 : * INCT = PLACE DU 1ER POINT-EXTREMITE DU CONTOUR DANS "NFI". 56 : * 57 : INTEGER IMCT,INCT 58 : * 59 : * AUTEUR, DATE DE CREATION: 60 : * ------------------------- 61 : * 62 : * PASCAL MANIGOT 26 FEVRIER 1987 63 : * 64 : * LANGAGE: 65 : * -------- 66 : * 67 : * ESOPE77 FORTRAN77 68 : * 69 : ************************************************************************ 70 : * 71 : IF (ITOUR .NE. 1) THEN 71 : CALL ERREUR(5) 72 : RETURN 73 : END IF 74 : * 75 : IMCT=MAI(ITOUR+1) 76 : INCT=MAI(1)+1 77 : IMAX=(IMCT**2)+10 78 : * 79 : NDEB=IMCT+1 80 : SEGINI XPROJ 81 : SEGACT,MSURFP*MOD 82 : MUVSUR = IUVSUR 83 : SEGACT,MUVSUR*MOD 84 : * 85 : N0 = NU0SUR 86 : DO 100 I=INCT,max(IMCT,mai(itour+2)) 87 : II=NFI(I) 88 : NFI(I)=I 89 : XPROJ(1,I) = USUR(II-N0) 90 : XPROJ(2,I) = VSUR(II-N0) 91 : 100 CONTINUE 92 : * END DO 93 : * 94 : * CALCUL DES DENSITES GRACE AUX DISTANCES AVEC LES VOISINS: 95 : * (NE FONCTIONNE PAS DU TOUT AVEC PLUSIEURS CONTOURS) 96 : * 97 : IF (INCT .LE. IMCT) THEN 98 : D3 = (XPROJ(1,IMCT) - XPROJ(1,INCT) )**2 99 : & + (XPROJ(2,IMCT) - XPROJ(2,INCT) )**2 100 : D3 = SQRT(D3) 101 : DO 110 I=INCT,IMCT 102 : IF (I .EQ. IMCT) THEN 103 : I3 = INCT 104 : ELSE 105 : I3 = I + 1 106 : END IF 107 : D1 = D3 108 : D3 = (XPROJ(1,I3) - XPROJ(1,I) )**2 109 : & + (XPROJ(2,I3) - XPROJ(2,I) )**2 110 : D3 = SQRT(D3) 111 : XPROJ(3,I) = (D1 + D3) / 2. 112 : 110 CONTINUE 113 : * END DO 114 : END IF 115 : * 116 : IF (IIMPI.EQ.1804) THEN 117 : DO 120 I=INCT,IMCT 118 : WRITE(IOIMP,'(I5,3(2X,G12.5))')I,XPROJ(1,I),XPROJ(2,I), 119 : & XPROJ(3,I) 120 : 120 CONTINUE 121 : * END DO 122 : END IF 123 : * 124 : SEGDES,MUVSUR,MSURFP 125 : * 126 : END 127 : 128 : 129 : 130 :
© Cast3M 2003 - All rights reserved.
Disclaimer