Télécharger cfl.eso

Retour à la liste

Numérotation des lignes :

  1. C CFL SOURCE CB215821 16/12/05 21:15:07 9237
  2. SUBROUTINE CFL
  3. *-----------------------------------------------------------------------
  4. *
  5. * chapeau de l'opérateur cfl
  6. *
  7. * appelle la routine clf1.eso qui est aussi appelé par taille et cson
  8. *
  9. *-----------------------------------------------------------------------
  10. *
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC CCOPTIO
  15.  
  16. CHARACTER*4 MOTCLE(2)
  17. DATA MOTCLE /'CSON','TAIL'/
  18. *
  19. IRET = 0
  20. IRET1 = 0
  21. IRET2 = 0
  22. IRET3 = 0
  23. IPCHA1 = 0
  24. IPCHA2 = 0
  25. IPCHA3 = 0
  26. *
  27. CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  28. IF (IRET.EQ.0) RETURN
  29. c
  30. *
  31. * determination des trois option
  32. *
  33. CALL LIRMOT(MOTCLE,2,IVAL,0)
  34. IF (IVAL .EQ. 0 ) THEN
  35. * cas du calcul global
  36. ICAS = 1
  37. CALL LIROBJ('MCHAML',IPIN,1,IRET1)
  38. IF (IRET1.EQ.0) RETURN
  39. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  40. IF(IR .NE. 1) CALL ERREUR(KER)
  41. IF(IERR .NE. 0) RETURN
  42. *
  43. ELSE IF (IVAL .EQ. 1 ) THEN
  44. * cas ou la vitesse du son est fournie
  45. ICAS = 2
  46. *
  47. CALL LIROBJ('MCHAML',IPIN,1,IRET1)
  48. IF (IRET1.EQ.0) RETURN
  49. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  50. IF(IR .NE. 1) CALL ERREUR(KER)
  51. IF(IERR .NE. 0) RETURN
  52. *
  53. CALL LIROBJ('MCHAML',IPIN,0,IRET2)
  54. * si les caractéristiques ne sont pas fournies
  55. * la taille l'est
  56. IF ( IRET2 .EQ. 0) THEN
  57. IPCHA2 = IPCHA1
  58. ELSE
  59. CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  60. IF(IR .NE. 1) CALL ERREUR(KER)
  61. IF(IERR .NE. 0) RETURN
  62. ENDIF
  63.  
  64. ELSE IF (IVAL .EQ. 2 ) THEN
  65. ICAS = 3
  66. * champ de caractéristiques
  67. CALL LIROBJ('MCHAML',IPIN,1,IRET1)
  68. IF (IRET1.EQ.0) RETURN
  69. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  70. IF(IR .NE. 1) CALL ERREUR(KER)
  71. IF(IERR .NE. 0) RETURN
  72.  
  73. CALL LIROBJ('MCHAML',IPIN,1,IRET3)
  74. IF (IRET3.EQ.0) RETURN
  75. CALL REDUAF(IPIN,IPMODL,IPCHA3,0,IR,KER)
  76. IF(IR .NE. 1) CALL ERREUR(KER)
  77. IF(IERR .NE. 0) RETURN
  78. ENDIF
  79. *
  80. * ipcha1 champ de caractéristiques
  81. * ipcha2 champ de vitesse du son composante 'cson'
  82. * ipcha3 champ de taille du maillage composante 'l' ( et 'l2h' facultatif)
  83. *
  84. CALL CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS)
  85. *
  86. * en retour on récupère le champ par élément de composante 'tcfl'
  87. *
  88. IF ( IPCHA4 .EQ. 0) RETURN
  89. *
  90. CALL ECROBJ('MCHAML',IPCHA4)
  91. RETURN
  92. END
  93.  
  94.  
  95.  

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