Télécharger pridua.eso

Retour à la liste

Numérotation des lignes :

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

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