SUBROUTINE OMXCAB(LMXC,LMXAB,LMXRAH);
! . ___. __ . __ . _  _   ......................................
!     / |  | |  | | \/ |  KERNEL                    LESETH - LMD
!    /  |  | |  | |    |  SUBROUTINE OMXCAB                    .
!   /__ |__| |__| |    |  Written by LESETH & RAMSES           .
!                                                              .
!   Compute the Ct*AB product for one Ct block (corresponding  .
!    to one given Cell interface) and for the whole AB matrix. .
!    The output is stored in the corresponding row of the      .
!    coupling matrix.                                          .
!   Input : LMXC = Ct matrix bank address                      .
!           LMXAB = AB matrix bank address                     .
!           LMXRAH = coupling matrix row bank address          .
!
!           Call-bank :                                        .
!            OXCAB_PAIR (+0 or +OX_S) : PAIR                   .
!            OXCAB_CDX (+0 or +OX_S) : CDXT                    .
!            OXCAB_RDX (+0 or +OX_S) : RDXT                    .
!                      --------------                          .
!            2 : Switch to PAIR (= OXCAB_PAIR or OXCAB_PAIR+OX_S)
!            2 : Switch to RDXT (= OXCAB_RDX or OXCAB_RDX+OX_S).
!            3 : Switch to CDXT (= OXCAB_CDX or OXCAB_CDX+OX_S).
!
!    Use : OMXG call bank                                      .
!                                                              .
!   Modified by Jean_Yves GRANDPEIX, 12/08/94, 10:30           .
!...............................................................
!
"-    GET CALL-BANK ADDRESS"
LZMX1=LQ(LZMX1+ONX);
LZMX2=LQ(LZMX1+ONX);

"-    GET OUTPUT MATRIX CTBR."
IPCTBR=@(LMXRAH.RT).CR+2;             AH pointeur
"-    GET PAIR,RDXTE,CDXTE ADDRESSES"
LQ(LZMX2+OXG_PAIR)=LQ(LZMX1-IQ(LZMX1+1));
LRDXT=LQ(LZMX1-IQ(LZMX1+2));                                          from OIC2RX :
LCDXT=LQ(LZMX1-IQ(LZMX1+3));

"-                                                          STORE # C+  COLUMNS IN LZMX2+2"
LRDXTB=LQ(LRDXT+OXRBX);
IQ(LZMX2+2)=IQ(LRDXTB+3);               2nd Call Bk (2)= k range 0_(LSV.SV).Nb_St_Var;
"-    MULTIPLICATION SIGN"                                projete par PAIRing dans (LCL).Nb_St_Var
IQ(LZMX2+5)=IQ(LZMX1+4);                            (5)= sign for mult.
"-    MULTIPLICITY=1"
IQ(LZMX2+1)=1;                                      (1)= 1
"-    STORE POINTER TO RDXTE"
LRDXTE=LQ(LRDXTB+OBXEX);
LQ(LZMX2+OXG_RDX)=LRDXTE+2;
"-                                                          STORE # (AB)+ COLUMNS"
LCDXTB=LQ(LCDXT+OXCXB);                                               from OC2CDX :
IQ(LZMX2+3)=IQ(LCDXTB+3);                           (3) ABt # cols => B # rows   (LCL).Nb_St_Var;

"-    LOOP ON AH-BLOCKS (THERE IS ONE CDXTE PER AH-BLOCK, done by OC2RX)"
JAH=0;                                  qui donne, par IC, d'ou il est dans Low, ou il va dans Up
DONEXT LCDXTE=LQ(LCDXTB+OXBXE)
<  JAH = JAH+1;
   IQ(LZMX2+4)=IQ(LCDXTB+4+3*JAH); "  STORE # AH COLUMNS"  (4)= # AH cols
   "-    GET AH-BLOCK:"
   NUCOL=IQ(IPCTBR+IQ(LCDXTE+2));
   LMXAH = @(LMXRAH.RT).MX(NUCOL);              Le bloc MX des elements de chaque AH bloc
   " "
   "-    LOOP ON B-GROUPS"                      un B group = un IC du AH bloc
   NUGR=IQ(LCDXTE+1);
   IPCDTE=LCDXTE+2;
   DO IGR=1,NUGR
   <  LQ(LZMX2+OXG_CDX)=IPCDTE;"    STORE POINTER TO CDXTE"
   " "CALL ZMXG1(LMXC,LMXAB,LMXAH);
   " "IPCDTE=IPCDTE+3;
   >    "    END LOOP ON B-GROUPS"
   " "
>    " End loop on AH blocks"


