C CONGE SOURCE PV 22/04/27 21:15:02 11344 SUBROUTINE CONGE ************************************************************************ * * C O N G E * --------- * * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "CONGE" * * FONCTION: * --------- * * CREER UN CONGE DE RACCORDEMENT ENTRE 2 LIGNES. * * C'EST LE VOISINAGE DE LA FIN DE LA PREMIERE LIGNE QUI EST * RACCORDE AU VOISINAGE DU DEBUT DE LA DEUXIEME LIGNE. * DANS CES VOISINAGES, LES LIGNES DOIVENT ETRE COPLANAIRES. * * PHRASE D'APPEL (EN GIBIANE): * ---------------------------- * * NL1 RAC NL2 = CONGE (N) L1 R L2 (DOUBLE) ; * * OPERANDES ET RESULTATS: * ----------------------- * * N 'ENTIER ' NOMBRE D'ELEMENTS A CREER SUR LE CONGE. * LA TAILLE DES ELEMENTS TIENDRA COMPTE DES * DENSITES DES EXTREMITES SI "N" EST NEGATIF. * L1 'MAILLAGE' LIGNE A RACCORDER EN QUEUE. * R 'FLOTTANT' RAYON DE RACCORDEMENT. * L2 'MAILLAGE' LIGNE A RACCORDER EN TETE. * NL1 'MAILLAGE' LIGNE S'APPUYANT SUR "L1" ET S'ARRETANT A * UNE EXTREMITE DU CONGE. * NL2 'MAILLAGE' LIGNE S'APPUYANT SUR "L2" ET S'ARRETANT A * L'AUTRE EXTREMITE DU CONGE. * LRAC 'MAILLAGE' CONGE DE RACCORDEMENT CREE. * * MODULES UTILISES: * ----------------- * IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC CCREEL * * VARIABLES: * ---------- * * RCONGE = RAYON DU CONGE DE RACCORDEMENT. * TCONGE = TYPE DE CONGE ('SIMPLE' OU 'DOUBLE'). * REAL*8 RCONGE CHARACTER*8 TCONGE * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 19 NOVEMBRE 1987 * * LANGAGE: * -------- * * FORTRAN77 + EXTENSION: DECLARATION "REAL*8". * ************************************************************************ * tconge=' ' * LECTURE DU TYPE DU CONGE: CALL LIRCHA (TCONGE,0,IRETOU) IF (IRETOU .EQ. 0) THEN TCONGE = 'SIMPLE' ELSE IF (TCONGE(1:4).NE.'DOUB') THEN TCONGE = 'SIMPLE' CALL REFUS END IF * * FACTEUR DE DECOUPAGE: CALL LIRENT (NCONGE,0,IRETOU) IF (IRETOU .EQ. 0) THEN NCONGE = 0 END IF * * LECTURE DU RAYON DE RACCORDEMENT: CALL LIRE04 (XPETIT,RCONGE,0,1,IRETOU) IF (IERR .NE. 0) RETURN * * LECTURE DES LIGNES A RACCORDER: CALL LIROBJ ('MAILLAGE',L1,1,IRETOU) IF (IERR .NE. 0) RETURN CALL LIROBJ ('MAILLAGE',L2,1,IRETOU) IF (IERR .NE. 0) RETURN * * DEFINITION DU CONGE: CALL CONGE1 (TCONGE,NCONGE,L1,RCONGE,L2, NL1,LRAC,NL2) IF (IERR .NE. 0) RETURN * CALL ECROBJ ('MAILLAGE',NL2) CALL ECROBJ ('MAILLAGE',LRAC) CALL ECROBJ ('MAILLAGE',NL1) * END