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. -INC CCOPTIO
  23. -INC SMCHPOI
  24. -INC SMLENTI
  25. -INC CCHAMP
  26. CHARACTER*4 CHA4
  27. *
  28. ICOTY1=0
  29. *
  30. JG=LNOMDD
  31. SEGINI,MLENTI
  32. JG=0
  33. *
  34. MCHPO1=ICHP1
  35. SEGACT,MCHPO1
  36. *
  37. NSOUP1=MCHPO1.IPCHP(/1)
  38. DO J1=1,NSOUP1
  39. MSOUP1=MCHPO1.IPCHP(J1)
  40. SEGACT,MSOUP1
  41. *
  42. NCO1=MSOUP1.NOCOMP(/2)
  43. DO 10 K1=1,NCO1
  44. *
  45. * ON CHERCHE LA COMPOSANTE DANS NOMDD ET AUSSI DANS NOMDU
  46. * (EN MECANIQUE DES FLUIDES, LE MEME NOM EST PARFOIS DONNE
  47. * A LA PRIMALE ET A LA DUALE)
  48. CHA4=MSOUP1.NOCOMP(K1)
  49. ICO1=0
  50. DO IDD=1,LNOMDD
  51. IF (CHA4.EQ.NOMDD(IDD)) THEN
  52. ICO1=1
  53. IPO1=IDD
  54. GOTO 20
  55. ENDIF
  56. ENDDO
  57. 20 CONTINUE
  58. DO IDU=1,LNOMDU
  59. IF (CHA4.EQ.NOMDU(IDU)) THEN
  60. ICO1=ICO1+2
  61. IPO1=IDU
  62. GOTO 30
  63. ENDIF
  64. ENDDO
  65. 30 CONTINUE
  66. *
  67. * => LA COMPOSANTE N'EXISTE PAS DANS CCHAMP
  68. IF (ICO1.EQ.0) THEN
  69. MOTERR(1:4)=CHA4
  70. CALL ERREUR(108)
  71. RETURN
  72. *
  73. * => LA COMPOSANTE EST DANS LES DEUX LISTES
  74. ELSEIF (ICO1.EQ.3) THEN
  75. GOTO 11
  76. ENDIF
  77. *
  78. IF (ICOTY1.EQ.0) ICOTY1=ICO1
  79. IF (ICOTY1.NE.ICO1) THEN
  80. ICOD1=-1
  81. IPOS1=0
  82. RETURN
  83. ENDIF
  84. *
  85. * Incrementation de MLENTI
  86. 11 CONTINUE
  87. DO L1=1,JG
  88. IF (IPO1.EQ.LECT(L1)) GOTO 10
  89. ENDDO
  90. JG=JG+1
  91. LECT(JG)=IPO1
  92. *
  93. 10 CONTINUE
  94. *
  95. SEGDES,MSOUP1
  96. ENDDO
  97. SEGDES,MCHPO1
  98. *
  99. ICOD1=ICOTY1
  100. IPOS1=MLENTI
  101. SEGADJ,MLENTI
  102. SEGDES,MLENTI
  103. *
  104. RETURN
  105. *
  106. END
  107. *
  108. *
  109.  

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