Télécharger excopp.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCOPP SOURCE BP208322 17/04/18 21:15:04 9396
  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
  68. SEGINI IPT1
  69. ELSE
  70. NC=1
  71. N=NBELEM+NDEJ
  72. NBELEM=N
  73. SEGADJ MPOVAL
  74. SEGADJ IPT1
  75. ENDIF
  76. DO 140 IC=1,NUM(/2)
  77. IPT1.NUM(1,IC+NDEJ)=NUM(1,IC)
  78. MPOVAL.VPOCHA(IC+NDEJ,1)=MPOVA1.VPOCHA(IC,IBVAL)
  79. 140 CONTINUE
  80. NDEJ=NDEJ+NUM(/2)
  81. SEGDES MELEME,MPOVA1
  82. 130 CONTINUE
  83. SEGDES MSOUP1
  84. 100 CONTINUE
  85. C
  86.  
  87. IF(MPOVAL.NE.0) GOTO 200
  88. C
  89. C ERREUR PAS DE COMPOSANTE DU TYPE RECHERCHE DANS MCHPOI
  90. C
  91. IF(IVID.EQ.1) THEN
  92. NSOUPO=0
  93. NAT=MCHPO1.JATTRI(/1)
  94. SEGINI MCHPOI
  95. mochde='chpoint vide'
  96. mtypoi='SCALAIRE'
  97. IFOPOI=MCHPO1.IFOPOI
  98. DO 160 II=1,NAT
  99. JATTRI(II)=MCHPO1.JATTRI(II)
  100. 160 CONTINUE
  101. IPCH2=MCHPOI
  102. SEGDES MCHPOI
  103. GO TO 666
  104. ELSE
  105. MOTERR(1:4)=MOT
  106. CALL ERREUR(181)
  107. GOTO 666
  108. ENDIF
  109. 200 CONTINUE
  110. C
  111. C ON REMPLIT LE NOUVEAU CHPOINT
  112. C
  113. NSOUPO=1
  114. NAT=MCHPO1.JATTRI(/1)
  115. SEGINI MCHPOI
  116. IPCH2=MCHPOI
  117. MTYPOI='SCALAIRE'
  118. MOCHDE=MCHPO1.MOCHDE
  119. DO 170 II=1,NAT
  120. JATTRI(II)=MCHPO1.JATTRI(II)
  121. 170 CONTINUE
  122. IFOPOI=MCHPO1.IFOPOI
  123. NC=1
  124. SEGINI MSOUPO
  125. IPCHP(1)=MSOUPO
  126. NOCOMP(1)=MOT2
  127. NOHARM(1)=NIF2
  128. IPOVAL=MPOVAL
  129. SEGDES MCHPOI,MSOUPO
  130. SEGDES MPOVAL
  131. segact ipt1*mod
  132. IPT1.ITYPEL=1
  133. call crech1(ipt1,1)
  134. IGEOC=IPT1
  135. SEGDES IPT1
  136. C
  137. 666 CONTINUE
  138. C
  139. C SUPPRESSION DES SEGMENTS DE TRAVAIL
  140. C
  141. C
  142. SEGDES MCHPO1
  143. RETURN
  144. END
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  

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