Télécharger deco.eso

Retour à la liste

Numérotation des lignes :

  1. C DECO SOURCE CB215821 19/07/30 21:15:48 10273
  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. -INC CCOPTIO
  31. -INC CCHAMP
  32. *
  33. * NINFOS est le nombre d'informations contenues dans INFELE
  34. * ( VOIR LE S-P ELQUOI )
  35. *
  36. * PARAMETER ( NINFOS=15 )
  37. *
  38. * MC 19/01/98 : Fonction indisponible en d?fo planes g?n?ralis?es
  39. IF(IFOUR.EQ.-3) THEN
  40. CALL ERREUR(710)
  41. RETURN
  42. ENDIF
  43. *
  44. IPCHL1=0
  45. IPCHE1=0
  46. IRET1 =0
  47. IRET3 =0
  48. *
  49. *
  50. * LECTURE D'UN MMODEL
  51. *
  52. CALL LIROBJ('MMODEL ',IPMODL,1,IRET)
  53. CALL ACTOBJ('MMODEL ',IPMODL,1)
  54. IF (IERR.NE.0) RETURN
  55. *
  56. IF (IRET.NE.0) THEN
  57. *
  58. * 1-ERE SYNTAXE
  59. * _____________
  60. *
  61. *
  62. * LECTURE D'UN CHPOINT
  63. *
  64. CALL LIROBJ('CHPOINT ',IPCHP1,0,IRET1)
  65. IF(IERR.NE.0) RETURN
  66. IF (IRET1.NE.0) THEN
  67. CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  68. *
  69. * CHPOINT ---> CHAMELEM AUX NOEUDS
  70. *
  71. CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE2,1)
  72. IF (IERR.NE.0) RETURN
  73. ENDIF
  74. *
  75. * LECTURE D'UN MCHAML (CARACTERISTIQUE)
  76. *
  77. CALL LIROBJ('MCHAML ',IPIN,0,IRET3)
  78. IF (IERR.NE.0) RETURN
  79. IPCHE1 = 0
  80. IF (IRET3 .EQ. 1) THEN
  81. CALL ACTOBJ('MCHAML ',IPIN,1)
  82. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  83. IF(IR .NE. 1) CALL ERREUR(KER)
  84. IF(IERR .NE. 0) RETURN
  85. ENDIF
  86. *
  87. ENDIF
  88. *
  89. * GESTION DES OP{RANDES
  90. * IPCHL1 = 0 (MCHAML calcule)
  91. *
  92. CALL DECO1(IPMODL,IPCHE2,IPCHE1,IPCHL1,IRET)
  93. *
  94. IF (IRET.EQ.1) THEN
  95. IF (IRET1.NE.0) CALL DTCHAM(IPCHE2)
  96. CALL ACTOBJ('MCHAML ',IPCHL1,1)
  97. CALL ECROBJ('MCHAML ',IPCHL1)
  98. ENDIF
  99. END
  100.  
  101.  
  102.  

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