Télécharger diad.eso

Retour à la liste

Numérotation des lignes :

diad
  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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMEVOLL
  32. -INC SMLREEL
  33. C
  34. POINTEUR IPSIG.MLREEL,IPRES.MLREEL
  35. C
  36. PARAMETER (NMOCLE=3)
  37. CHARACTER*4 MOTCLE(NMOCLE)
  38. DATA MOTCLE/'DIRE','INVE','IVIN'/
  39. C
  40. C DEFAUT TRANSFORMATION DIRECTE
  41. C
  42. LDIRE=.TRUE.
  43. LINTE=.FALSE.
  44. C
  45. C LECTURE DE L'OBJET LISTREEL CONTENANT LE SIGNAL
  46. C
  47. CALL LIROBJ('LISTREEL',IPSIG,1,IRET1)
  48. IF(IRET1.EQ.0) RETURN
  49. C
  50. C LECTURE DES OPTIONS
  51. C
  52. CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  53. IF(IVAL.EQ.0)GOTO 9
  54. GOTO(2,3,4),IVAL
  55. C ---> "TYPE"
  56. 2 LDIRE=.TRUE.
  57. GOTO 9
  58. 3 LDIRE=.FALSE.
  59. LINTE=.FALSE.
  60. GOTO 9
  61. 4 LDIRE=.FALSE.
  62. LINTE=.TRUE.
  63. GOTO 9
  64. 9 CONTINUE
  65. C
  66. IF(IERR.NE.0) RETURN
  67. C
  68. C DIMENSION DES TABLEAUX
  69. C
  70. SEGACT IPSIG
  71. JG=IPSIG.PROG(/1)
  72. C
  73. IF(LDIRE)THEN
  74. JG=(JG+1)/2
  75. ELSE
  76. JG=JG*2-MOD(JG,2)
  77. ENDIF
  78. C
  79. C CREATION DE L'OBJET RESULTAT
  80. C
  81. SEGINI IPRES
  82. C
  83. IF(LDIRE)THEN
  84. DO 15 IE1=1,JG
  85. IPRES.PROG(IE1)=IPSIG.PROG(2*(IE1-1)+1)
  86. 15 CONTINUE
  87. ELSE
  88. IF(LINTE)THEN
  89. XNEXT=IPSIG.PROG(1)
  90. DO 20 IE1=1,JG/2-1+MOD(JG,2)
  91. X =XNEXT
  92. XNEXT=IPSIG.PROG(IE1+1)
  93. IPRES.PROG(2*(IE1-1)+1)= X
  94. IPRES.PROG(2*(IE1-1)+2)=(X+XNEXT)/2
  95. 20 CONTINUE
  96. IF (MOD(JG,2).EQ.0)THEN
  97. IPRES.PROG(JG-1)= XNEXT
  98. IPRES.PROG(JG) =(3*XNEXT-X)/2
  99. ELSE
  100. IPRES.PROG(JG) = XNEXT
  101. ENDIF
  102. ELSE
  103. DO 25 IE1=1,JG/2
  104. IPRES.PROG(2*(IE1-1)+1)=IPSIG.PROG(IE1)
  105. IPRES.PROG(2*(IE1-1)+2)=0.D0
  106. 25 CONTINUE
  107. IF (MOD(JG,2).NE.0)THEN
  108. IPRES.PROG(JG) = IPSIG.PROG((JG+1)/2)
  109. ENDIF
  110. ENDIF
  111. ENDIF
  112. C
  113. SEGDES IPSIG
  114. SEGDES IPRES
  115. C
  116. CALL ECROBJ('LISTREEL',IPRES)
  117. RETURN
  118. END
  119.  
  120.  
  121.  
  122.  
  123.  

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