Télécharger la plaquette Cast3M


fr en

Télécharger deco.eso

Retour à la liste

Numérotation des lignes : 

deco

  1. C DECO      SOURCE    PV        20/09/12    21:15:07     10711          
  2.       SUBROUTINE DECO
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *                     Op?rateur DEnsite de COurant                   *
  8. *                     ____________________________                   *
  9. *                                                                    *
  10. *     Calcul de la densite de courant de Foucault                    *
  11. *                                                                    *
  12. * Syntaxe n?1:  DNS1 = DECO MOD1 DEP1 ( CAR1 ) ;                    *
  13. *                                                                    *
  14. *     Entr{es:                                                       *
  15. *                                                                    *
  16. *        MOD1      objet MMODEL                                      *
  17. *        DEP1      CHPOINT (FONCTION DE COURANT)                     *
  18. *        CAR1      MCHAML de sous-type CARACTERISTIQUES              *
  19. *                                                                    *
  20. *     Sortie:                                                        *
  21. *                                                                    *
  22. *        DNS1      MCHAML de sous-type GRADIENT                      *
  23. *                                                                    *
  24. *                                                                    *
  25. *      Auteurs, date de cr{ation:                                    *
  26. *                                                                    *
  27. *                                                                    *
  28. *        Y. STEPHAN le 22/09/97 (copie de GRAD)                      *
  29. *--------------------------------------------------------------------*
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCHAMP
  34. -INC SMCOORD
  35. *
  36. *     NINFOS est le nombre d'informations contenues dans INFELE
  37. *     ( VOIR LE S-P ELQUOI )
  38. *
  39. *      PARAMETER ( NINFOS=15 )
  40. *
  41. * MC 19/01/98 : Fonction indisponible en d?fo planes g?n?ralis?es
  42.       IF(IFOUR.EQ.-3) THEN
  43.          CALL ERREUR(710)
  44.          RETURN
  45.       ENDIF
  46.       segact mcoord
  47. *
  48.       IPCHL1=0
  49.       IPCHE1=0
  50.       IRET1 =0
  51.       IRET3 =0
  52. *
  53. *
  54. *     LECTURE D'UN MMODEL
  55. *
  56.       CALL LIROBJ('MMODEL  ',IPMODL,1,IRET)
  57.       CALL ACTOBJ('MMODEL  ',IPMODL,1)
  58.       IF (IERR.NE.0) RETURN
  59. *
  60.       IF (IRET.NE.0) THEN
  61. *
  62. *       1-ERE SYNTAXE
  63. *       _____________
  64. *
  65. *
  66. *       LECTURE D'UN CHPOINT
  67. *
  68.         CALL LIROBJ('CHPOINT ',IPCHP1,0,IRET1)
  69.         IF(IERR.NE.0) RETURN
  70.         IF (IRET1.NE.0) THEN
  71.         CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  72. *
  73. *    CHPOINT  ---> CHAMELEM AUX NOEUDS
  74. *
  75.            CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE2,1)
  76.            IF (IERR.NE.0) RETURN
  77.         ENDIF
  78. *
  79. *     LECTURE D'UN  MCHAML (CARACTERISTIQUE)
  80. *
  81.         CALL LIROBJ('MCHAML  ',IPIN,0,IRET3)
  82.         IF (IERR.NE.0) RETURN
  83.         IPCHE1 = 0
  84.         IF (IRET3 .EQ. 1) THEN
  85.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  86.           CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  87.           IF(IR   .NE. 1) CALL ERREUR(KER)
  88.           IF(IERR .NE. 0) RETURN
  89.         ENDIF
  90. *
  91.       ENDIF
  92. *
  93. *     GESTION DES OP{RANDES
  94. *     IPCHL1 = 0 (MCHAML calcule)
  95. *
  96.       CALL DECO1(IPMODL,IPCHE2,IPCHE1,IPCHL1,IRET)
  97. *
  98.       IF (IRET.EQ.1) THEN
  99.         CALL ACTOBJ('MCHAML  ',IPCHL1,1)
  100.         CALL ECROBJ('MCHAML  ',IPCHL1)
  101.       ENDIF
  102.       END
  103.  
  104.  
  105.  
  106.  
  107.  

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