Télécharger la plaquette Cast3M


fr en

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