PROGRAM PROG
C---------------------------------------------------08/01/2002--------
C OutputFormatting Control Switches validated : -rlbefotuv
C Conversion Control Switches validated       : -xr
C Conversion via  : /SX/psuite/trans90 -rlbefotuv -xr prog.f 
C---------------------------------------------------------------------
      COMMON /ACOM/ AA, BB
      integer CTL
      PARAMETER(N=8, M=N+2, L1=N/2, L2=M/2)
      REAL*4 A(N,M), B(M,M), C(M,M)
      REAL*4 BR(L1,L2,M,N), AR(N,L2,L1)
      REAL*4 RA(N), RB(N), RD(N), RE(N)
c
c-- Lecture des données dans le fichier "data_prog"
      WRITE(6, 123) 
 123  format('Prog : lecture des données')
      OPEN(10,file='data_prog',action='READ',access='sequential',
     1     form='unformatted')
      READ(10) ((B(I, J),I=1,M),J=1,M)
      READ(10) ((C(I, J),I=1,M),J=1,M) 
      READ(10) br, ar     
      READ(10) RA,RB,RD,RE
      Y=B(2,1)
C
C-- IF arithmétique ==> Blocs IF THEN -----
      Z=Y*2.     
      IF(Y) 200, 50, 60
   50 CONTINUE
      X=0.
      GO TO 100
   60 CONTINUE
      X=1.
  100 CONTINUE
      Y=Y+Z
  200 CONTINUE 
      print *, 'X=',X, ' Y=',Y 
C
C-- GO TO ==>  Blocs IF THEN -----
      T=X+Y
      IF(X.GT.Y) GO TO 10
      S=SQRT(T)
      GO TO 20
   10 CONTINUE
      S=EXP(T)
   20 CONTINUE 
      print *, 'S=',S 
C
C-- Appel sous programme avec COMMON ==> module ------
      AA=2.
      BB=3.
      CTL=0
      CALL SP1(T,B,M,CTL,xout)
      PRINT *, 'SP1 : CTL=', CTL, ' xout=', xout
C
C--- Boucles avec GO TO ==> Boucles avec CYCLE/EXIT --
      DO 233 J=1, M
      DO 133 I=1, N
      A(I,J)=B(I,J) - 10.
      IF (B(I, J) .LT.0.) GOTO 133
      IF (A(I, J) .EQ.0.) GOTO 333
      B(I,J)=2.
  133 CONTINUE
  233 CONTINUE
  333 CONTINUE 
      print *,'B(2,2)=',B(2,2), ' B(N,M)=',B(N,M)
C
C--- GO TO calculé ==> SELECT CASE --------------------
      IF(I.gt.100) i=0
      GO TO (51, 51, 101) I
      B(I,1)=2.
      GO TO 201
   51 CONTINUE
      X=1.
      GO TO 201
  101 CONTINUE
      X=2.
  201 CONTINUE
      print *,'Select case : X=',X
C 
C--- Opérations tableaux -----------------------------
C
C-- Initialisation globale
      DO 111 I=1,M
      DO 111 J=1,M
 111  C(I,J)=3.14
C
C--- Initialisation globale avec transposée
      DO 3709 J=1, N
      DO 3709 I=1, N
 3709 A(I, J)=2.0*B(J, I)
      print *,'A(2,2)=',A(2,2), ' A(N,N)=',A(N,N)
C
C--- Sommation ==> SUM
      S=0.
      DO 204 J=1, N
      DO 204 I=1, N
  204 S=S+A(I, J)+B(I, J)
      print *, 'S=',S
C
C--- Boucle + IF ==> Réduction via SUM + MINVAL + COUNT
      K=0 
      DO 105 I=1, N
      IF (RA(I) .GT. 0) S=S+RB(I)
      IF (RB(I) .GE. RD(I)) X=MIN(X, RE(I))
      IF (RA(I) .GT. RB(I)) K=K+1
 105  CONTINUE
      print *, 'S=',S, ' K=',K 
C--- Quadruple boucle imbriquée ==> RESHAPE + SPREAD
      DO 17 K=1, N
      DO 17 J=1, M
      DO 17 I2=1, L2
      DO 17 I1=1, L1
      BR(I1, I2, J, K)=AR(K,I2, I1)
   17 CONTINUE 
      print *,'BR(1,1,1,1)=', BR(1,1,1,1)
C
C--- Réduction double boucle ==> SPREAD + (/ ... /)
      DO 1234 I=1,N
      DO 1234 J=1,N
 1234 B(I,J) = C(I,J) + real(I+J)
      print *, 'B(2,2)=',B(2,2), ' B(N,N)=',B(N,N)
C
C--- Multiplication de matrices ==> MATMUL
      DO 930 I = 1,N
      DO 930 J = 1,M
      A(I,J) = 1.0
      DO 930 K = 1,M
 930  A(I,J) = A(I,J) + B(K,I)*C(K,J)
      print *,'MATMUL : A(1,1)=', A(1,1), ' A(N,M)=', A(N,M),
     1                ' A(2,2)=', A(2,2), ' A(2,3)=', A(2,3)    
      STOP
      END
      SUBROUTINE SP1(INC,TAB,N1,CTL,COEF)
      COMMON /ACOM/ AA, BB
      integer CTL
      real*4 TAB(N1,*), INC
      S=real(CTL)
      Do 10 i=1,N1
 10   S=S+TAB(i,1)
      IF(S.gt.0.) CTL=99
      COEF=INC+AA+BB/2.
      RETURN
      END