Télécharger conge1.eso

Retour à la liste

Numérotation des lignes :

  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. -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
  58. CALL ERREUR(25)
  59. RETURN
  60. END IF
  61. IF (ILCOUR.EQ.0) THEN
  62. CALL ERREUR(16)
  63. RETURN
  64. END IF
  65. ITYPLM=KDEGRE(ILCOUR)
  66. IF (ITYPEL.NE.ITYPLM) THEN
  67. CALL ECROBJ('MAILLAGE',L1)
  68. CALL PRCHAN
  69. IF (IERR.NE.0) RETURN
  70. CALL LIROBJ('MAILLAGE',L1B,1,IRETOU)
  71. IF (IERR.NE.0) RETURN
  72. ELSE
  73. L1B=L1
  74. END IF
  75. SEGDES,MELEME
  76. *
  77. MELEME=L2
  78. SEGACT,MELEME
  79. N=LISOUS(/1)
  80. IF (N.NE.0) THEN
  81. CALL ERREUR(25)
  82. RETURN
  83. END IF
  84. IF (ILCOUR.EQ.0) THEN
  85. CALL ERREUR(16)
  86. RETURN
  87. END IF
  88. ITYPLM=KDEGRE(ILCOUR)
  89. IF (ITYPEL.NE.ITYPLM) THEN
  90. CALL ECROBJ('MAILLAGE',L2)
  91. CALL PRCHAN
  92. IF (IERR.NE.0) RETURN
  93. CALL LIROBJ('MAILLAGE',L2B,1,IRETOU)
  94. IF (IERR.NE.0) RETURN
  95. ELSE
  96. L2B=L2
  97. END IF
  98. SEGDES,MELEME
  99. *
  100. IF (TCONGE.EQ.'SIMPLE') THEN
  101. CALL CONGE2(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2)
  102. IF (IERR.NE.0) RETURN
  103. ELSE
  104. CALL CONGE3(L1B,L2B,RCONGE,NCONGE,NL1,LRAC,NL2)
  105. IF (IERR.NE.0) RETURN
  106. END IF
  107. *
  108. IF (L1.NE.L1B) THEN
  109. MELEME=L1B
  110. SEGSUP,MELEME
  111. END IF
  112. IF (L2.NE.L2B) THEN
  113. MELEME=L2B
  114. SEGSUP,MELEME
  115. END IF
  116. *
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  

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