Télécharger conge1.eso

Retour à la liste

Numérotation des lignes :

conge1
  1. C CONGE1 SOURCE BP208322 16/11/18 21:15:53 9177
  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.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC SMELEME
  25. *
  26. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  27. * -----------
  28. *
  29. * TCONGE (E) TYPE DU CONGE: SIMPLE OU DOUBLE.
  30. * NCONGE (E) FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS
  31. * CLASSIQUES SUR SON SIGNE.
  32. * = 0 SI NON FOURNI.
  33. * L1 (E) PREMIERE LIGNE A RACCORDER (MAILLAGE).
  34. * RCONGE (E) RAYON DU CONGE DE RACCORDEMENT.
  35. * L2 (E) DEUXIEME LIGNE A RACCORDER (MAILLAGE).
  36. * NL1 (S) LIGNE APPUYEE SUR "L1" ET ABOUTISSANT SUR LE CONGE.
  37. * LRAC (S) CONGE DE RACCORDEMENT.
  38. * NL2 (S) LIGNE APPUYEE SUR "L2" ET COMMENCANT SUR LE CONGE.
  39. *
  40. INTEGER NCONGE,N,ITYPLM
  41. REAL*8 RCONGE
  42. CHARACTER*8 TCONGE
  43. *
  44. * AUTEUR, DATE DE CREATION:
  45. * -------------------------
  46. *
  47. * LIONEL VIVAN 20 NOVEMBRE 1987
  48. *
  49. * LANGAGE:
  50. * --------
  51. *
  52. * ESOPE + FORTRAN77
  53. *
  54. ************************************************************************
  55. *
  56. MELEME=L1
  57. SEGACT,MELEME
  58. N=LISOUS(/1)
  59. IF (N.NE.0) THEN
  60. CALL ERREUR(25)
  61. RETURN
  62. END IF
  63. IF (ILCOUR.EQ.0) THEN
  64. CALL ERREUR(16)
  65. RETURN
  66. END IF
  67. ITYPLM=KDEGRE(ILCOUR)
  68. IF (ITYPEL.NE.ITYPLM) THEN
  69. CALL ECROBJ('MAILLAGE',L1)
  70. CALL PRCHAN
  71. IF (IERR.NE.0) RETURN
  72. CALL LIROBJ('MAILLAGE',L1B,1,IRETOU)
  73. IF (IERR.NE.0) RETURN
  74. ELSE
  75. L1B=L1
  76. END IF
  77. SEGDES,MELEME
  78. *
  79. MELEME=L2
  80. SEGACT,MELEME
  81. N=LISOUS(/1)
  82. IF (N.NE.0) THEN
  83. CALL ERREUR(25)
  84. RETURN
  85. END IF
  86. IF (ILCOUR.EQ.0) THEN
  87. CALL ERREUR(16)
  88. RETURN
  89. END IF
  90. ITYPLM=KDEGRE(ILCOUR)
  91. IF (ITYPEL.NE.ITYPLM) THEN
  92. CALL ECROBJ('MAILLAGE',L2)
  93. CALL PRCHAN
  94. IF (IERR.NE.0) RETURN
  95. CALL LIROBJ('MAILLAGE',L2B,1,IRETOU)
  96. IF (IERR.NE.0) RETURN
  97. ELSE
  98. L2B=L2
  99. END IF
  100. SEGDES,MELEME
  101. *
  102. IF (TCONGE.EQ.'SIMPLE') THEN
  103. CALL CONGE2(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2)
  104. IF (IERR.NE.0) RETURN
  105. ELSE
  106. CALL CONGE3(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2)
  107. IF (IERR.NE.0) RETURN
  108. END IF
  109. *
  110. IF (L1.NE.L1B) THEN
  111. MELEME=L1B
  112. SEGSUP,MELEME
  113. END IF
  114. IF (L2.NE.L2B) THEN
  115. MELEME=L2B
  116. SEGSUP,MELEME
  117. END IF
  118. *
  119. END
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales