Télécharger evol.eso

Retour à la liste

Numérotation des lignes :

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

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