Télécharger etalch.eso

Retour à la liste

Numérotation des lignes :

  1. C ETALCH SOURCE BP208322 15/09/24 21:15:02 8631
  2. SUBROUTINE ETALCH(MCHPOI,IINC,ICPR,ICONTR,MVA,IPB,NPR2,ICODE)
  3. C
  4. C=======================================================================
  5. C CE SUBROUTINE ETALE LE CHPOINT DANS LE TABLEAU MVA
  6. C
  7. C ***** ENTREES *****
  8. C IINC : LISTE DES COMPOSANTES DU TABLEAU
  9. C ICPR(I)=KI : LE NOEUD I EST LE KI^IEME POINT DU TABLEAU MVA
  10. C si ICODE=1, ON VERIFIE QUE LES POINTS DE MCHPOI MUNIS DE LEUR
  11. C COMPOSANTES (indice K) SONT CONTENUS DANS MVA,
  12. C C.A.D. QUE MCONTR(K,KI)=1 POUR CES POINTS
  13. C
  14. C ***** SORTIES *****
  15. C LES VALEURS DE MVA DANS LE CHPOINT
  16. C EVENTUELLEMENT IPB LE TABLEAU DE CORRESPONDANCE DES POINTS
  17. C IPB(I)=IK LE IEME POINT DU CHPOINT EST A LA PLACE IK DANS MVA
  18. C NPR2 = NOMBRE DE POINTS TOTAL DU MCHPOI
  19. C
  20. C ATTENTION : SEGACT MVA,IPB ET MISE A ZERO DE CES 2 TABLEAUX AVANT
  21. C UTILISATION.
  22. C=======================================================================
  23. IMPLICIT INTEGER(I-N)
  24. -INC CCOPTIO
  25. -INC SMCHPOI
  26. -INC SMELEME
  27. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  28. SEGMENT IINC
  29. CHARACTER*4 CIINC(0)
  30. ENDSEGMENT
  31. SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA
  32. SEGMENT/ICONTR/(MCONTR(NNI1,IPR1))
  33. SEGMENT IPB(IPR1)
  34.  
  35. C---- Activation des segments utiles ----
  36.  
  37. SEGACT ICPR
  38. SEGACT IINC
  39. SEGACT MVA*MOD
  40. SEGACT ICONTR
  41. IF(IPB.NE.0) SEGACT IPB*MOD
  42. NNI1=VA(/1)
  43. IPR1=VA(/2)
  44. NPR2=0
  45.  
  46. C---- Mise a 0 de VA et de IPB----
  47.  
  48. DO 1 J=1,IPR1
  49. DO 1 K=1,NNI1
  50. VA(K,J)=0.D0
  51. 1 CONTINUE
  52. C
  53. IF(IPB.EQ.0) GOTO 2
  54. DO 3 J=1,IPR1
  55. IPB(J)=0
  56. 3 CONTINUE
  57. 2 CONTINUE
  58.  
  59. C---- Boucle sur les zones du CHPOINT ----
  60.  
  61. SEGACT MCHPOI
  62. NSOUP=IPCHP(/1)
  63. DO 60 ISOUP=1,NSOUP
  64.  
  65. MSOUPO=IPCHP(ISOUP)
  66. SEGACT MSOUPO
  67. MELEME=IGEOC
  68. SEGACT MELEME
  69. N2=NUM(/2)
  70. MPOVAL=IPOVAL
  71. SEGACT MPOVAL
  72.  
  73. C ---- Boucle sur les composantes du CHPOINT ----
  74.  
  75. DO 61 J=1,NOCOMP(/2)
  76.  
  77. DO 62 K=1,NNI1
  78. IF(NOCOMP(J).EQ.CIINC(K)) GOTO 63
  79. 62 CONTINUE
  80. c si on n'a pas trouvé la J eme composante dans CIINC,
  81. c -> on essaie la prochaine
  82. IF(ICODE.EQ.0) GOTO 61
  83. c -> ou erreur
  84. WRITE(IOIMP,*) 'NOCOMP(',J,')=',NOCOMP(J),'n existe pas dans:'
  85. WRITE(IOIMP,*) 'CIINC=',(CIINC(iou),iou=1,NNI1)
  86. IJ=1
  87. GOTO 66
  88. c J eme composante dans CIINC(K)
  89. 63 CONTINUE
  90.  
  91. IF(IPB.NE.0) GOTO 65
  92.  
  93. c - si IPB n'existe pas, on verifie que MCONTR=1 et on remplit VA
  94. DO 64 IJ=1,N2
  95. KI=ICPR(NUM(1,IJ))
  96. IF(KI.EQ.0) THEN
  97. IF(ICODE.EQ.0) GOTO 64
  98. WRITE(IOIMP,*) IJ,'ieme NOEUD #',NUM(1,IJ),'n existe pas',
  99. & ' dans l ICPR'
  100. GOTO 66
  101. ENDIF
  102. IF(MCONTR(K,KI).NE.1) THEN
  103. IF(ICODE.EQ.0) GOTO 64
  104. GOTO 66
  105. ENDIF
  106. VA(K,KI)=VPOCHA(IJ,J)
  107. 64 CONTINUE
  108. GOTO 61
  109.  
  110. c - si IPB existe, on le remplit aussi
  111. 65 CONTINUE
  112. c boucle 74 = copie de la boucle 64 avec remplissage de IPB en +
  113. DO 74 IJ=1,N2
  114. KI=ICPR(NUM(1,IJ))
  115. IF(KI.EQ.0) THEN
  116. IF(ICODE.EQ.0) GOTO 74
  117. WRITE(IOIMP,*) IJ,'ieme NOEUD #',NUM(1,IJ),'n existe pas',
  118. & ' dans l ICPR'
  119. GOTO 66
  120. ENDIF
  121. IF(MCONTR(K,KI).NE.1) THEN
  122. IF(ICODE.EQ.0) GOTO 74
  123. GOTO 66
  124. ENDIF
  125. IF(J.EQ.1) IPB(NPR2+IJ)=KI
  126. VA(K,KI)=VPOCHA(IJ,J)
  127. 74 CONTINUE
  128. GOTO 61
  129.  
  130. c - ERREUR -
  131. 66 CONTINUE
  132. MOTERR(1:4)=NOCOMP(J)
  133. INTERR(1)=NUM(1,IJ)
  134. CALL ERREUR(140)
  135. C INCOMPATIBILITE ENTRE LES POINTS ET COMPOSANTES DES 2 CHPOINTS
  136. GOTO 5000
  137.  
  138. 61 CONTINUE
  139. C ---- Fin de Boucle sur les comosantes du CHPOINT ----
  140. NPR2=NPR2+N2
  141. SEGDES MELEME
  142. SEGDES MSOUPO
  143. SEGDES MPOVAL
  144.  
  145. 60 CONTINUE
  146. C---- Fin de Boucle sur les zones du CHPOINT ----
  147. SEGDES MCHPOI
  148. C
  149. C---- DesActivation des segments utiles et return ----
  150. SEGDES ICPR,IINC
  151. SEGDES ICONTR
  152. SEGDES MVA
  153. IF(IPB.NE.0) SEGDES IPB
  154. 5000 CONTINUE
  155. RETURN
  156. END
  157.  
  158.  
  159.  
  160.  

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