Télécharger combt1.eso

Retour à la liste

Numérotation des lignes :

  1. C COMBT1 SOURCE PV 11/03/08 21:15:15 6888
  2. SUBROUTINE COMBT1 (IPCHP1,IPTABL,COMBIN,IPCHP2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * C O M B T 1
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * EFFECTUER LA COMBINAISON LINEAIRE DE CHPOINTS CONSIGNES DANS UNE
  14. * TABLE, INDICES PAR DES POINTS.
  15. *
  16. * MODE D'APPEL:
  17. * -------------
  18. *
  19. * CALL COMBT1 (IPCHP1,IPTABL,COMBIN,IPCHP2)
  20. *
  21. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  22. * -----------
  23. *
  24. * IPCHP1 ENTIER (E) POINTEUR SUR LE CHPOINT DES COEFFICIENTS DE
  25. * PONDERATION (VOIR LE SOUS-PROGRAMME
  26. * "COMBTA" OU L'OPERATEUR "COMBTABLE" POUR LE
  27. * DETAIL DE SON CONTENU).
  28. * IPTABL ENTIER (E) POINTEUR SUR LA TABLE DES CHPOINTS.
  29. * COMBIN SUBROUT. (E) SOUS-PROGRAMME DE COMBINAISON LINEAIRE DE
  30. * 2 CHPOINTS. 5 ARGUMENTS:
  31. * - CHPOINT N.1 ,
  32. * - REEL D.P. N.1 ,
  33. * - CHPOINT N.2 ,
  34. * - REEL D.P. N.2 ,
  35. * - CHPOINT COMBINAISON LINEAIRE.
  36. * IPCHP2 ENTIER (S) POINTEUR SUR LE CHPOINT COMBINE.
  37. *
  38. * AUTEUR, DATE DE CREATION:
  39. * -------------------------
  40. *
  41. * PASCAL MANIGOT 30 MAI 1985
  42. *
  43. * LANGAGE:
  44. * --------
  45. *
  46. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
  47. *
  48. ************************************************************************
  49. *
  50. -INC CCOPTIO
  51. -INC SMCHPOI
  52. -INC SMELEME
  53. -INC SMTABLE
  54. -INC SMVECTD
  55. *
  56. LOGICAL FIRST,LBID
  57. CHARACTER*1 CBID
  58. EXTERNAL COMBIN
  59. *
  60. *
  61.  
  62. FIRST = .TRUE.
  63. MCHPOI = IPCHP1
  64. SEGACT,MCHPOI
  65. *
  66. NSOUPO = IPCHP(/1)
  67. DO 100 IB100=1,NSOUPO
  68. *
  69. MSOUPO = IPCHP(IB100)
  70. SEGACT,MSOUPO
  71. NC = NOCOMP(/2)
  72. IF (NC .NE. 1) THEN
  73. * LE CHPOINT DES COEFFICIENTS DE PONDERATION A PLUSIEURS
  74. * COMPOSANTES: ON NE SAIT PAS QUOI EN FAIRE.
  75. NUMERR = 180
  76. CALL ERREUR (NUMERR)
  77. RETURN
  78. END IF
  79. *
  80. MELEME = IGEOC
  81. SEGACT,MELEME
  82. NBNN = NUM(/1)
  83. IF (NBNN .NE. 1) THEN
  84. * ON NE COMPREND PAS QUE L'OBJET "MAILLAGE" NE CONTIENNE PAS
  85. * DES ELEMENTS A 1 SEUL NOEUD.
  86. MOTERR(1:8) = '"COMBT1"'
  87. NUMERR = 224
  88. CALL ERREUR (NUMERR)
  89. RETURN
  90. END IF
  91. *
  92. MPOVAL = IPOVAL
  93. SEGACT,MPOVAL
  94. NBPOIN = VPOCHA(/1)
  95. NBELEM = NUM(/2)
  96. IF (NBPOIN .NE. NBELEM) THEN
  97. * TYPE DE RELATION ENTRE LE 'CHPOINT' ET SON SUPPORT INCOMPRIS
  98. MOTERR(1:8) = '"COMBT1"'
  99. NUMERR = 224
  100. CALL ERREUR (NUMERR)
  101. RETURN
  102. END IF
  103. *
  104. mtable=iptabl
  105. segact mtable,mtab1
  106. DO 110 IB110=1,NBPOIN
  107. INDICE = NUM(1,IB110)
  108. do iou=1,mlotab
  109. if(mtabii(iou).eq.indice) go to 32
  110. enddo
  111. call erreur(5)
  112. 32 continue
  113. ipchp3=mtabiv(iou)
  114. mvect1= mtab1.mtabiv(iou)
  115. INDICE = NUM(1,IB110)
  116. write(6,*) ib110 ,'ieme point numero ' , indice
  117. * CALL ACCTAB (IPTABL,'POINT',IBID,XBID,CBID,LBID,INDICE
  118. * & ,'CHPOINT',IBID,XBID,CBID,LBID,IPCHP3)
  119. * IF (IERR .NE. 0) RETURN
  120. * segact mvect1
  121. COEFF3 = VPOCHA(IB110,1)
  122. IF (FIRST) THEN
  123. inc=mvect1.vectbb(/1)
  124. segini,mvect3
  125. do iau=1,mvect1.vectbb(/1)
  126. mvect3.vectbb(iau)=mvect1.vectbb(iau)*coeff3
  127. enddo
  128. FIRST = .FALSE.
  129. * MULTPL = 1
  130. * CALL MUCHPO (IPCHP3,COEFF3, IPCHP2,MULTPL)
  131. * IF (IERR .NE. 0) RETURN
  132. ELSE
  133. do iau=1,inc
  134. mvect3.vectbb(iau)=mvect3.vectbb(iau)+
  135. $ coeff3*mvect1.vectbb(iau)
  136. enddo
  137.  
  138. * COEFF2 = 1.D0
  139. * CALL COMBIN (IPCHP2,COEFF2,IPCHP3,COEFF3, IPCHP9)
  140. * IF (IERR .NE. 0) RETURN
  141. * CALL DTCHPO (IPCHP2)
  142. * IPCHP2 = IPCHP9
  143. END IF
  144. *
  145. 110 CONTINUE
  146. *** call crech2(ipchp2,mvect3,mvecri,1)
  147. *** segsup mvect3
  148. segdes mtable,mtab1
  149. * END DO
  150. *
  151. SEGDES,MELEME
  152. SEGDES,MPOVAL
  153. SEGDES,MSOUPO
  154. *
  155. 100 CONTINUE
  156. * END DO
  157. *
  158. SEGDES,MCHPOI
  159. *
  160. END
  161.  
  162.  
  163.  
  164.  
  165.  

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