"-    RESET CALL-BANK ADDRESS"
LZMX1=LQ(LZMX1+OX_PREV);
RETURN;
END;
SUBROUTINE OMXG(LMXA,LMXB,LMXC);
! . ___. __ . __ . _  _   ......................................
!     / |  | |  | | \/ |  KERNEL                    LESETH - LMD
!    /  |  | |  | |    |  SUBROUTINE OMXG                      .
!   /__ |__| |__| |    |  Written by LESETH & RAMSES           .
!                                                              .
!   Multiply one group of rows of A by one group of columns of .
!   B (entry point OMXG) or of B transposed (entry point OMXG1).
!   (and add the result to C).                                 .
!   Input : LMXA = Mx-bank of A matrix                         .
!           LMXB = Mx-bank of B matrix                         .
!           LMXC = Mx-bank of C matrix                         .
!                                                              .
!           Call-bank :                                        .
!            OXGV_PAIR : Pair bank address (Ref link)          .
!            OXAD_RDX : pointer into RDXTE bank                .
!            OXAD_CDX : pointer into CDXTE bank                .
!                      --------------                          .
!            1 : Multiplicity                                  .
!            2 : # columns of A                                .
!     OMXG -> 3 : # columns of B (= # rows of C)               .
!    OMXG1 -> 3 : # rows of B (= # rows of C)                  .
!            4 : # columns of C                                .
!            5 : multiplication sign (GE.0 -> +; LT.0 -> -)    .
!                                                              .       exemple de la Ct*t_ABt
!   Modified by Jean_Yves GRANDPEIX, 12/08/94, 10:30           .
!...............................................................                 X---I---I
                                         C(i,j) = A(k,i)*B(j,k)       P        E |
"-    GET CALL-BANK ADDRESS"                                            ai     t | B=AB
LZMX1=LQ(LZMX1+ONX);                                                       r   a |     CDXTB
"-    #  COLUMNS"                               from :                   SV      -       |
NCA=IQ(LZMX1+2); k range 0_(LSV.SV).Nb_St_Var; RDXTB    Low left      X----k>---I         \ IC
NCB=IQ(LZMX1+3);      (LCL).Nb_St_Var;         CDXTB    Low right     | IC                 CDXTE
NCC=IQ(LZMX1+4); (4)= # AH cols                CDXTB    Up            -    A=Ct              \
JMPRB=NCB;                               B(j,k) = B(j+(k-1)*JmpRB)    |        RDXTB          [AH BRow]
JMPCB=1;                                                              | IC        \_IC RDXTE_/
GO TO :START:;                                                        X
ENTRY ZMXG1(LMXA,LMXB,LMXC); =====================================
"-    GET CALL-BANK ADDRESS"
LZMX1=LQ(LZMX1+ONX);
+SELF,IF=PROMXG.
ISWMXG=1;                               C(i,j) = A(k,i)*t_Bt(j,k)
+SELF.                                                  Bt(k,j)
"-    # COLUMNS OR ROWS"
NCA=IQ(LZMX1+2);NRB=IQ(LZMX1+3);NCC=IQ(LZMX1+4);

Increment pour changer de col / ligne de B = t_Bt
JMPRB=1;  (on passe d'une ligne de B a une autre en passant d'une col de Bt a une autre)
JMPCB=NRB;                              Bt(j,k) = Bt(j+(k-1)*JmpRBt)
                                      t_Bt      == B(k+(j-1)*JmpCB)

:START: ;             "<================================== START"
+SELF,IF=PRZMXG0.
ISWPRT=0;
+SELF,IF=PRZMXG1.
ISWPRT=1;
+SELF,IF=PRZMXG2.
ISWPRT=ISWMXG;
+SELF.

"-    GET PAIR,RDXTE,CDXTE ADDRESSES"   Set by OIC2RX cf >> OIC2RX.hlp
LPAIR=LQ(LZMX1+OXG_PAIR);               ==============================
IPRDXT=LQ(LZMX1+OXG_RDX);   = pointe sur RDXTE(2)
IPCDXT=LQ(LZMX1+OXG_CDX);            et  CDXTE(2)
"-    ROWS AND COLUMNS 0_LOCATIONS"
IRA=IQ(IPRDXT+1);RDXTE(3)           =0  Bloc 0_location in low (Ct) BRow                left
ICB=IQ(IPCDXT+1);CDXTE(3)                                      AB BRow  (IC).LTr_in_Cl; right
IRC=IQ(IPRDXT+3);RDXTE(5)              Row loc in Up    0_(LIC.IC).LTr_in_Fc;           left
ICC=IQ(IPCDXT+3);CDXTE(5)              Col loc in Up   (IC).LTr_in_Fc;                  right
"-    GROUP SIZES"
NGA=IQ(IPRDXT+2);RDXTE(4)       Nb of rows of A Brow    0_(LIC.IC).Nb_Tr_Var;           left
NGB=IQ(IPCDXT+2);CDXTE(4)       Nb of columns of B Bcol (IC).Nb_Tr_Var                  right

