Sources Esope | Cast3M

conge1
C CONGE1    SOURCE    BP208322  16/11/18    21:15:53     9177           
      SUBROUTINE CONGE1 (TCONGE,NCONGE,L1,RCONGE,L2,  NL1,LRAC,NL2)
************************************************************************
*
*                             C O N G E 1
*                             -----------
*
* FONCTION:
* ---------
*
*     CREER UN CONGE DE RACCORDEMENT ENTRE LE VOISINAGE DE LA FIN D'UNE
*     LIGNE ET LE VOISINAGE DU DEBUT D'UNE DEUXIEME LIGNE.
*     SONT EGALEMENT CREEES 2 NOUVELLES LIGNES S'APPUYANT SUR LES
*     ANCIENNES ET S'ARRETANT AUX EXTREMITES DU CONGE.
*
* MODULES UTILISES:
* -----------------
*
      IMPLICIT INTEGER(I-N)
-INC CCGEOME
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     TCONGE  (E)  TYPE DU CONGE: SIMPLE OU DOUBLE.
*     NCONGE  (E)  FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS
*                  CLASSIQUES SUR SON SIGNE.
*                  = 0  SI NON FOURNI.
*     L1      (E)  PREMIERE LIGNE A RACCORDER (MAILLAGE).
*     RCONGE  (E)  RAYON DU CONGE DE RACCORDEMENT.
*     L2      (E)  DEUXIEME LIGNE A RACCORDER (MAILLAGE).
*     NL1     (S)  LIGNE APPUYEE SUR "L1" ET ABOUTISSANT SUR LE CONGE.
*     LRAC    (S)  CONGE DE RACCORDEMENT.
*     NL2     (S)  LIGNE APPUYEE SUR "L2" ET COMMENCANT SUR LE CONGE.
*
      INTEGER NCONGE,N,ITYPLM
      REAL*8 RCONGE
      CHARACTER*8 TCONGE
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     LIONEL VIVAN       20 NOVEMBRE 1987
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
      MELEME=L1
      SEGACT,MELEME
      N=LISOUS(/1)
      IF (N.NE.0) THEN
         CALL ERREUR(25)
         RETURN
      END IF
      IF (ILCOUR.EQ.0) THEN
         CALL ERREUR(16)
         RETURN
      END IF
      ITYPLM=KDEGRE(ILCOUR)
      IF (ITYPEL.NE.ITYPLM) THEN
         CALL ECROBJ('MAILLAGE',L1)
         CALL PRCHAN
         IF (IERR.NE.0) RETURN
         CALL LIROBJ('MAILLAGE',L1B,1,IRETOU)
         IF (IERR.NE.0) RETURN
      ELSE
         L1B=L1
      END IF
      SEGDES,MELEME
*
      MELEME=L2
      SEGACT,MELEME
      N=LISOUS(/1)
      IF (N.NE.0) THEN
         CALL ERREUR(25)
         RETURN
      END IF
      IF (ILCOUR.EQ.0) THEN
         CALL ERREUR(16)
         RETURN
      END IF
      ITYPLM=KDEGRE(ILCOUR)
      IF (ITYPEL.NE.ITYPLM) THEN
         CALL ECROBJ('MAILLAGE',L2)
         CALL PRCHAN
         IF (IERR.NE.0) RETURN
         CALL LIROBJ('MAILLAGE',L2B,1,IRETOU)
         IF (IERR.NE.0) RETURN
      ELSE
         L2B=L2
      END IF
      SEGDES,MELEME
*
      IF (TCONGE.EQ.'SIMPLE') THEN
         CALL CONGE2(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2)
         IF (IERR.NE.0) RETURN
      ELSE
         CALL CONGE3(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2)
         IF (IERR.NE.0) RETURN
      END IF
*
      IF (L1.NE.L1B) THEN
         MELEME=L1B
         SEGSUP,MELEME
      END IF
      IF (L2.NE.L2B) THEN
         MELEME=L2B
         SEGSUP,MELEME
      END IF
*
      END