Télécharger excopp.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCOPP SOURCE CB215821 19/05/21 21:15:08 10221
  2. SUBROUTINE EXCOPP(IPCH1,MOT,NIF1,IPCH2,MOT2,NIF2,IVID)
  3. C=======================================================================
  4. C
  5. C EXTRACTION D UNE COMPOSANTE D UN CHPOINT
  6. C ROUTINE APPELLEE PAR L OPERATEUR EXCOMP
  7. C ENTREE
  8. C IPCH1= POINTEUR SUR UN CHPOINT
  9. C MOT = NOM DE LA COMPOSANTE A EXTRAIRE
  10. C NIF1 = harmonique de Fourier
  11. C SORTIE
  12. C IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA
  13. C COMPOSANTE MOT LE NOM DE CETTE COMPOSANTE EST
  14. C REPABTISE MOT2 + harmonique NIF2
  15. C CODE DECEMBRE 84 MODIFIE NOVEMBRE 1986
  16. C=======================================================================
  17. IMPLICIT INTEGER(I-N)
  18. -INC SMCHPOI
  19. -INC SMELEME
  20. -INC CCOPTIO
  21. CHARACTER*4 MOT,MOT1,MOT2
  22. C
  23. c write(*,*) 'EXCOPP: search ',MOT,NIF1,' a renommer en ',MOT2,NIF2
  24. MCHPO1=IPCH1
  25. SEGACT MCHPO1
  26. C
  27. C INITIALISATION DES SEGMENTS DE TRAVAIL
  28. C
  29. C
  30. MPOVAL=0
  31. IPT1 =0
  32. NBSOUS=0
  33. NBREF =0
  34. NSOUP1=MCHPO1.IPCHP(/1)
  35. C
  36. C BOUCLE SUR LES SOUS PAQUETS DE MCHPO1
  37. C
  38. DO 100 IA=1,NSOUP1
  39. MSOUP1=MCHPO1.IPCHP(IA)
  40. SEGACT MSOUP1
  41. NC1=MSOUP1.NOCOMP(/2)
  42. DO 110 IB=1,NC1
  43. MOT1=MSOUP1.NOCOMP(IB)
  44. IHA=MSOUP1.NOHARM(IB)
  45. c write(*,*) MCHPO1,' +zone ',IA,' +composante',IB,MOT1,' +n=',IHA
  46. IF(MOT1.NE.MOT.OR.IHA.NE.NIF1) GOTO 110
  47. IBVAL=IB
  48. GOTO 120
  49. 110 CONTINUE
  50. C
  51. C ON A PAS TROUVE UNE COMPOSANTE MOT DANS CE SOUS PAQUET
  52. C
  53. GOTO 130
  54. C
  55. C ON A TROUVE DANS LE SOUS PAQUET UNE COMPOSANTE MOT
  56. C
  57. 120 CONTINUE
  58. MELEME=MSOUP1.IGEOC
  59. MPOVA1=MSOUP1.IPOVAL
  60. SEGACT MELEME,MPOVA1
  61. NBNN =NUM(/1)
  62. NBELEM=NUM(/2)
  63. IF(MPOVAL.EQ.0) THEN
  64. NDEJ=0
  65. NC =1
  66. N =NBELEM
  67. SEGINI,MPOVAL,IPT1
  68. ELSE
  69. NC =1
  70. N =NBELEM+NDEJ
  71. NBELEM=N
  72. SEGADJ,MPOVAL,IPT1
  73. ENDIF
  74. DO 140 IC=1,NUM(/2)
  75. IPT1.NUM(1,IC+NDEJ)=NUM(1,IC)
  76. MPOVAL.VPOCHA(IC+NDEJ,1)=MPOVA1.VPOCHA(IC,IBVAL)
  77. 140 CONTINUE
  78.  
  79. NDEJ=NDEJ+NUM(/2)
  80. 130 CONTINUE
  81. 100 CONTINUE
  82. C
  83.  
  84. IF(MPOVAL.NE.0) GOTO 200
  85. C
  86. C ERREUR PAS DE COMPOSANTE DU TYPE RECHERCHE DANS MCHPOI
  87. C
  88. IF(IVID.EQ.1) THEN
  89. NSOUPO=0
  90. NAT=MCHPO1.JATTRI(/1)
  91. SEGINI,MCHPOI
  92. mochde='chpoint vide'
  93. mtypoi='SCALAIRE'
  94. IFOPOI=MCHPO1.IFOPOI
  95. DO 160 II=1,NAT
  96. JATTRI(II)=MCHPO1.JATTRI(II)
  97. 160 CONTINUE
  98. IPCH2=MCHPOI
  99. SEGACT,MCHPOI*NOMOD
  100. RETURN
  101. ELSE
  102. MOTERR(1:4)=MOT
  103. CALL ERREUR(181)
  104. RETURN
  105. ENDIF
  106. 200 CONTINUE
  107. C
  108. C ON REMPLIT LE NOUVEAU CHPOINT
  109. C
  110. NSOUPO=1
  111. NAT=MCHPO1.JATTRI(/1)
  112. SEGINI,MCHPOI
  113. IPCH2=MCHPOI
  114. MTYPOI='SCALAIRE'
  115. MOCHDE=MCHPO1.MOCHDE
  116. DO 170 II=1,NAT
  117. JATTRI(II)=MCHPO1.JATTRI(II)
  118. 170 CONTINUE
  119. IFOPOI=MCHPO1.IFOPOI
  120. NC=1
  121. SEGINI,MSOUPO
  122. IPCHP(1)=MSOUPO
  123. NOCOMP(1)=MOT2
  124. NOHARM(1)=NIF2
  125. IPOVAL=MPOVAL
  126. IPT1.ITYPEL=1
  127. call crech1(ipt1,1)
  128. IGEOC=IPT1
  129. SEGACT,MCHPOI*NOMOD,MSOUPO*NOMOD,MPOVAL*NOMOD,IPT1*NOMOD
  130.  
  131. END
  132.  
  133.  

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