"-    POINTERS TO BEGINNINGS OF MATRICES"
IPC1=LMXC+IRC*NCC+ICC;
IPB1=LMXB+ICB*JMPCB;
IPA1=LMXA+IRA*NCA;


"-    SCAN SV_list Segments OF (A(Ct)-COLUMNS, B(AB)-ROWS)"
NG=IQ(LPAIR+1); Nbre de segments = serie naturelles d'entiers cf OSV2P in \
IPP1=LPAIR+1;                                             >  Circulation_de_l_info_entre_Bks
IPPMAX=IPP1+(NG-1)*4;
"-    SWITCH ACCORDING TO MULTIPLICATION SIGN"
IF (IQ(LZMX1+5).LE.-1) GO TO :NEGATIVE MULTIPLY:;

"-    POSITIVE MULTIPLY"
DO IP=IPP1,IPPMAX,4      scan quadriplets of all segments
<  ICA=IQ(IP+1);         < A(ICA+k,i)
   IRB=IQ(IP+2);                     * B(j,IRB+k)
   NGAB=IQ(IP+3);                                 k=0,NGAB-1
   WGHT=Q(IP+4);
   " "
   "-    POINTERS TO BEGINNINGS OF GROUPS"
   IPGA=IPA1+ICA;               A =>Q(IPGA+ICA+k)
   IPGB=IPB1+IRB*JMPRB+1;       B =>Q(IPGB+(IRB+k)*JmpRB)
   " "
   "-    MATRIX MULTIPLY"
   IPRLST=IPGA+(NGA-1)*NCA;     last row of A
   IPRC=IPC1;
   DO IPRA=IPGA,IPRLST,NCA      loop on beginnings of rows of A
   <  IPAFST=IPRA+1;            < first value
   " "IPALST=IPRA+NCA;            & last of A row :
   " "IPCFST=IPRC+1;              first
   " "IPCLST=IPRC+NGB;                 and last of C col
   " "IPRB=IPGB;                  first on B col
   " "DO IPA=IPAFST,IPALST        loop on A line #i items (k=1,NCA)
   " "<  A=Q(IPA)*WGHT;           < A(k,i)*Wght
   " "   IPB=IPRB;                  (j,k) de B
   " "   DO IPC=IPCFST,IPCLST       loop on C col #i items (j=1,NGB)
   " "   <  Q(IPC)=Q(IPC)+A*Q(IPB); <    C(i,j) = + A(k,i)*B(j,k)
   " "   " "IPB=IPB+JMPCB;             (j+1,k) of B and (i,j+1) of C
   " "   >                          >
   " "   IPRB=IPRB+JMPRB;          (j,k+1) of B and (k+1,i) of A
   " ">                           >
   " "IPRC=IPRC+NCC;             (i,j+1) of C  and (1,i) of A
   >                            >
> "END OF GROUP-SCANNING"  >
!
GO TO :RETURN:;
!
:NEGATIVE MULTIPLY:;                  "<===========NEGATIVE MULTIPLY"

DO IP=IPP1,IPPMAX,4
<  ICA=IQ(IP+1);
   IRB=IQ(IP+2);
   NGAB=IQ(IP+3);
   WGHT=-Q(IP+4);
   " "
   "-    POINTERS TO BEGINNINGS OF GROUPS"
   IPGA=IPA1+ICA;
   IPGB=IPB1+IRB*JMPRB+1;
   " "
   "-    MATRIX MULTIPLY"
   IPRLST=IPGA+(NGA-1)*NCA;
   IPRC=IPC1;
   DO IPRA=IPGA,IPRLST,NCA
   <  IPAFST=IPRA+1;
   " "IPALST=IPRA+NCA;
   " "IPCFST=IPRC+1;
   " "IPCLST=IPRC+NGB;
   " "IPRB=IPGB;
   " "DO IPA=IPAFST,IPALST
   " "<  A=Q(IPA)*WGHT;
   " "   IPB=IPRB;
   " "   DO IPC=IPCFST,IPCLST
   " "   <  Q(IPC)=Q(IPC)+A*Q(IPB);
   " "   " "IPB=IPB+JMPCB;
   " "   >
   " "   IPRB=IPRB+JMPRB;
   " ">
+SELF,IF=PROMXG.
   " "IF (ISWPRT.EQ.ISWMXG)
   " "PRINT *,' Q(IPC) APRES ',(Q(IPC),IPC=IPCFST,IPCLST);
+SELF.
   " " IPRC=IPRC+NCC;
   >
   " "
>
"-    END OF GROUP-SCANNING"

:RETURN: ;                     "<==========RETURN"


"-    RESET CALL-BANK ADDRESS"
LZMX1=LQ(LZMX1+OX_PREV);
RETURN;
END;
