Télécharger la plaquette Cast3M


fr en

Télécharger oooadg.eso

Retour à la liste

Numérotation des lignes : 

oooadg

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

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