Télécharger evol.eso

Retour à la liste

Numérotation des lignes :

  1. C EVOL SOURCE CB215821 19/07/30 21:16:11 10273
  2. SUBROUTINE EVOL
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C
  7. C OPERATEUR EVOL : EVOLUTION D'UN PARAMETRE EN FONCTION D'UN AUTRE
  8. C IL EXISTE 7 OPTIONS (VOIR SYNTAXES DANS LES ROUTINES CORRESPONDANTES)
  9. C
  10. C :---------------------:---------------------------:
  11. C : OPTION : ROUTINE :
  12. C :---------------------:---------------------------:
  13. C : SOLU : EVSOLU :
  14. C : MANU : EVMANU :
  15. C : RECO : EVRECO :
  16. C : PJBA : EVPJBA :
  17. C : COMP : EVCOMP :
  18. C : CHPO : EVCHPO :
  19. C : TEMP : EVTEMP :
  20. C :---------------------:---------------------------:
  21. C
  22. C ECRIT PAR FARVACQUE LE 22/10/85
  23. C=======================================================================
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCGEOME
  28. -INC SMLMOTS
  29. -INC SMLENTI
  30. *
  31. PARAMETER(NDCLR=14)
  32. INTEGER IDCLR(NDCLR)
  33. DATA IDCLR/0,1,2,3,4,5,6,9,10,11,12,13,14,15/
  34. *
  35. PARAMETER(LMOOPT=7)
  36. CHARACTER*4 MOOPT(LMOOPT)
  37. DATA MOOPT/'SOLU','MANU','RECO','PJBA','COMP','CHPO','TEMP'/
  38. *
  39. CHARACTER*4 CHA4
  40. CHARACTER*8 CHA8
  41. POINTEUR LCOUL.MLENTI
  42. *
  43. *
  44. * ======================
  45. * COULEUR(S) DES COURBES
  46. * ======================
  47. *
  48. * RECHERCHE SOUS FORME D'UN OBJET DE TYPE MOT OU LISTMOTS
  49. CALL LIRMOT(NCOUL,NBCOUL,IMCOUL,0)
  50. *
  51. * UN MOT A ETE FOURNI => TOUTES LES COURBES SONT DE LA MEME COULEUR
  52. IF (IMCOUL.NE.0) THEN
  53. ICOUL=IMCOUL-1
  54. JG=1
  55. SEGINI,LCOUL
  56. LCOUL.LECT(1)=ICOUL
  57. *
  58. ELSE
  59.  
  60. ILCOUL=0
  61. CALL QUETYP(CHA8,1,IRET)
  62.  
  63. * UN LISTMOTS A ETE FOURNI
  64. IF (CHA8.EQ.'LISTMOTS') THEN
  65. ILCOUL=1
  66. CALL LIROBJ('LISTMOTS',MLMOTS,1,IRET)
  67. *
  68. * VERIFICATION DU NOMBRE DE COULEURS SPECIFIEES
  69. SEGACT,MLMOTS
  70. NCLR=MOTS(/2)
  71. IF (NCLR.EQ.0) THEN
  72. MOTERR(1:8)='LISTMOTS'
  73. CALL ERREUR(1027)
  74. RETURN
  75. ENDIF
  76. *
  77. * VERIFICATION DES VALEURS FOURNIES ET TRANSFORMATION EN
  78. * LISTENTI
  79. JG=NCLR
  80. SEGINI,LCOUL
  81. NB1=0
  82. DO K=1,NCLR
  83. CHA4=MOTS(K)
  84. CALL CHRMOT(NCOUL,NBCOUL,CHA4,ICLR)
  85. IF (ICLR.EQ.0) THEN
  86. MOTERR(1:4)=CHA4
  87. CALL ERREUR(1055)
  88. RETURN
  89. ENDIF
  90. LCOUL.LECT(K)=ICLR-1
  91. ENDDO
  92. *
  93. * NI MOT NI LISTMOTS : UNE LISTE PAR DEFAUT EST UTILISEE
  94. * (COMMENCANT TOUJOURS PAR IDCOUL)
  95. ELSE
  96. JG=NDCLR
  97. SEGINI,LCOUL
  98. IDEF=0
  99. DO K=1,NDCLR
  100. IF (IDCLR(K).EQ.IDCOUL) IDEF=K
  101. ENDDO
  102. IF (IDEF.EQ.0) THEN
  103. LCOUL.LECT(1)=IDCOUL
  104. DO K=1,NDCLR-1
  105. LCOUL.LECT(K+1)=IDCLR(K)
  106. ENDDO
  107. ELSE
  108. DO K=1,NDCLR
  109. LCOUL.LECT(K)=IDCLR(MOD(K+IDEF-2,NDCLR)+1)
  110. ENDDO
  111. ENDIF
  112. ENDIF
  113. *
  114. ICOUL=LCOUL.LECT(1)
  115. ENDIF
  116. *
  117. *
  118. * ===============================================================
  119. * MOT-CLE DE L'OPERATEUR EVOL ET BRANCHEMENT VERS LES SUBROUTINES
  120. * ===============================================================
  121. *
  122. CALL LIRMOT(MOOPT,-LMOOPT,IVAL,1)
  123. IF (IERR.NE.0) GOTO 5000
  124. GOTO(1,2,3,4,5,6,7),IVAL
  125. *
  126. 1 CONTINUE
  127. CALL EVSOLU(ICOUL)
  128. GOTO 5000
  129. *
  130. 2 CONTINUE
  131. CALL EVMANU(ICOUL)
  132. GOTO 5000
  133. *
  134. 3 CONTINUE
  135. CALL EVRECO(LCOUL)
  136. GOTO 5000
  137. *
  138. 4 CONTINUE
  139. CALL EVPJBA(LCOUL)
  140. GOTO 5000
  141. *
  142. 5 CONTINUE
  143. CALL EVCOMP(ICOUL)
  144. GOTO 5000
  145. *
  146. 6 CONTINUE
  147. CALL EVCHPO(ICOUL)
  148. GOTO 5000
  149. *
  150. 7 CONTINUE
  151. CALL EVTEMP(LCOUL)
  152. GO TO 5000
  153. *
  154. 5000 CONTINUE
  155. SEGSUP,LCOUL
  156. END
  157.  
  158.  
  159.  

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