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. -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. *
  91. * NI MOT NI LISTMOTS : UNE LISTE PAR DEFAUT EST UTILISEE
  92. * (COMMENCANT TOUJOURS PAR IDCOUL)
  93. ELSE
  94. JG=NDCLR
  95. SEGINI,LCOUL
  96. IDEF=0
  97. DO K=1,NDCLR
  98. IF (IDCLR(K).EQ.IDCOUL) IDEF=K
  99. ENDDO
  100. IF (IDEF.EQ.0) THEN
  101. LCOUL.LECT(1)=IDCOUL
  102. DO K=1,NDCLR-1
  103. LCOUL.LECT(K+1)=IDCLR(K)
  104. ENDDO
  105. ELSE
  106. DO K=1,NDCLR
  107. LCOUL.LECT(K)=IDCLR(MOD(K+IDEF-2,NDCLR)+1)
  108. ENDDO
  109. ENDIF
  110. ENDIF
  111. *
  112. ICOUL=LCOUL.LECT(1)
  113. ENDIF
  114. *
  115. *
  116. * ===============================================================
  117. * MOT-CLE DE L'OPERATEUR EVOL ET BRANCHEMENT VERS LES SUBROUTINES
  118. * ===============================================================
  119. *
  120. CALL LIRMOT(MOOPT,-LMOOPT,IVAL,1)
  121. IF (IERR.NE.0) GOTO 5000
  122. GOTO(1,2,3,4,5,6,7),IVAL
  123. *
  124. 1 CONTINUE
  125. CALL EVSOLU(ICOUL)
  126. GOTO 5000
  127. *
  128. 2 CONTINUE
  129. CALL EVMANU(ICOUL)
  130. GOTO 5000
  131. *
  132. 3 CONTINUE
  133. CALL EVRECO(LCOUL)
  134. GOTO 5000
  135. *
  136. 4 CONTINUE
  137. CALL EVPJBA(LCOUL)
  138. GOTO 5000
  139. *
  140. 5 CONTINUE
  141. CALL EVCOMP(ICOUL)
  142. GOTO 5000
  143. *
  144. 6 CONTINUE
  145. CALL EVCHPO(ICOUL)
  146. GOTO 5000
  147. *
  148. 7 CONTINUE
  149. CALL EVTEMP(LCOUL)
  150. GO TO 5000
  151. *
  152. 5000 CONTINUE
  153. SEGSUP,LCOUL
  154. END
  155.  
  156.  
  157.  

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