Télécharger evol.eso

Retour à la liste

Numérotation des lignes :

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

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