C SURFP4 SOURCE PV 07/11/23 21:19:33 5978 SUBROUTINE SURFP4 (OPERAT,UVARIE,LIGNE1,LIGNE3,msurfp) ************************************************************************ * * S U R F P 4 * ----------- * * FONCTION: * --------- * * CREER 2 COTES OPPOSES D'UNE SURFACE PARAMETREE. * * MODULES UTILISES: * ----------------- * IMPLICIT REAL*8(A-H,O-Z) IMPLICIT INTEGER(I-N) -INC CCOPTIO -INC CCGEOME -INC SMCOORD -INC TMCOURB -INC TMSURFP * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * OPERAT (E) NOM DE L'OPERATEUR COURANT. * UVARIE (E) = .TRUE. SI ON S'OCCUPE DES COTES OU LE PARAMETRE * "U" VARIE (CE QUI EQUIVAUT A "V" CONSTANT). * = .FALSE. SINON. * LIGNE1 (S) POINTEUR DE "MAILLAGE". COTE DE LA SURFACE. * LIGNE3 (S) POINTEUR DE "MAILLAGE". COTE OPPOSE A "LIGNE1". * +MSURFP (E) POINTEUR DE LA SURFACE PARAMETREE. * (S) LAISSE DANS L'ETAT ACTIF. * COMPLETION DU SEGMENT. * +DENSIT (E) VOIR LE COMMUN "CGEOME". * +IDIM (E) VOIR LE COMMUN "COPTIO". * +MCOORD (E) VOIR LE COMMUN "COPTIO". * (S) LE SEGMENT ASSOCIE EST ETENDU (AVEC LES POINTS * INTERIEURS DES COTES OPPOSES). * CHARACTER*4 OPERAT LOGICAL UVARIE INTEGER LIGNE1,LIGNE3 * * VARIABLES: * ---------- * POINTEUR MCOUR1.MCOURB,MCOFC1.MCOFCO * * CONSTANTES: * ----------- * CHARACTER*4 DALL PARAMETER (DALL = 'DALL') * * FONCTIONS: * ---------- * REAL*8 POLYNO * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 6 MARS 1987 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 + EXTENSION: DECLARATION "REAL*8". * ************************************************************************ * SEGACT,MCOORD*MOD SEGACT,MSURFP*MOD MCOFSU = ICOFSU MUVSUR = IUVSUR * * * -- CREATION DU COTE N.1 : U DE U1SUR A U2SUR ; V = V1SUR -- * OU * -- CREATION DU COTE N.2 : U = U2SUR ; V DE V1SUR A V2SUR -- * LONG = 0 SEGINI,MCOURB * NLMCOU = 0 D1COU = DENSIT D2COU = DENSIT LI1COU = 0 LI2COU = 0 REGCOU = REGSUR IF (UVARIE) THEN U1COU = U1SUR U2COU = U2SUR PT1COU = PT1SUR PT2COU = PT2SUR ND1COU = NCOSUR ELSE U1COU = V1SUR U2COU = V2SUR PT1COU = PT2SUR PT2COU = PT3SUR ND1COU = NLISUR END IF * SEGACT,MCOFSU*MOD N = ND1COU SEGINI,MCOFCO ICOFCO = MCOFCO IF (UVARIE) THEN DO 110 IB1=1,IDIM DO 110 IB2=1,N COFCOU(IB2,IB1) & = POLYNO (COFSUR(1,IB2,IB1),NLISUR,1,V1SUR) 110 CONTINUE * END DO * END DO ELSE DO 120 IB1=1,IDIM DO 120 IB2=1,N COFCOU(IB2,IB1) & = POLYNO (COFSUR(IB2,1,IB1),NCOSUR,NLISUR,U2SUR) 120 CONTINUE * END DO * END DO END IF SEGDES,MCOFSU * CALL COURB2 (MCOURB, LIGNE1) IF (IERR .NE. 0) RETURN SEGDES,MCOURB * * -- CREATION DU COTE N.3 : U DE U2SUR A U1SUR ; V = V2SUR -- * OU * -- CREATION DU COTE N.4 : U = U1SUR ; V DE V2SUR A V1SUR -- * LONG = 0 SEGINI,MCOUR1 * MCOUR1.NLMCOU = 0 MCOUR1.D1COU = DENSIT MCOUR1.D2COU = DENSIT MCOUR1.LI1COU = 0 MCOUR1.LI2COU = 0 MCOUR1.REGCOU = REGSUR IF (UVARIE) THEN MCOUR1.U1COU = U2SUR MCOUR1.U2COU = U1SUR MCOUR1.PT1COU = PT3SUR MCOUR1.PT2COU = PT4SUR MCOUR1.ND1COU = NCOSUR ELSE MCOUR1.U1COU = V2SUR MCOUR1.U2COU = V1SUR MCOUR1.PT1COU = PT4SUR MCOUR1.PT2COU = PT1SUR MCOUR1.ND1COU = NLISUR END IF * SEGACT,MCOFSU*MOD N = MCOUR1.ND1COU SEGINI,MCOFC1 MCOUR1.ICOFCO = MCOFC1 IF (UVARIE) THEN DO 130 IB1=1,IDIM DO 130 IB2=1,N MCOFC1.COFCOU(IB2,IB1) & = POLYNO (COFSUR(1,IB2,IB1),NLISUR,1,V2SUR) 130 CONTINUE * END DO * END DO ELSE DO 140 IB1=1,IDIM DO 140 IB2=1,N MCOFC1.COFCOU(IB2,IB1) & = POLYNO (COFSUR(IB2,1,IB1),NCOSUR,NLISUR,U1SUR) 140 CONTINUE * END DO * END DO END IF SEGDES,MCOFSU * CALL COURB2 (MCOUR1, LIGNE3) IF (IERR .NE. 0) RETURN SEGDES,MCOUR1 * IF (OPERAT .EQ. DALL) THEN * LES COTES OPPOSES DOIVENT AVOIR MEME NOMBRE D'ELEMENTS DANS LE * CAS D'UN DALLAGE. * SEGACT,MCOURB*MOD,MCOUR1*MOD NLM = NLMCOU NL1 = MCOUR1.NLMCOU IF (NLM .NE. NL1) THEN IF (NL1.EQ.(NLM-1) .OR. NL1.EQ.(NLM+1) ) THEN SEGDES,MCOURB CALL COURB9 (MCOUR1,LIGNE3) SEGACT,MCOUR1*MOD MCOUR1.NLMCOU = NLM CALL COURB2 (MCOUR1,LIGNE3) IF (IERR .NE. 0) RETURN SEGDES,MCOUR1 ELSE * APPELS "COURB9" EN SENS INVERSE DE L'ORDRE DE CREATION: CALL COURB9 (MCOUR1,LIGNE3) CALL COURB9 (MCOURB,LIGNE1) NLM = (NLM + NL1) / 2 SEGACT,MCOURB*MOD NLMCOU = NLM CALL COURB2 (MCOURB,LIGNE1) IF (IERR .NE. 0) RETURN SEGDES,MCOURB SEGACT,MCOUR1*MOD MCOUR1.NLMCOU = NLM CALL COURB2 (MCOUR1,LIGNE3) IF (IERR .NE. 0) RETURN SEGDES,MCOUR1 END IF ELSE SEGDES,MCOURB,MCOUR1 END IF END IF * SEGSUP,MCOFCO,MCOFC1 * * REMPLISSAGE DE LA TABLE DES COORDONNEES PARAMETRIQUES DU CONTOUR: * SEGACT,MUVSUR*MOD SEGACT,MCOURB*MOD,MCOUR1*MOD LONG0 = USUR(/1) LONG1 = UCOU(/1) LONG3 = MCOUR1.UCOU(/1) LONG = LONG0 + LONG1 + LONG3 SEGADJ,MUVSUR * IF (UVARIE) THEN DO 210 IB=(LONG0+1),(LONG0+LONG1) USUR(IB) = UCOU(IB-LONG0) VSUR(IB) = V1SUR 210 CONTINUE * END DO LONG01 = LONG0 + LONG1 DO 230 IB=(LONG01+1),LONG USUR(IB) = MCOUR1.UCOU(IB-LONG01) VSUR(IB) = V2SUR 230 CONTINUE * END DO ELSE DO 220 IB=(LONG0+1),(LONG0+LONG1) VSUR(IB) = UCOU(IB-LONG0) USUR(IB) = U2SUR 220 CONTINUE * END DO LONG01 = LONG0 + LONG1 DO 240 IB=(LONG01+1),LONG VSUR(IB) = MCOUR1.UCOU(IB-LONG01) USUR(IB) = U1SUR 240 CONTINUE * END DO END IF * SEGDES,MUVSUR SEGSUP,MCOURB,MCOUR1 * END