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.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMCHAML
  41. -INC SMCOORD
  42. -INC SMLMOTS
  43. -INC SMLENTI
  44.  
  45. BMO = .FALSE.
  46. MOTERR=' '
  47.  
  48. MCHEL1 = IPCHE1
  49. SEGACT,MCHEL1
  50. SEGINI,MCHELM=MCHEL1
  51. IPCHE2=MCHELM
  52. N1 = MCHEL1.ICHAML(/1)
  53. IF (ICHAML .EQ. 0) THEN
  54. RETURN
  55. ENDIF
  56.  
  57. IF (IPLMO1 .NE. 0) THEN
  58. MLMOTS = IPLMO1
  59. SEGACT,MLMOTS
  60. JGM = MOTS(/2)
  61. JG = JGM
  62. SEGINI,MLENTI
  63. ENDIF
  64.  
  65. DO 100 IA=1,N1
  66. MCHAM1= MCHEL1.ICHAML(IA)
  67. SEGACT,MCHAM1
  68. SEGINI,MCHAML=MCHAM1
  69. ICHAML(IA)=MCHAML
  70. N2 =MCHAM1.IELVAL(/1)
  71.  
  72. IF (N2 .GE. 1) THEN
  73. DO 101 ICOMP=1,N2
  74.  
  75.  
  76. CHA8a=MCHAM1.NOMCHE(ICOMP)
  77.  
  78. C LISTMOTS obligatoire si N2 > 1
  79. IF (N2 .GE. 2) THEN
  80. IF ((IPLMO1 .EQ. 0) .OR. (JGM .EQ. 0)) THEN
  81. MOTERR(1:8)='LISTMOTS'
  82. CALL ERREUR(37)
  83. ELSE
  84. C Recherche de la COMPOSANTE du meme nom dans le LISTMOTS
  85. BMO = .FALSE.
  86. IPLAC=0
  87. DO IMO = 1,JGM
  88. IF (MOTS(IMO) .EQ. CHA8a) THEN
  89. C PRINT *,'COMPOSANTE TROUVEE :',MOTS(IMO)
  90. LECT(IMO) =LECT(IMO )+1
  91. IF (.NOT. BMO) THEN
  92. IPLAC = IMO
  93. ELSE
  94. LECT(IPLAC)=LECT(IPLAC)+1
  95. ENDIF
  96. BMO = .TRUE.
  97. ENDIF
  98. ENDDO
  99. IF (BMO) GOTO 102
  100. GOTO 101
  101. ENDIF
  102. ENDIF
  103.  
  104. 102 CONTINUE
  105.  
  106. MELVA1=MCHAM1.IELVAL(ICOMP)
  107. SEGACT,MELVA1
  108. N1PTEL=MELVA1.VELCHE(/1)
  109. N1EL =MELVA1.VELCHE(/2)
  110. N2PTEL=0
  111. N2EL =0
  112. SEGINI,MELVAL
  113. IELVAL(ICOMP)=MELVAL
  114.  
  115. IF (N1PTEL .NE. 0) THEN
  116. IF (IEPS .EQ. 0) THEN
  117. DO IGAU=1,N1PTEL
  118. DO IB=1,N1EL
  119. VELCHE(IGAU,IB)= MELVA1.VELCHE(IGAU,IB) - XFLO1
  120. ENDDO
  121. ENDDO
  122.  
  123. ELSEIF (IEPS .EQ. 1) THEN
  124. DO IGAU=1,N1PTEL
  125. DO IB=1,N1EL
  126. VELCHE(IGAU,IB)= MELVA1.VELCHE(IGAU,IB) + XFLO1
  127. ENDDO
  128. ENDDO
  129.  
  130. ELSEIF (IEPS .EQ. 2) THEN
  131. DO IGAU=1,N1PTEL
  132. DO IB=1,N1EL
  133. VELCHE(IGAU,IB)=-MELVA1.VELCHE(IGAU,IB) + XFLO1
  134. ENDDO
  135. ENDDO
  136.  
  137. ELSE
  138. CALL ERREUR(21)
  139. RETURN
  140. ENDIF
  141.  
  142. ELSE
  143. CALL ERREUR(21)
  144. RETURN
  145. ENDIF
  146.  
  147. SEGDES,MELVA1,MELVAL
  148. 101 CONTINUE
  149. ENDIF
  150.  
  151. SEGDES,MCHAM1,MCHAML
  152. 100 CONTINUE
  153.  
  154. IF (IPLMO1 .NE. 0) THEN
  155. C Verification que toutes les composantes demandees ont ete trouvees
  156. DO IMO = 1,JGM
  157. IF (LECT(IMO) .EQ. 0) THEN
  158. CHA8a = MOTS(IMO)
  159. MOTERR(1:4 )=CHA8a(1:4)
  160. MOTERR(5:12)=CHA8b
  161. CALL ERREUR(77)
  162. SEGSUP,MLENTI
  163. SEGDES,MCHEL1,MCHELM,MLMOTS
  164. RETURN
  165.  
  166. ELSEIF (LECT(IMO) .GT. 1) THEN
  167. CHA8a = MOTS(IMO)
  168. MOTERR(1:4 )=CHA8a(1:4)
  169. MOTERR(5:12)=CHA8c
  170. CALL ERREUR(1051)
  171. SEGSUP,MLENTI
  172. SEGDES,MCHEL1,MCHELM,MLMOTS
  173. RETURN
  174. ENDIF
  175. ENDDO
  176.  
  177. SEGDES,MLMOTS
  178. SEGSUP,MLENTI
  179. ENDIF
  180. SEGDES,MCHEL1,MCHELM
  181.  
  182. RETURN
  183. END
  184.  
  185.  
  186.  

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