Télécharger la plaquette Cast3M


fr en

Télécharger masgen.eso

Retour à la liste

Numérotation des lignes : 

masgen

  1. C MASGEN    SOURCE    CB215821  20/11/25    13:34:04     10792          
  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36.       REAL*8 PROPRE(5)
  37. C
  38. C
  39.       MCHPO1=IPX
  40.       SEGACT MCHPO1
  41. C
  42. C     CAS FOURIER
  43. C
  44.       IF(MCHPO1.IFOPOI.NE.1) GOTO 2000
  45. C
  46.          NSOUPO=MCHPO1.IPCHP(/1)
  47.          DO 20 ISOUPO=1,NSOUPO
  48.          MSOUPO=MCHPO1.IPCHP(ISOUPO)
  49.          SEGACT MSOUPO
  50.          NC=NOHARM(/1)
  51.          DO 30 I=1,NC
  52.          NHARM=NOHARM(I)
  53.          IF(ISOUPO.NE.1.OR.I.NE.1) GOTO 31
  54.          NHARM1=NHARM
  55.          GOTO 30
  56.    31    CONTINUE
  57.          IF(NHARM.NE.NHARM1) GOTO 1000
  58.    30    CONTINUE
  59.          SEGDES MSOUPO
  60.    20    CONTINUE
  61.          GOTO 2000
  62. C
  63. C
  64. C***********************************************************
  65. C        PROVISOIREMENT ON SUPPOSE QU IL N Y A QU UNE HARMONIQUE
  66. C        ON TESTE NIFOUR
  67. C**10    NHARM1=NIFOUR
  68. C
  69. C
  70. C
  71. C**************************************************************
  72.  
  73. C
  74. 1000  CONTINUE
  75. C
  76. C     PLUSIEURS HARMONIQUES
  77. C
  78.       PROPRE(2)=0.D0
  79.       IF (IIMPI.EQ.2) WRITE(IOIMP,1001)
  80. 1001  FORMAT(20X,' IL Y A PLUSIEURS HARMONIQUES DIFFERENTES ',
  81.      C 'ON MET LA MASSE GENERALISEE A 0 (VERSION 11/06/86) ')
  82.       GOTO 2000
  83. C
  84. C
  85. 2000  CONTINUE
  86.       SEGDES MCHPO1
  87.       RETURN
  88.       END
  89.  
  90.  
  91.  
  92.  

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