Télécharger pridua.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIDUA SOURCE JC220346 16/04/25 21:15:17 8915
  2. SUBROUTINE PRIDUA(ICHP1,ICOD1,IPOS1)
  3. ************************************************************************
  4. * NOM : PRIDUA
  5. * DESCRIPTION : Indique si un champ est primal ou dual
  6. ************************************************************************
  7. * APPELE PAR : pjblch.eso
  8. ************************************************************************
  9. * ENTREES : ICHP1 = pointeur vers le CHPOINT
  10. * SORTIES : ICOD1 = 0 si le CHPOINT est vide ou si toutes les
  11. * composantes sont a la fois primales et duales
  12. * (i.e. elles sont dans NOMDD et aussi dans NOMDU)
  13. * = 1 s'il n'y a que des primales
  14. * = 2 s'il n'y a que des duales
  15. * = -1 s'il y a a la fois des primales et des duales
  16. * IPOS1 contient la position dans NOMDD si ICOD1 vaut 0 ou 1,
  17. * dans NOMDU si ICOD1 vaut 0 ou 2
  18. * (vaut 0 si ICOD1 vaut -1)
  19. ************************************************************************
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8 (A-H,O-Z)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMCHPOI
  26. -INC SMLENTI
  27. -INC CCHAMP
  28. CHARACTER*4 CHA4
  29. *
  30. ICOTY1=0
  31. *
  32. JG=LNOMDD
  33. SEGINI,MLENTI
  34. JG=0
  35. *
  36. MCHPO1=ICHP1
  37. SEGACT,MCHPO1
  38. *
  39. NSOUP1=MCHPO1.IPCHP(/1)
  40. DO J1=1,NSOUP1
  41. MSOUP1=MCHPO1.IPCHP(J1)
  42. SEGACT,MSOUP1
  43. *
  44. NCO1=MSOUP1.NOCOMP(/2)
  45. DO 10 K1=1,NCO1
  46. *
  47. * ON CHERCHE LA COMPOSANTE DANS NOMDD ET AUSSI DANS NOMDU
  48. * (EN MECANIQUE DES FLUIDES, LE MEME NOM EST PARFOIS DONNE
  49. * A LA PRIMALE ET A LA DUALE)
  50. CHA4=MSOUP1.NOCOMP(K1)
  51. ICO1=0
  52. DO IDD=1,LNOMDD
  53. IF (CHA4.EQ.NOMDD(IDD)) THEN
  54. ICO1=1
  55. IPO1=IDD
  56. GOTO 20
  57. ENDIF
  58. ENDDO
  59. 20 CONTINUE
  60. DO IDU=1,LNOMDU
  61. IF (CHA4.EQ.NOMDU(IDU)) THEN
  62. ICO1=ICO1+2
  63. IPO1=IDU
  64. GOTO 30
  65. ENDIF
  66. ENDDO
  67. 30 CONTINUE
  68. *
  69. * => LA COMPOSANTE N'EXISTE PAS DANS CCHAMP
  70. IF (ICO1.EQ.0) THEN
  71. MOTERR(1:4)=CHA4
  72. CALL ERREUR(108)
  73. RETURN
  74. *
  75. * => LA COMPOSANTE EST DANS LES DEUX LISTES
  76. ELSEIF (ICO1.EQ.3) THEN
  77. GOTO 11
  78. ENDIF
  79. *
  80. IF (ICOTY1.EQ.0) ICOTY1=ICO1
  81. IF (ICOTY1.NE.ICO1) THEN
  82. ICOD1=-1
  83. IPOS1=0
  84. RETURN
  85. ENDIF
  86. *
  87. * Incrementation de MLENTI
  88. 11 CONTINUE
  89. DO L1=1,JG
  90. IF (IPO1.EQ.LECT(L1)) GOTO 10
  91. ENDDO
  92. JG=JG+1
  93. LECT(JG)=IPO1
  94. *
  95. 10 CONTINUE
  96. *
  97. SEGDES,MSOUP1
  98. ENDDO
  99. SEGDES,MCHPO1
  100. *
  101. ICOD1=ICOTY1
  102. IPOS1=MLENTI
  103. SEGADJ,MLENTI
  104. SEGDES,MLENTI
  105. *
  106. RETURN
  107. *
  108. END
  109. *
  110. *
  111.  

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