Télécharger la plaquette Cast3M


fr en

Télécharger extr15.eso

Retour à la liste

Numérotation des lignes : 

extr15

  1. C EXTR15    SOURCE    CB215821  24/04/12    21:15:52     11897          
  2.       SUBROUTINE EXTR15(IPMODL,IPCHE1,IPLSTM)
  3. *_____________________________________________________________________
  4. *
  5. *     Extrait les composantes d'un MCHAML
  6. *
  7. *  Entrees :
  8. *  ---------
  9. *
  10. *     IPMODL  Pointeur sur un MMODEL
  11. *     IPCHE1  Pointeur sur un MCHAML
  12. *
  13. *  Sortie :
  14. *  --------
  15. *     IPLSTM  Pointeur sur un LISTMOTS
  16. *
  17. *  JM CAMPENON le 07/91
  18. *_____________________________________________________________________
  19. *
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22. *
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCHAML
  27. -INC SMMODEL
  28. -INC SMLMOTS
  29. *
  30.       SEGMENT MTR1(0)
  31. *
  32.       IPLSTM=0
  33.       JGN=LOCOMP
  34.       JGM=0
  35.       MMODEL=IPMODL
  36.       NSOUS=KMODEL(/1)
  37. *
  38.       MCHELM=IPCHE1
  39. *
  40.       SEGINI MTR1
  41. *
  42.       DO 100 ISOUS=1,NSOUS
  43.          IMODEL=KMODEL(ISOUS)
  44.          IPMAIL=IMAMOD
  45. *
  46.          DO 200 IA=1,ICHAML(/1)
  47.           IF (IMACHE(IA).EQ.IPMAIL.AND.CONCHE(IA).EQ.CONMOD) GOTO 300
  48.  200     CONTINUE
  49. *
  50. *        Pas de sous zone dans le MCHAML qui corresponde au MMODEL
  51. *
  52.          CALL ERREUR(472)
  53.          SEGSUP MTR1
  54.          GOTO 555
  55. *
  56.  300     CONTINUE
  57.          MCHAML=ICHAML(IA)
  58.          NCOMP=NOMCHE(/2)
  59.          JGM=JGM+NCOMP
  60.          MTR1(**)=IA
  61.  100  CONTINUE
  62.       SEGINI MLMOTS
  63.       IPLSTM=MLMOTS
  64. *
  65.       IMEM=0
  66.       DO 150 ISOUS=1,MTR1(/1)
  67.          MCHAML=ICHAML(MTR1(ISOUS))
  68.          NCOMP=NOMCHE(/2)
  69. *
  70.          DO 400 ICOMP=IMEM+1,IMEM+NCOMP
  71.             MOTS(ICOMP)=NOMCHE(ICOMP-IMEM)
  72.  400     CONTINUE
  73.          IMEM=IMEM+NCOMP
  74.  150  CONTINUE
  75. *
  76.  555  CONTINUE
  77.       RETURN
  78.       END
  79.  
  80.  
  81.  

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