1 : C CONGE1 SOURCE CHAT 07/10/29 21:16:54 5940 2 : SUBROUTINE CONGE1 (TCONGE,NCONGE,L1,RCONGE,L2, NL1,LRAC,NL2) 3 : ************************************************************************ 4 : * 5 : * C O N G E 1 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * CREER UN CONGE DE RACCORDEMENT ENTRE LE VOISINAGE DE LA FIN D'UNE 12 : * LIGNE ET LE VOISINAGE DU DEBUT D'UNE DEUXIEME LIGNE. 13 : * SONT EGALEMENT CREEES 2 NOUVELLES LIGNES S'APPUYANT SUR LES 14 : * ANCIENNES ET S'ARRETANT AUX EXTREMITES DU CONGE. 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : IMPLICIT INTEGER(I-N) 20 : -INC CCGEOME 21 : -INC CCOPTIO 22 : -INC SMELEME 23 : * 24 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 25 : * ----------- 26 : * 27 : * TCONGE (E) TYPE DU CONGE: SIMPLE OU DOUBLE. 28 : * NCONGE (E) FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS 29 : * CLASSIQUES SUR SON SIGNE. 30 : * = 0 SI NON FOURNI. 31 : * L1 (E) PREMIERE LIGNE A RACCORDER (MAILLAGE). 32 : * RCONGE (E) RAYON DU CONGE DE RACCORDEMENT. 33 : * L2 (E) DEUXIEME LIGNE A RACCORDER (MAILLAGE). 34 : * NL1 (S) LIGNE APPUYEE SUR "L1" ET ABOUTISSANT SUR LE CONGE. 35 : * LRAC (S) CONGE DE RACCORDEMENT. 36 : * NL2 (S) LIGNE APPUYEE SUR "L2" ET COMMENCANT SUR LE CONGE. 37 : * 38 : INTEGER NCONGE,N,ITYPLM 39 : REAL*8 RCONGE 40 : CHARACTER*8 TCONGE 41 : * 42 : * AUTEUR, DATE DE CREATION: 43 : * ------------------------- 44 : * 45 : * LIONEL VIVAN 20 NOVEMBRE 1987 46 : * 47 : * LANGAGE: 48 : * -------- 49 : * 50 : * ESOPE + FORTRAN77 51 : * 52 : ************************************************************************ 53 : * 54 : MELEME=L1 55 : SEGACT,MELEME 56 : N=LISOUS(/1) 57 : IF (N.NE.0) THEN 57 : CALL ERREUR(25) 58 : RETURN 59 : END IF 60 : IF (ILCOUR.EQ.0) THEN 60 : CALL ERREUR(16) 61 : RETURN 62 : END IF 63 : ITYPLM=KDEGRE(ILCOUR) 64 : IF (ITYPEL.NE.ITYPLM) THEN 64 : CALL ECROBJ('MAILLAGE',L1) 64 : CALL PRCHAN 65 : IF (IERR.NE.0) RETURN 65 : CALL LIROBJ('MAILLAGE',L1B,1,IRETOU) 66 : IF (IERR.NE.0) RETURN 67 : ELSE 68 : L1B=L1 69 : END IF 70 : SEGDES,MELEME 71 : * 72 : MELEME=L2 73 : SEGACT,MELEME 74 : N=LISOUS(/1) 75 : IF (N.NE.0) THEN 75 : CALL ERREUR(25) 76 : RETURN 77 : END IF 78 : IF (ILCOUR.EQ.0) THEN 78 : CALL ERREUR(16) 79 : RETURN 80 : END IF 81 : ITYPLM=KDEGRE(ILCOUR) 82 : IF (ITYPEL.NE.ITYPLM) THEN 82 : CALL ECROBJ('MAILLAGE',L2) 82 : CALL PRCHAN 83 : IF (IERR.NE.0) RETURN 83 : CALL LIROBJ('MAILLAGE',L2B,1,IRETOU) 84 : IF (IERR.NE.0) RETURN 85 : ELSE 86 : L2B=L2 87 : END IF 88 : SEGDES,MELEME 89 : * 90 : IF (TCONGE.EQ.'SIMPLE') THEN 90 : CALL CONGE2(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2) 91 : IF (IERR.NE.0) RETURN 92 : ELSE 92 : CALL CONGE3(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2) 93 : IF (IERR.NE.0) RETURN 94 : END IF 95 : * 96 : IF (L1.NE.L1B) THEN 97 : MELEME=L1B 98 : SEGSUP,MELEME 99 : END IF 100 : IF (L2.NE.L2B) THEN 101 : MELEME=L2B 102 : SEGSUP,MELEME 103 : END IF 104 : * 105 : END 106 : 107 : 108 : 109 : 110 : 111 : 112 :
© Cast3M 2003 - All rights reserved.
Disclaimer