Télécharger arcorc.eso

Retour à la liste

Numérotation des lignes :

  1. C ARCORC SOURCE BP208322 15/10/21 21:15:03 8690
  2. SUBROUTINE ARCORC (IPCHPT,REF)
  3.  
  4. ***********************************************************************
  5. *
  6. * A R C O R C
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * MISE A ZERO, S'ILS EXISTENT, DES ELEMENTS RELATIFS A UNE INCONNUE
  12. * 'NOMDU'
  13. *
  14. *
  15. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  16. * -----------
  17. *
  18. * IPCHPT ENTIER (E/S) CHPOINT DE TRAVAIL
  19. *
  20. * REF ENTIER (E) NUMERO DE L'INCONNUE A METTRE A ZERO
  21. *
  22. *
  23. * SOUS-PROGRAMMES APPELES:
  24. * ------------------------
  25. *
  26. * ANCHPO
  27. *
  28. * AUTEUR, DATE DE CREATION:
  29. * -------------------------
  30. *
  31. * PASCAL BOUDA 11 SEPTEMBRE 2015
  32. *
  33. * LANGAGE:
  34. * --------
  35. *
  36. * FORTRAN 77 & 90
  37. *
  38. ***********************************************************************
  39.  
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8 (A-H,O-Z)
  42.  
  43. -INC CCOPTIO
  44. -INC SMCHPOI
  45. -INC CCHAMP
  46.  
  47.  
  48. INTEGER IPCHPT
  49. INTEGER REF
  50.  
  51. INTEGER IINC
  52. INTEGER IPBUFF
  53. CHARACTER*4 MOC
  54.  
  55. IINC=0
  56.  
  57.  
  58. MCHPOI=IPCHPT
  59. SEGACT MCHPOI
  60. NSOUPO = IPCHP(/1)
  61.  
  62. DO 10 ISOUPO=1,NSOUPO
  63.  
  64. MSOUPO = IPCHP(ISOUPO)
  65. SEGACT MSOUPO
  66. MPOVAL=IPOVAL
  67. SEGACT MPOVAL
  68. NC = NOCOMP(/2)
  69.  
  70. DO 20 IC = 1,NC
  71.  
  72. MOC=NOCOMP(IC)
  73. IF ( MOC .EQ. NOMDU(REF) ) THEN
  74. IINC=IINC+VPOCHA(/1)
  75. ENDIF
  76.  
  77. 20 CONTINUE
  78.  
  79. SEGDES MPOVAL
  80. SEGDES MSOUPO
  81.  
  82. 10 CONTINUE
  83.  
  84. SEGDES MCHPOI
  85.  
  86.  
  87. *Mise a zero des eventuels elments
  88. IF (IINC .NE. 0) THEN
  89. IPBUFF=IPCHPT
  90. CALL ANCHPO(IPBUFF,NOMDU(REF),IPCHPT)
  91. ENDIF
  92.  
  93.  
  94. END
  95.  

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