Télécharger la plaquette Cast3M


fr en

Télécharger cfl.eso

Retour à la liste

Numérotation des lignes : 

cfl

  1. C CFL       SOURCE    CB215821  19/08/01    21:15:09     10279          
  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.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.  
  18.       CHARACTER*4 MOTCLE(2)
  19.       DATA MOTCLE /'CSON','TAIL'/
  20. *
  21.       IRET   = 0
  22.       IRET1  = 0
  23.       IRET2  = 0
  24.       IRET3  = 0
  25.       IPCHA1 = 0
  26.       IPCHA2 = 0
  27.       IPCHA3 = 0
  28. *
  29.       CALL LIROBJ('MMODEL  ',IPMODL,1,IRET)
  30.       CALL ACTOBJ('MMODEL  ',IPMODL,1)
  31.       IF (IRET.EQ.0) RETURN
  32. c
  33. *
  34. *  determination des trois option
  35. *
  36.       CALL LIRMOT(MOTCLE,2,IVAL,0)
  37.       IF (IVAL .EQ. 0 ) THEN
  38. *      cas du calcul global
  39.           ICAS = 1
  40.           CALL LIROBJ('MCHAML  ',IPIN,1,IRET1)
  41.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  42.           IF (IRET1.EQ.0) RETURN
  43.           CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  44.           IF(IR   .NE. 1) CALL ERREUR(KER)
  45.           IF(IERR .NE. 0) RETURN
  46. *
  47.       ELSE IF (IVAL .EQ. 1 ) THEN
  48. *       cas ou la vitesse du son est fournie
  49.           ICAS = 2
  50. *
  51.           CALL LIROBJ('MCHAML  ',IPIN,1,IRET1)
  52.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  53.           IF (IRET1.EQ.0) RETURN
  54.           CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  55.           IF(IR   .NE. 1) CALL ERREUR(KER)
  56.           IF(IERR .NE. 0) RETURN
  57. *
  58.           CALL LIROBJ('MCHAML  ',IPIN,0,IRET2)
  59. *         si les caractéristiques ne sont pas fournies
  60. *         la taille l'est
  61.           IF ( IRET2 .EQ. 0) THEN
  62.             IPCHA2 = IPCHA1
  63.           ELSE
  64.             CALL ACTOBJ('MCHAML  ',IPIN,1)
  65.             CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  66.             IF(IR   .NE. 1) CALL ERREUR(KER)
  67.             IF(IERR .NE. 0) RETURN
  68.           ENDIF
  69.  
  70.       ELSE IF (IVAL .EQ. 2 ) THEN
  71.           ICAS = 3
  72. *          champ de caractéristiques
  73.           CALL LIROBJ('MCHAML  ',IPIN,1,IRET1)
  74.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  75.           IF (IRET1.EQ.0) RETURN
  76.           CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  77.           IF(IR   .NE. 1) CALL ERREUR(KER)
  78.           IF(IERR .NE. 0) RETURN
  79.  
  80.           CALL LIROBJ('MCHAML  ',IPIN,1,IRET3)
  81.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  82.           IF (IRET3.EQ.0) RETURN
  83.           CALL REDUAF(IPIN,IPMODL,IPCHA3,0,IR,KER)
  84.           IF(IR   .NE. 1) CALL ERREUR(KER)
  85.           IF(IERR .NE. 0) RETURN
  86.       ENDIF
  87. *
  88. *  ipcha1 champ de caractéristiques
  89. *  ipcha2 champ de vitesse du son composante 'cson'
  90. *  ipcha3 champ de taille du maillage composante 'l' ( et 'l2h' facultatif)
  91. *
  92.       CALL CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS)
  93. *
  94. *  en retour on récupère le champ par élément de composante 'tcfl'
  95. *
  96.       IF ( IPCHA4 .EQ. 0) RETURN
  97. *
  98.       CALL ACTOBJ('MCHAML  ',IPCHA4,1)
  99.       CALL ECROBJ('MCHAML  ',IPCHA4)
  100.       END
  101.  
  102.  
  103.  

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