Télécharger rlexf2.eso

Retour à la liste

Numérotation des lignes :

  1. C RLEXF2 SOURCE PV 09/03/12 21:33:53 6325
  2. SUBROUTINE RLEXF2(MCHCEN,MCHLIM,MCHELM,MCHFAC)
  3. C
  4. C**** Variables de COOPTIO
  5. C
  6. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  7. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  8. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  9. C & ,IECHO, IIMPI, IOSPI
  10. C & ,IDIM
  11. C & ,MCOORD
  12. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  13. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  14. C & ,NORINC,NORVAL,NORIND,NORVAD
  15. C & ,NUCROU, IPSAUV
  16. C
  17. IMPLICIT INTEGER(I-N)
  18. -INC CCOPTIO
  19. INTEGER NBNN, NBELEM
  20. -INC SMELEME
  21. -INC SMCHAML
  22. C
  23. -INC SMCHPOI
  24. POINTEUR MCHCEN.MCHPOI, MCHLIM.MCHPOI, MCHFAC.MCHPOI
  25. POINTEUR MPOCEN.MPOVAL, MPOLIM.MPOVAL, MPOFAC.MPOVAL
  26. C
  27. -INC SMLENTI
  28. POINTEUR MLECEN.MLENTI, MLELIM.MLENTI, MLEFAC.MLENTI
  29. C
  30. INTEGER IGEOM, NCOM, NBSOUS, ISOUS, IELEM, NGF, NLF, NGV, NLV
  31. & ,IVOI, ICOM, I2
  32. REAL*8 VAL
  33. CHARACTER*8 NOM1
  34. C
  35. LOGICAL LOGCEN
  36. CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM)
  37. IF(IERR.NE.0)GOTO 9999
  38. NCOM=MPOCEN.VPOCHA(/2)
  39. C En LICHT SEGACT*MOD MPOCEN
  40. CALL KRIPAD(IGEOM,MLECEN)
  41. IF(IERR.NE.0)GOTO 9999
  42. C
  43. C**** En KRIPAD
  44. C SEGACT IGEOM
  45. C SEGINI MLECEN
  46. C
  47. MELEME=IGEOM
  48. SEGDES MELEME
  49. C
  50. IF(MCHLIM.GT.0)THEN
  51. CALL LICHT(MCHLIM,MPOLIM,NOM1,IGEOM)
  52. IF(IERR.NE.0)GOTO 9999
  53. C En LICHT SEGACT*MOD MPOLIM
  54. CALL KRIPAD(IGEOM,MLELIM)
  55. IF(IERR.NE.0)GOTO 9999
  56. C
  57. C**** En KRIPAD
  58. C SEGACT IGEOM
  59. C SEGINI MLELIM
  60. C
  61. MELEME=IGEOM
  62. SEGDES MELEME
  63. ELSE
  64. MPOLIM=0
  65. MLELIM=0
  66. ENDIF
  67. C
  68. CALL LICHT(MCHFAC,MPOFAC,NOM1,IGEOM)
  69. IF(IERR.NE.0)GOTO 9999
  70. C En LICHT SEGACT*MOD MPOFAC
  71. CALL KRIPAD(IGEOM,MLEFAC)
  72. IF(IERR.NE.0)GOTO 9999
  73. C
  74. C**** En KRIPAD
  75. C SEGACT IGEOM
  76. C SEGINI MLEFAC
  77. C
  78. MELEME=IGEOM
  79. SEGDES MELEME
  80. C
  81. SEGACT MCHELM
  82. NBSOUS=MCHELM.IMACHE(/1)
  83. C
  84. DO ISOUS=1,NBSOUS,1
  85. MELEME=MCHELM.IMACHE(ISOUS)
  86. MCHAM1=MCHELM.ICHAML(ISOUS)
  87. SEGACT MELEME
  88. SEGACT MCHAM1
  89. MELVA1=MCHAM1.IELVAL(1)
  90. MELVA2=MCHAM1.IELVAL(2)
  91. SEGACT MELVA1
  92. SEGACT MELVA2
  93. NOM1=MCHAM1.NOMCHE(1)
  94. IF(NOM1 .NE. 'alphax ')THEN
  95. WRITE(IOIMP,*) NOM1, '!=', 'alphax '
  96. C 21 2
  97. C Données incompatibles
  98. CALL ERREUR(21)
  99. GOTO 9999
  100. ENDIF
  101. NOM1=MCHAM1.NOMCHE(2)
  102. IF(NOM1 .NE. 'alphay ')THEN
  103. WRITE(IOIMP,*) NOM1, '!=', 'alphay '
  104. C 21 2
  105. C Données incompatibles
  106. CALL ERREUR(21)
  107. GOTO 9999
  108. ENDIF
  109. IF(IDIM.EQ.3)THEN
  110. MELVA3=MCHAM1.IELVAL(3)
  111. SEGACT MELVA3
  112. NOM1=MCHAM1.NOMCHE(3)
  113. IF(NOM1 .NE. 'alphaz ')THEN
  114. WRITE(IOIMP,*) NOM1, '!=', 'alphaz '
  115. C 21 2
  116. C Données incompatibles
  117. CALL ERREUR(21)
  118. GOTO 9999
  119. ENDIF
  120. ENDIF
  121. C
  122. NBNN=MELEME.NUM(/1)
  123. NBELEM=MELEME.NUM(/2)
  124. C
  125. DO IELEM=1,NBELEM,1
  126. NGF=MELEME.NUM(1,IELEM)
  127. NLF=MLEFAC.LECT(NGF)
  128. IF(NLF.EQ.0)THEN
  129. WRITE (IOIMP,*) 'subroutine rlexf2.eso'
  130. CALL ERREUR(5)
  131. GOTO 9999
  132. ENDIF
  133. DO IVOI=2,NBNN,1
  134. NGV=MELEME.NUM(IVOI,IELEM)
  135. NLV=MLECEN.LECT(NGV)
  136. IF(NLV.NE.0)THEN
  137. LOGCEN=.TRUE.
  138. ELSE
  139. LOGCEN=.FALSE.
  140. NLV=MLELIM.LECT(NGV)
  141. IF(NLV.EQ.0)THEN
  142. WRITE(IOIMP,*) 'subroutine rlexf2.eso'
  143. CALL ERREUR(5)
  144. GOTO 9999
  145. ENDIF
  146. ENDIF
  147. DO ICOM = 1, NCOM, 1
  148. IF(LOGCEN)THEN
  149. VAL=MPOCEN.VPOCHA(NLV,ICOM)
  150. ELSE
  151. VAL=MPOLIM.VPOCHA(NLV,ICOM)
  152. ENDIF
  153. I2=(ICOM-1)*IDIM+1
  154. MPOFAC.VPOCHA(NLF,I2)=MPOFAC.VPOCHA(NLF,I2)+
  155. & (MELVA1.VELCHE(IVOI,IELEM)*VAL)
  156. MPOFAC.VPOCHA(NLF,I2+1)=MPOFAC.VPOCHA(NLF,I2+1)+
  157. & (MELVA2.VELCHE(IVOI,IELEM)*VAL)
  158. IF(IDIM.EQ.3)
  159. & MPOFAC.VPOCHA(NLF,I2+2)=MPOFAC.VPOCHA(NLF,I2+2)+
  160. & (MELVA3.VELCHE(IVOI,IELEM)*VAL)
  161. ENDDO
  162. ENDDO
  163. ENDDO
  164. SEGDES MELEME
  165. SEGDES MCHAM1
  166. SEGDES MELVA1
  167. SEGDES MELVA2
  168. IF(IDIM.EQ.3) SEGDES MELVA3
  169. ENDDO
  170. C
  171. SEGDES MCHELM
  172. IF(MPOLIM .NE. 0) THEN
  173. SEGDES MPOLIM
  174. SEGSUP MLELIM
  175. ENDIF
  176. SEGDES MPOFAC
  177. SEGDES MPOCEN
  178. SEGSUP MLECEN
  179. SEGSUP MLEFAC
  180. C
  181. 9999 RETURN
  182. END
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  

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