Télécharger ch2vec.eso

Retour à la liste

Numérotation des lignes :

  1. C CH2VEC SOURCE PV 16/11/17 21:58:22 9180
  2. SUBROUTINE CH2VEC(MCHPOI,MINC,KISPG,IDMAT,KVEC,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : CH2VEC
  7. C DESCRIPTION :
  8. C
  9. C Ce sp effectue la surcharge :
  10. C chpoint (MCHPOI) -> vecteur (KVEC pointeur de type IZA).
  11. C L'ordonnancement des inconnues est
  12. C donné par MINC, les points concernés par KISPG et IDMAT
  13. C donne le passage num. ancienne -> num. nouvelle (NUAN)
  14. C
  15. C Son alter ego est vec2ch.
  16. C
  17. C Les valeurs non nulles de MCHPOI NE correspondant
  18. C PAS à des inconnues du vecteur KVEC donnent lieu à
  19. C l'émission d'un warning.
  20. C
  21. C
  22. C
  23. C
  24. C LANGAGE : ESOPE
  25. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  26. C mél : gounand@semt2.smts.cea.fr
  27. C***********************************************************************
  28. C APPELES : KRIPAD
  29. C***********************************************************************
  30. C ENTREES : MCHPOI, MINC, KISPG, IDMAT, IMPR
  31. C ENTREES/SORTIES : KVEC
  32. C SORTIES : IRET
  33. C CODE RETOUR (IRET) : inutilisé (=0 tout marche !)
  34. C
  35. C MCHPOI : pointeur sur segment MCHPOI de l'include SMCHPOI
  36. C chpoint de surchargement pour le vecteur KVEC.
  37. C MINC : pointeur sur segment MINC de l'include SMMATRIK
  38. C décrit l'ordonnancement des inconnues dans une
  39. C certaine numérotation (dite "nouvelle").
  40. C KISPG : pointeur sur segment MELEME de l'include SMELEME
  41. C support géométrique des inconnues.
  42. C IDMAT : pointeur sur segment IDMAT de l'include SMMATRIK
  43. C contient le tableau NUAN permettant de faire
  44. C le passage numérotation ancienne -> num. "nouvelle".
  45. C IMPR : niveau d'impression
  46. C KVEC : pointeur sur segment IZA de l'include SMMATRIK
  47. C contient le vecteur des inconnues à surcharger.
  48. C (Il est donc initialisé avant l'appel à ch2vec)
  49. C
  50. C***********************************************************************
  51. C VERSION : v2, 01/12/99
  52. C HISTORIQUE : v1, 01/04/98, création
  53. C HISTORIQUE : v2; 01/12/99, modifs (nouvelle signification de NUAN)
  54. C HISTORIQUE :
  55. C***********************************************************************
  56. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  57. C en cas de modification de ce sous-programme afin de faciliter
  58. C la maintenance !
  59. C***********************************************************************
  60. -INC CCOPTIO
  61. POINTEUR KVEC.IZA
  62. -INC SMCHPOI
  63. -INC SMELEME
  64. POINTEUR KISPG.MELEME
  65. -INC SMLENTI
  66. CHARACTER*8 NOMINC
  67. LOGICAL FLINC
  68. *
  69. INTEGER IMPR,IRET
  70. *
  71. INTEGER I1,IN,INBI,INBVA
  72. INTEGER INC,L,N,NBI,NC,NSOUPO
  73. *
  74. IRET=0
  75. C
  76. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans ch2vec.eso'
  77. C
  78. IF (IMPR.GT.6) THEN
  79. WRITE(IOIMP,*) ' ch2vec : entrées '
  80. WRITE(IOIMP,*) ' MCHPOI = ',MCHPOI
  81. WRITE(IOIMP,*) ' MINC = ',MINC
  82. WRITE(IOIMP,*) ' KISPG = ',KISPG
  83. WRITE(IOIMP,*) ' IDMAT = ',IDMAT
  84. ENDIF
  85. C
  86. SEGACT MINC
  87. NBI=LISINC(/2)
  88. C In KRIPAD : SEGACT KISPG
  89. C SEGINI MLENTI
  90. C write(ioimp,*) 'kispg'
  91. C call ecmail(kispg,0)
  92. C write(ioimp,*) 'minc'
  93. C write(ioimp,*) 'minc lisinc',(lisinc(i),i=1,lisinc(/2))
  94. C write(ioimp,*) 'minc npos ',(npos(i),i=1,npos(/1))
  95. C do i=1,mpos(/1)
  96. C write(ioimp,*) 'minc mpos (',i,')=',(mpos(i,j),j=1,mpos(/2))
  97. C enddo
  98. CALL KRIPAD(KISPG,MLENTI)
  99. C write(ioimp,*) 'mlenti ',(lect(i),i=1,lect(/1))
  100. SEGDES KISPG
  101. SEGACT IDMAT
  102. SEGACT MCHPOI
  103. NSOUPO=IPCHP(/1)
  104. DO 1 L=1,NSOUPO
  105. MSOUPO=IPCHP(L)
  106. SEGACT MSOUPO
  107. NC=NOCOMP(/2)
  108. MELEME=IGEOC
  109. MPOVAL=IPOVAL
  110. SEGACT MELEME
  111. N=NUM(/2)
  112. IF (N.EQ.0) GOTO 15
  113. SEGACT MPOVAL
  114. DO 2 INC=1,NC
  115. NOMINC=NOCOMP(INC)//' '
  116. FLINC=.FALSE.
  117. C Repeat..until
  118. INBI=1
  119. 21 CONTINUE
  120. IF (NOMINC.EQ.LISINC(INBI)) THEN
  121. FLINC=.TRUE.
  122. ELSEIF (INBI.LT.NBI) THEN
  123. INBI=INBI+1
  124. GOTO 21
  125. ENDIF
  126. IF (.NOT.FLINC) THEN
  127. * WRITE(IOIMP,*) ' ch2vec : Composante ',NOMINC,' unknown '
  128. ELSE
  129. N=VPOCHA(/1)
  130. DO 3 IN=1,N
  131. I1=LECT(NUM(1,IN))
  132. IF(I1.EQ.0)THEN
  133. * Silence dans les rangs !
  134. * WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN),
  135. * $ ' inconnue : ', NOCOMP(INC)
  136. * WRITE(IOIMP,*) ' n''appartient pas au vec.'
  137. ELSE
  138. IF (MPOS(I1,INBI).NE.0) THEN
  139. INBVA=NUAN(NPOS(I1)+MPOS(I1,INBI)-1)
  140. C INBVA=NPOS(NUAN(I1))+MPOS(NUAN(I1),INBI)-1
  141. C KVEC.A(INBVA)=KVEC.A(INBVA)+VPOCHA(IN,INC)
  142. C Je préfère surcharger
  143. C
  144. * WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN),
  145. * $ ' inconnue : ', NOCOMP(INC) , 'valeur ',
  146. * $ VPOCHA(IN,INC)
  147. * WRITE(IOIMP,*) ' attribue au ddl ',INBVA
  148. KVEC.A(INBVA)=VPOCHA(IN,INC)
  149. ENDIF
  150. ENDIF
  151. 3 CONTINUE
  152. ENDIF
  153. 2 CONTINUE
  154. SEGDES MPOVAL
  155. 15 CONTINUE
  156. SEGDES MSOUPO
  157. SEGDES MELEME
  158. 1 CONTINUE
  159. SEGDES MCHPOI
  160. SEGDES IDMAT
  161. SEGSUP MLENTI
  162. SEGDES MINC
  163. *
  164. * Normal termination
  165. *
  166. RETURN
  167. *
  168. * End of CH2VEC
  169. *
  170. END
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  

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