Télécharger diad.eso

Retour à la liste

Numérotation des lignes :

  1. C DIAD SOURCE CHAT 05/01/12 22:49:37 5004
  2. *$$$$ DIAD
  3. C DIAD SOURCE ISPRA 90/08/02
  4. SUBROUTINE DIAD
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. LOGICAL LDIRE,LINTE
  8. C
  9. C=======================================================================
  10. C = CALCUL DIADIQUE =
  11. C = =
  12. C = SYNTAXE : =
  13. C = =
  14. C = LIST1 = DIAD LIST2 (TYPE) ; =
  15. C = =
  16. C = =
  17. C = LIST2 : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL A TRAITER=
  18. C = LIST1 : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL REPONSE =
  19. C = =
  20. C = TYPE : 'DIRE' OU 'INVE' OU 'IVIN' (DEFAUT 'DIRE') =
  21. C = =
  22. C = =
  23. C = CREATION : 90/08/02 =
  24. C = MODIFICATION: 90/09/14 =
  25. C = PROGRAMMEUR : PEG =
  26. C=======================================================================
  27. C
  28. -INC CCOPTIO
  29. -INC SMEVOLL
  30. -INC SMLREEL
  31. C
  32. POINTEUR IPSIG.MLREEL,IPRES.MLREEL
  33. C
  34. PARAMETER (NMOCLE=3)
  35. CHARACTER*4 MOTCLE(NMOCLE)
  36. DATA MOTCLE/'DIRE','INVE','IVIN'/
  37. C
  38. C DEFAUT TRANSFORMATION DIRECTE
  39. C
  40. LDIRE=.TRUE.
  41. LINTE=.FALSE.
  42. C
  43. C LECTURE DE L'OBJET LISTREEL CONTENANT LE SIGNAL
  44. C
  45. CALL LIROBJ('LISTREEL',IPSIG,1,IRET1)
  46. IF(IRET1.EQ.0) RETURN
  47. C
  48. C LECTURE DES OPTIONS
  49. C
  50. CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  51. IF(IVAL.EQ.0)GOTO 9
  52. GOTO(2,3,4),IVAL
  53. C ---> "TYPE"
  54. 2 LDIRE=.TRUE.
  55. GOTO 9
  56. 3 LDIRE=.FALSE.
  57. LINTE=.FALSE.
  58. GOTO 9
  59. 4 LDIRE=.FALSE.
  60. LINTE=.TRUE.
  61. GOTO 9
  62. 9 CONTINUE
  63. C
  64. IF(IERR.NE.0) RETURN
  65. C
  66. C DIMENSION DES TABLEAUX
  67. C
  68. SEGACT IPSIG
  69. JG=IPSIG.PROG(/1)
  70. C
  71. IF(LDIRE)THEN
  72. JG=(JG+1)/2
  73. ELSE
  74. JG=JG*2-MOD(JG,2)
  75. ENDIF
  76. C
  77. C CREATION DE L'OBJET RESULTAT
  78. C
  79. SEGINI IPRES
  80. C
  81. IF(LDIRE)THEN
  82. DO 15 IE1=1,JG
  83. IPRES.PROG(IE1)=IPSIG.PROG(2*(IE1-1)+1)
  84. 15 CONTINUE
  85. ELSE
  86. IF(LINTE)THEN
  87. XNEXT=IPSIG.PROG(1)
  88. DO 20 IE1=1,JG/2-1+MOD(JG,2)
  89. X =XNEXT
  90. XNEXT=IPSIG.PROG(IE1+1)
  91. IPRES.PROG(2*(IE1-1)+1)= X
  92. IPRES.PROG(2*(IE1-1)+2)=(X+XNEXT)/2
  93. 20 CONTINUE
  94. IF (MOD(JG,2).EQ.0)THEN
  95. IPRES.PROG(JG-1)= XNEXT
  96. IPRES.PROG(JG) =(3*XNEXT-X)/2
  97. ELSE
  98. IPRES.PROG(JG) = XNEXT
  99. ENDIF
  100. ELSE
  101. DO 25 IE1=1,JG/2
  102. IPRES.PROG(2*(IE1-1)+1)=IPSIG.PROG(IE1)
  103. IPRES.PROG(2*(IE1-1)+2)=0.D0
  104. 25 CONTINUE
  105. IF (MOD(JG,2).NE.0)THEN
  106. IPRES.PROG(JG) = IPSIG.PROG((JG+1)/2)
  107. ENDIF
  108. ENDIF
  109. ENDIF
  110. C
  111. SEGDES IPSIG
  112. SEGDES IPRES
  113. C
  114. CALL ECROBJ('LISTREEL',IPRES)
  115. RETURN
  116. END
  117.  
  118.  
  119.  
  120.  
  121.  

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