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.  
  61. -INC PPARAM
  62. -INC CCOPTIO
  63. POINTEUR KVEC.IZA
  64. -INC SMCHPOI
  65. -INC SMELEME
  66. POINTEUR KISPG.MELEME
  67. -INC SMLENTI
  68. CHARACTER*8 NOMINC
  69. LOGICAL FLINC
  70. *
  71. INTEGER IMPR,IRET
  72. *
  73. INTEGER I1,IN,INBI,INBVA
  74. INTEGER INC,L,N,NBI,NC,NSOUPO
  75. *
  76. IRET=0
  77. C
  78. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans ch2vec.eso'
  79. C
  80. IF (IMPR.GT.6) THEN
  81. WRITE(IOIMP,*) ' ch2vec : entrées '
  82. WRITE(IOIMP,*) ' MCHPOI = ',MCHPOI
  83. WRITE(IOIMP,*) ' MINC = ',MINC
  84. WRITE(IOIMP,*) ' KISPG = ',KISPG
  85. WRITE(IOIMP,*) ' IDMAT = ',IDMAT
  86. ENDIF
  87. C
  88. SEGACT MINC
  89. NBI=LISINC(/2)
  90. C In KRIPAD : SEGACT KISPG
  91. C SEGINI MLENTI
  92. C write(ioimp,*) 'kispg'
  93. C call ecmail(kispg,0)
  94. C write(ioimp,*) 'minc'
  95. C write(ioimp,*) 'minc lisinc',(lisinc(i),i=1,lisinc(/2))
  96. C write(ioimp,*) 'minc npos ',(npos(i),i=1,npos(/1))
  97. C do i=1,mpos(/1)
  98. C write(ioimp,*) 'minc mpos (',i,')=',(mpos(i,j),j=1,mpos(/2))
  99. C enddo
  100. CALL KRIPAD(KISPG,MLENTI)
  101. C write(ioimp,*) 'mlenti ',(lect(i),i=1,lect(/1))
  102. SEGDES KISPG
  103. SEGACT IDMAT
  104. SEGACT MCHPOI
  105. NSOUPO=IPCHP(/1)
  106. DO 1 L=1,NSOUPO
  107. MSOUPO=IPCHP(L)
  108. SEGACT MSOUPO
  109. NC=NOCOMP(/2)
  110. MELEME=IGEOC
  111. MPOVAL=IPOVAL
  112. SEGACT MELEME
  113. N=NUM(/2)
  114. IF (N.EQ.0) GOTO 15
  115. SEGACT MPOVAL
  116. DO 2 INC=1,NC
  117. NOMINC=NOCOMP(INC)//' '
  118. FLINC=.FALSE.
  119. C Repeat..until
  120. INBI=1
  121. 21 CONTINUE
  122. IF (NOMINC.EQ.LISINC(INBI)) THEN
  123. FLINC=.TRUE.
  124. ELSEIF (INBI.LT.NBI) THEN
  125. INBI=INBI+1
  126. GOTO 21
  127. ENDIF
  128. IF (.NOT.FLINC) THEN
  129. * WRITE(IOIMP,*) ' ch2vec : Composante ',NOMINC,' unknown '
  130. ELSE
  131. N=VPOCHA(/1)
  132. DO 3 IN=1,N
  133. I1=LECT(NUM(1,IN))
  134. IF(I1.EQ.0)THEN
  135. * Silence dans les rangs !
  136. * WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN),
  137. * $ ' inconnue : ', NOCOMP(INC)
  138. * WRITE(IOIMP,*) ' n''appartient pas au vec.'
  139. ELSE
  140. IF (MPOS(I1,INBI).NE.0) THEN
  141. INBVA=NUAN(NPOS(I1)+MPOS(I1,INBI)-1)
  142. C INBVA=NPOS(NUAN(I1))+MPOS(NUAN(I1),INBI)-1
  143. C KVEC.A(INBVA)=KVEC.A(INBVA)+VPOCHA(IN,INC)
  144. C Je préfère surcharger
  145. C
  146. * WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN),
  147. * $ ' inconnue : ', NOCOMP(INC) , 'valeur ',
  148. * $ VPOCHA(IN,INC)
  149. * WRITE(IOIMP,*) ' attribue au ddl ',INBVA
  150. KVEC.A(INBVA)=VPOCHA(IN,INC)
  151. ENDIF
  152. ENDIF
  153. 3 CONTINUE
  154. ENDIF
  155. 2 CONTINUE
  156. SEGDES MPOVAL
  157. 15 CONTINUE
  158. SEGDES MSOUPO
  159. SEGDES MELEME
  160. 1 CONTINUE
  161. SEGDES MCHPOI
  162. SEGDES IDMAT
  163. SEGSUP MLENTI
  164. SEGDES MINC
  165. *
  166. * Normal termination
  167. *
  168. RETURN
  169. *
  170. * End of CH2VEC
  171. *
  172. END
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  

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