Télécharger masgen.eso

Retour à la liste

Numérotation des lignes :

  1. C MASGEN SOURCE CHAT 05/01/13 01:31:35 5004
  2. SUBROUTINE MASGEN(IPX,PROPRE)
  3. C
  4. C********************************************************************
  5. C
  6. C
  7. C VERSION 11/06/86 AUTEUR D. BROCHARD
  8. C IPX POINTEUR SUR LE MODE PROPRE (CHAMP PAR POINT)
  9. C PROPRE VOIR SIGNIFICATION DANS ITINV
  10. C
  11. C SBR APPELE PAR ITINV ET SIMUL7
  12. C CALCUL DES MASSES GENERALISEES INTRODUCTION DES COEFF.
  13. C EVENTUELS :
  14. C CAS PLAN AXIS. OU 3D COEF =1.0
  15. C CAS FOURIER (IFOPOI=1) :
  16. C 1 SEULE HARMONIQUE NHARM COEF=1.0
  17. C PLUSIEURS HARMONIQUES MASSE GEN.=0 + MESSAGE D ERREUR
  18. C
  19. C 12/06/86 IFOPOI ET NOHARM NON INITIALISES (MIS =0)
  20. C PROVISOIREMENT ON UTILISERA LES VARIABLES DE OPTIO
  21. C
  22. C LES CARTES A RENDRE ACTIVES SERONT REPEREES PAR **
  23. C
  24. C 08/07/86 IFOPOI ET NOHARM CORRECTS LES ANCIENNES CARTES
  25. C SONT PRECEDEES PAR **
  26. C
  27. C********************************************************************
  28. C
  29. C
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8(A-H,O-Z)
  32. -INC SMCHPOI
  33. -INC CCOPTIO
  34. REAL*8 PROPRE(5)
  35. C
  36. C
  37. MCHPO1=IPX
  38. SEGACT MCHPO1
  39. C
  40. C CAS FOURIER
  41. C
  42. IF(MCHPO1.IFOPOI.NE.1) GOTO 2000
  43. C
  44. NSOUPO=MCHPO1.IPCHP(/1)
  45. DO 20 ISOUPO=1,NSOUPO
  46. MSOUPO=MCHPO1.IPCHP(ISOUPO)
  47. SEGACT MSOUPO
  48. NC=NOHARM(/1)
  49. DO 30 I=1,NC
  50. NHARM=NOHARM(I)
  51. IF(ISOUPO.NE.1.OR.I.NE.1) GOTO 31
  52. NHARM1=NHARM
  53. GOTO 30
  54. 31 CONTINUE
  55. IF(NHARM.NE.NHARM1) GOTO 1000
  56. 30 CONTINUE
  57. SEGDES MSOUPO
  58. 20 CONTINUE
  59. GOTO 2000
  60. C
  61. C
  62. C***********************************************************
  63. C PROVISOIREMENT ON SUPPOSE QU IL N Y A QU UNE HARMONIQUE
  64. C ON TESTE NIFOUR
  65. C**10 NHARM1=NIFOUR
  66. C
  67. C
  68. C
  69. C**************************************************************
  70.  
  71. C
  72. 1000 CONTINUE
  73. C
  74. C PLUSIEURS HARMONIQUES
  75. C
  76. PROPRE(2)=0.D0
  77. IF (IIMPI.EQ.2) WRITE(IOIMP,1001)
  78. 1001 FORMAT(20X,' IL Y A PLUSIEURS HARMONIQUES DIFFERENTES ',
  79. C 'ON MET LA MASSE GENERALISEE A 0 (VERSION 11/06/86) ')
  80. GOTO 2000
  81. C
  82. C
  83. 2000 CONTINUE
  84. SEGDES MCHPO1
  85. RETURN
  86. END
  87.  
  88.  
  89.  

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