Télécharger adchfl.eso

Retour à la liste

Numérotation des lignes :

  1. C ADCHFL SOURCE CB215821 16/03/14 21:15:01 8854
  2.  
  3. SUBROUTINE ADCHFL(IPCHE1,XFLO1,IPLMO1,CHA8b,CHA8c,IPCHE2,IEPS)
  4.  
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C BUT: Faire '+' ou '-' entre un CHAMELEM et un FLOTTANT
  8. C Lorsqu'il n'y a qu'une composante on effectue l'operation sur la
  9. C seule composante. Sinon le LISTMOT devient necessaire pour savoir
  10. C sur quelle composante on effectue l'operation
  11. C
  12. C Entree : IPCHE1 : CHAMELEM
  13. C XFLO1 : FLOTTANT
  14. C IPLMO1 : LISTMOT des composantes sur lesquelles on fait l'operation
  15. C CHA8b : Nom de IPCHE1 s'il en a un
  16. C CHA8c : Nom de IPLMO1 s'il en a un
  17. C IEPS : 0 ==> Soustraction IPCHE1 - XFLO1
  18. C 1 ==> Addition IPCHE1 + XFLO1 ou XFLO1 + IPCHE1
  19. C 2 ==> Soustraction XFLO1 - IPCHE1
  20. C
  21. C Auteur : Clement BERTHINIER
  22. C Mars 2016
  23. C
  24. C Liste des Corrections :
  25. C
  26. C Appele par : OPERAD, OPERSO
  27. C
  28. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  29.  
  30.  
  31. IMPLICIT INTEGER(I-N)
  32. IMPLICIT REAL*8 (A-H,O-Z)
  33.  
  34. CHARACTER*8 CHA8a,CHA8b,CHA8c
  35. LOGICAL BMO
  36.  
  37. -INC CCOPTIO
  38. -INC SMCHAML
  39. -INC SMCOORD
  40. -INC SMLMOTS
  41. -INC SMLENTI
  42.  
  43. BMO = .FALSE.
  44. MOTERR=' '
  45.  
  46. MCHEL1 = IPCHE1
  47. SEGACT,MCHEL1
  48. SEGINI,MCHELM=MCHEL1
  49. IPCHE2=MCHELM
  50. N1 = MCHEL1.ICHAML(/1)
  51. IF (ICHAML .EQ. 0) THEN
  52. RETURN
  53. ENDIF
  54.  
  55. IF (IPLMO1 .NE. 0) THEN
  56. MLMOTS = IPLMO1
  57. SEGACT,MLMOTS
  58. JGM = MOTS(/2)
  59. JG = JGM
  60. SEGINI,MLENTI
  61. ENDIF
  62.  
  63. DO 100 IA=1,N1
  64. MCHAM1= MCHEL1.ICHAML(IA)
  65. SEGACT,MCHAM1
  66. SEGINI,MCHAML=MCHAM1
  67. ICHAML(IA)=MCHAML
  68. N2 =MCHAM1.IELVAL(/1)
  69.  
  70. IF (N2 .GE. 1) THEN
  71. DO 101 ICOMP=1,N2
  72.  
  73.  
  74. CHA8a=MCHAM1.NOMCHE(ICOMP)
  75.  
  76. C LISTMOTS obligatoire si N2 > 1
  77. IF (N2 .GE. 2) THEN
  78. IF ((IPLMO1 .EQ. 0) .OR. (JGM .EQ. 0)) THEN
  79. MOTERR(1:8)='LISTMOTS'
  80. CALL ERREUR(37)
  81. ELSE
  82. C Recherche de la COMPOSANTE du meme nom dans le LISTMOTS
  83. BMO = .FALSE.
  84. IPLAC=0
  85. DO IMO = 1,JGM
  86. IF (MOTS(IMO) .EQ. CHA8a) THEN
  87. C PRINT *,'COMPOSANTE TROUVEE :',MOTS(IMO)
  88. LECT(IMO) =LECT(IMO )+1
  89. IF (.NOT. BMO) THEN
  90. IPLAC = IMO
  91. ELSE
  92. LECT(IPLAC)=LECT(IPLAC)+1
  93. ENDIF
  94. BMO = .TRUE.
  95. ENDIF
  96. ENDDO
  97. IF (BMO) GOTO 102
  98. GOTO 101
  99. ENDIF
  100. ENDIF
  101.  
  102. 102 CONTINUE
  103.  
  104. MELVA1=MCHAM1.IELVAL(ICOMP)
  105. SEGACT,MELVA1
  106. N1PTEL=MELVA1.VELCHE(/1)
  107. N1EL =MELVA1.VELCHE(/2)
  108. N2PTEL=0
  109. N2EL =0
  110. SEGINI,MELVAL
  111. IELVAL(ICOMP)=MELVAL
  112.  
  113. IF (N1PTEL .NE. 0) THEN
  114. IF (IEPS .EQ. 0) THEN
  115. DO IGAU=1,N1PTEL
  116. DO IB=1,N1EL
  117. VELCHE(IGAU,IB)= MELVA1.VELCHE(IGAU,IB) - XFLO1
  118. ENDDO
  119. ENDDO
  120.  
  121. ELSEIF (IEPS .EQ. 1) THEN
  122. DO IGAU=1,N1PTEL
  123. DO IB=1,N1EL
  124. VELCHE(IGAU,IB)= MELVA1.VELCHE(IGAU,IB) + XFLO1
  125. ENDDO
  126. ENDDO
  127.  
  128. ELSEIF (IEPS .EQ. 2) THEN
  129. DO IGAU=1,N1PTEL
  130. DO IB=1,N1EL
  131. VELCHE(IGAU,IB)=-MELVA1.VELCHE(IGAU,IB) + XFLO1
  132. ENDDO
  133. ENDDO
  134.  
  135. ELSE
  136. CALL ERREUR(21)
  137. RETURN
  138. ENDIF
  139.  
  140. ELSE
  141. CALL ERREUR(21)
  142. RETURN
  143. ENDIF
  144.  
  145. SEGDES,MELVA1,MELVAL
  146. 101 CONTINUE
  147. ENDIF
  148.  
  149. SEGDES,MCHAM1,MCHAML
  150. 100 CONTINUE
  151.  
  152. IF (IPLMO1 .NE. 0) THEN
  153. C Verification que toutes les composantes demandees ont ete trouvees
  154. DO IMO = 1,JGM
  155. IF (LECT(IMO) .EQ. 0) THEN
  156. CHA8a = MOTS(IMO)
  157. MOTERR(1:4 )=CHA8a(1:4)
  158. MOTERR(5:12)=CHA8b
  159. CALL ERREUR(77)
  160. SEGSUP,MLENTI
  161. SEGDES,MCHEL1,MCHELM,MLMOTS
  162. RETURN
  163.  
  164. ELSEIF (LECT(IMO) .GT. 1) THEN
  165. CHA8a = MOTS(IMO)
  166. MOTERR(1:4 )=CHA8a(1:4)
  167. MOTERR(5:12)=CHA8c
  168. CALL ERREUR(1051)
  169. SEGSUP,MLENTI
  170. SEGDES,MCHEL1,MCHELM,MLMOTS
  171. RETURN
  172. ENDIF
  173. ENDDO
  174.  
  175. SEGDES,MLMOTS
  176. SEGSUP,MLENTI
  177. ENDIF
  178. SEGDES,MCHEL1,MCHELM
  179.  
  180. RETURN
  181. END
  182.  
  183.  
  184.  

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