Télécharger la plaquette Cast3M


fr en

Télécharger oooadi.eso

Retour à la liste

Numérotation des lignes : 

oooadi

  1. C OOOADI    SOURCE    PV090527  26/05/07    21:15:05     12532          
  2. **      SUBROUTINE OOOADG (ISSG,TYLN,NELM,IDOB,IDOA)
  3.       SUBROUTINE OOOADI (LLL,LL2,LL1,III,II2,II1,RRR,RR8,R16,CCC,C16,
  4.      >C32,CAR,TYLN,NELM,IDOB,IDOA)
  5. C----------------------------------------------------------------------
  6. C
  7. C                   DECALAGE A GAUCHE POUR OOOYAD
  8. C              XXX(IDOB+I)=XXX(IDOA+I)  POUR : I=1,NELM
  9. C
  10. C     ISSG   POINTEUR SUR LE SEGMENT CONTENANT LA ZONE A DECALER
  11. C     IDOB   DEPLACEMENT DESTINATION DANS LE SEGMENT
  12. C     IDOA   DEPLACEMENT EMISSION    DANS LE SEGMENT
  13. C     NELM   NOMBRE D'ELEMENTS A DEPLACER
  14. C     TYLN   TYPE DES ELEMENTS DU SEGMENT (1 A 13) (LOGICAL A CHARACTER)
  15. C
  16. * avec unrolling PV 1/2020
  17.  
  18.       MACRO ,      ( LOGICAL    , LOGICAL 2  , LOGICAL 1
  19.      2             , INTEGER    , INTEGER 2  , INTEGER 1
  20.      3             , REAL       , REAL    8  , REAL   16
  21.      4             , COMPLEX    , COMPLEX16  , COMPLEX32
  22.      5             , CHARACTER  )
  23. C
  24. **    SEGMENT      , LLL(0)*L   , LL2(0)*L2  , LL1(0)*L1
  25. **    SEGMENT      , III(0)*I   , II2(0)*I2  , II1(0)*I1
  26. **    SEGMENT      , RRR(0)*R   , RR8(0)* D  , R16(0)* Q
  27. **    SEGMENT      , CCC(0)*C   , C16(0)*CD  , C32(0)*CQ
  28. **    SEGMENT /SCH/ (CAR   *(1))
  29.  
  30. **    EQUIVALENCE  ( LLL        , LL2        , LL1       ,ISEG)
  31. **    EQUIVALENCE  ( III        , II2        , II1       ,ISEG)
  32. **    EQUIVALENCE  ( RRR        , RR8        , R16       ,ISEG)
  33. **    EQUIVALENCE  ( CCC        , C16        , C32       ,ISEG)
  34. **    EQUIVALENCE  ( SCH                                 ,ISEG)
  35. C
  36.       logical lll(*)
  37.       logical*2 ll2(*)
  38.       logical*1 ll1(*)
  39.       integer iii(*)
  40.       integer*2 ii2(*)
  41.       integer*1 ii1(*)
  42.       real rrr(*)
  43.       real*8 rr8(*)
  44. **    real*16 r16(*)
  45.       complex ccc(*)
  46.       complex*16 c16(*)
  47.       complex*16 c32(*)
  48.       character*(*) car 
  49.  
  50.       CHARACTER*1 H1
  51.       INTEGER     TYLN
  52.       SEGMENT ,   ISSG(0)*I   , ISEG(0)*I
  53. C
  54. **    ISEG=ISSG
  55.  
  56.       CASE , TYLN
  57.  
  58.       WHEN , LOGICAL
  59.  
  60.         DO     I=1,NELM
  61.           LLL(IDOB+I)=LLL(IDOA+I)
  62.         ENDDO
  63.  
  64.       WHEN , LOGICAL 2
  65.  
  66.         DO     I=1,NELM
  67.           LL2(IDOB+I)=LL2(IDOA+I)
  68.         ENDDO
  69.  
  70.       WHEN , LOGICAL 1
  71.  
  72.         DO     I=1,NELM
  73.           LL1(IDOB+I)=LL1(IDOA+I)
  74.         ENDDO
  75.  
  76.       WHEN , INTEGER
  77.  
  78. **      DO     I=1,NELM
  79. **        III(IDOB+I)=III(IDOA+I)
  80. **      ENDDO
  81.         DO     I=1,NELM-3,4
  82.           III(IDOB+I)=III(IDOA+I)
  83.           III(IDOB+I+1)=III(IDOA+I+1)
  84.           III(IDOB+I+2)=III(IDOA+I+2)
  85.           III(IDOB+I+3)=III(IDOA+I+3)
  86.         ENDDO
  87.         j=i
  88.         DO     i=j,NELM
  89.           III(IDOB+i)=III(IDOA+i)
  90.         ENDDO
  91.  
  92.       WHEN , INTEGER 2
  93.  
  94.         DO     I=1,NELM
  95.           II2(IDOB+I)=II2(IDOA+I)
  96.         ENDDO
  97.  
  98.       WHEN , INTEGER 1
  99.  
  100.         DO     I=1,NELM
  101.           II1(IDOB+I)=II1(IDOA+I)
  102.         ENDDO
  103.  
  104.       WHEN , REAL
  105.  
  106. **        DO     I=1,NELM
  107. **          RRR(IDOB+I)=RRR(IDOA+I)
  108. **        ENDDO
  109.         DO     I=1,NELM-3,4
  110.           RRR(IDOB+I)=RRR(IDOA+I)
  111.           RRR(IDOB+I+1)=RRR(IDOA+I+1)
  112.           RRR(IDOB+I+2)=RRR(IDOA+I+2)
  113.           RRR(IDOB+I+3)=RRR(IDOA+I+3)
  114.         ENDDO
  115.         j=i
  116.         DO     I=j,NELM
  117.           RRR(IDOB+I)=RRR(IDOA+I)
  118.         ENDDO
  119.  
  120.       WHEN , REAL    8
  121.  
  122. **        DO     I=1,NELM
  123. **          RR8(IDOB+I)=RR8(IDOA+I)
  124. **        ENDDO
  125.         DO     I=1,NELM-3,4
  126.           RR8(IDOB+I)=RR8(IDOA+I)
  127.           RR8(IDOB+I+1)=RR8(IDOA+I+1)
  128.           RR8(IDOB+I+2)=RR8(IDOA+I+2)
  129.           RR8(IDOB+I+3)=RR8(IDOA+I+3)
  130.         ENDDO
  131.         j=i
  132.         DO     I=j,NELM
  133.           RR8(IDOB+I)=RR8(IDOA+I)
  134.         ENDDO
  135.  
  136.       WHEN , REAL   16
  137.  
  138.         DO     I=1,NELM
  139. **        R16(IDOB+I)=R16(IDOA+I)
  140.         ENDDO
  141.  
  142.       WHEN , COMPLEX
  143.  
  144.         DO     I=1,NELM
  145.           CCC(IDOB+I)=CCC(IDOA+I)
  146.         ENDDO
  147.  
  148.       WHEN , COMPLEX16
  149.  
  150.         DO     I=1,NELM
  151.           C16(IDOB+I)=C16(IDOA+I)
  152.         ENDDO
  153.  
  154.       WHEN , COMPLEX32
  155.  
  156.         DO     I=1,NELM
  157.           C32(IDOB+I)=C32(IDOA+I)
  158.         ENDDO
  159.  
  160.       WHEN , CHARACTER
  161.  
  162.         DO     I=1,NELM
  163.           H1                =CAR(IDOA+I:IDOA+I)
  164.           CAR(IDOB+I:IDOB+I)=H1
  165.         ENDDO
  166.  
  167.       ENDCASE
  168.                                                        RETURN
  169. C-----------------------------------------------------------------------
  170. C
  171. C                   DECALAGE A DROITE POUR OOOYAD
  172. C            XXX(IDOB+I)=XXX(IDOA+I)  POUR : I=NELM,1,-1
  173. C
  174. **    ENTRY      OOOADD (ISSG,TYLN,NELM,IDOB,IDOA)
  175.       ENTRY      OOOADH (LLL,LL2,LL1,III,II2,II1,RRR,RR8,R16,CCC,C16,
  176.      >C32,CAR,TYLN,NELM,IDOB,IDOA)
  177. C
  178. **    ISEG=ISSG
  179.  
  180.       CASE , TYLN
  181.  
  182.       WHEN , LOGICAL
  183.  
  184.         DO     I=NELM,1,-1
  185.           LLL(IDOB+I)=LLL(IDOA+I)
  186.         ENDDO
  187.  
  188.       WHEN , LOGICAL 2
  189.  
  190.         DO     I=NELM,1,-1
  191.           LL2(IDOB+I)=LL2(IDOA+I)
  192.         ENDDO
  193.  
  194.       WHEN , LOGICAL 1
  195.  
  196.         DO     I=NELM,1,-1
  197.           LL1(IDOB+I)=LL1(IDOA+I)
  198.         ENDDO
  199.  
  200.       WHEN , INTEGER
  201.  
  202. **      DO     I=NELM,1,-1
  203. **        III(IDOB+I)=III(IDOA+I)
  204. **      ENDDO
  205.         DO     I=NELM,3,-4
  206.           III(IDOB+I)=III(IDOA+I)
  207.           III(IDOB+I-1)=III(IDOA+I-1)
  208.           III(IDOB+I-2)=III(IDOA+I-2)
  209.           III(IDOB+I-3)=III(IDOA+I-3)
  210.         ENDDO
  211.         j=i
  212.         DO     i=j,1,-1
  213.           III(IDOB+i)=III(IDOA+i)
  214.         ENDDO
  215.  
  216.       WHEN , INTEGER 2
  217.  
  218.         DO     I=NELM,1,-1
  219.           II2(IDOB+I)=II2(IDOA+I)
  220.         ENDDO
  221.  
  222.       WHEN , INTEGER 1
  223.  
  224.         DO     I=NELM,1,-1
  225.           II1(IDOB+I)=II1(IDOA+I)
  226.         ENDDO
  227.  
  228.       WHEN , REAL
  229.  
  230. **      DO     I=NELM,1,-1
  231. **        RRR(IDOB+I)=RRR(IDOA+I)
  232. **      ENDDO
  233.         DO     I=NELM,3,-4
  234.           RRR(IDOB+I)=RRR(IDOA+I)
  235.           RRR(IDOB+I-1)=RRR(IDOA+I-1)
  236.           RRR(IDOB+I-2)=RRR(IDOA+I-2)
  237.           RRR(IDOB+I-3)=RRR(IDOA+I-3)
  238.         ENDDO
  239.         j=i
  240.         DO     I=j,1,-1
  241.           RRR(IDOB+I)=RRR(IDOA+I)
  242.         ENDDO
  243.  
  244.       WHEN , REAL    8
  245.  
  246. **      DO     I=NELM,1,-1
  247. **        RR8(IDOB+I)=RR8(IDOA+I)
  248. **      ENDDO
  249.         DO     I=NELM,3,-4
  250.           RR8(IDOB+I)=RR8(IDOA+I)
  251.           RR8(IDOB+I-1)=RR8(IDOA+I-1)
  252.           RR8(IDOB+I-2)=RR8(IDOA+I-2)
  253.           RR8(IDOB+I-3)=RR8(IDOA+I-3)
  254.         ENDDO
  255.         j=i
  256.         DO     I=j,1,-1
  257.           RR8(IDOB+I)=RR8(IDOA+I)
  258.         ENDDO
  259.  
  260.       WHEN , REAL   16
  261.  
  262.         DO     I=NELM,1,-1
  263. **        R16(IDOB+I)=R16(IDOA+I)
  264.         ENDDO
  265.  
  266.       WHEN , COMPLEX
  267.  
  268.         DO     I=NELM,1,-1
  269.           CCC(IDOB+I)=CCC(IDOA+I)
  270.         ENDDO
  271.  
  272.       WHEN , COMPLEX16
  273.  
  274.         DO     I=NELM,1,-1
  275.           C16(IDOB+I)=C16(IDOA+I)
  276.         ENDDO
  277.  
  278.       WHEN , COMPLEX32
  279.  
  280.         DO     I=NELM,1,-1
  281.           C32(IDOB+I)=C32(IDOA+I)
  282.         ENDDO
  283.  
  284.       WHEN , CHARACTER
  285.  
  286.         DO     I=NELM,1,-1
  287.           H1                =CAR(IDOA+I:IDOA+I)
  288.           CAR(IDOB+I:IDOB+I)=H1
  289.         ENDDO
  290.  
  291.       ENDCASE
  292.                                                        RETURN
  293. C-----------------------------------------------------------------------
  294. C
  295. C                   REMISE A 0 OU BLANC POUR OOOYAD
  296. C                 XXX(IDOB+I)= NULL?  POUR : I=1,NELM
  297. C
  298. **    ENTRY      OOOADZ (ISSG,TYLN,NELM,IDOB)
  299.       ENTRY      OOOADY (LLL,LL2,LL1,III,II2,II1,RRR,RR8,R16,CCC,C16,
  300.      >C32,CAR,TYLN,NELM,IDOB)
  301. C
  302. **    ISEG=ISSG
  303.  
  304.       CASE , TYLN
  305.  
  306.       WHEN , LOGICAL
  307.  
  308.         DO     I=1,NELM
  309.           LLL(IDOB+I)=.FALSE.
  310.         ENDDO
  311.  
  312.       WHEN , LOGICAL 2
  313.  
  314.         DO     I=1,NELM
  315.           LL2(IDOB+I)=.FALSE.
  316.         ENDDO
  317.  
  318.       WHEN , LOGICAL 1
  319.  
  320.         DO     I=1,NELM
  321.           LL1(IDOB+I)=.FALSE.
  322.         ENDDO
  323.  
  324.       WHEN , INTEGER
  325.  
  326.         DO     I=1,NELM
  327.           III(IDOB+I)=0
  328.         ENDDO
  329.  
  330.       WHEN , INTEGER 2
  331.  
  332.         DO     I=1,NELM
  333.           II2(IDOB+I)=0
  334.         ENDDO
  335.  
  336.       WHEN , INTEGER 1
  337.  
  338.         DO     I=1,NELM
  339.           II1(IDOB+I)=0
  340.         ENDDO
  341.  
  342.       WHEN , REAL
  343.  
  344.         DO     I=1,NELM
  345.           RRR(IDOB+I)=0.
  346.         ENDDO
  347.  
  348.       WHEN , REAL    8
  349.  
  350.         DO     I=1,NELM
  351.           RR8(IDOB+I)=0.
  352.         ENDDO
  353.  
  354.       WHEN , REAL   16
  355.  
  356.         DO     I=1,NELM
  357. **        R16(IDOB+I)=0.
  358.         ENDDO
  359.  
  360.       WHEN , COMPLEX
  361.  
  362.         DO     I=1,NELM
  363.           CCC(IDOB+I)=(0.,0.)
  364.         ENDDO
  365.  
  366.       WHEN , COMPLEX16
  367.  
  368.         DO     I=1,NELM
  369.           C16(IDOB+I)=(0.,0.)
  370.         ENDDO
  371.  
  372.       WHEN , COMPLEX32
  373.  
  374.         DO     I=1,NELM
  375.           C32(IDOB+I)=(0.,0.)
  376.         ENDDO
  377.  
  378.       WHEN , CHARACTER
  379.  
  380.         DO     I=1,NELM
  381.           CAR(IDOB+I:IDOB+I)=' '
  382.         ENDDO
  383.  
  384.       ENDCASE
  385.                                                        RETURN
  386.       END
  387.  
  388.  
  389.  

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