/*********************************************************************/
/*  Fortran DVM+OpenMP+ACC                                           */
/*                                                                   */
/*                   Parallel Loop Processing                        */
/*********************************************************************/

#include "dvm.h"

SgStatement *parallel_dir;
SgExpression *spec_accr; 
int iacross;
symb_list *newvar_list;
#define IN_  0 
#define OUT_ 1 

extern int nloopred; //counter of parallel loops with reduction group
extern int nloopcons; //counter of parallel loops with consistent group
extern int opt_base, opt_loop_range; //set on by compiler options (code optimization options)
extern symb_list *redvar_list;

int ParallelLoop(SgStatement *stmt)
{
  SgSymbol     *do_var[MAX_LOOP_LEVEL];
  SgExpression *step[MAX_LOOP_LEVEL], 
               *init[MAX_LOOP_LEVEL],
               *last[MAX_LOOP_LEVEL],
               *vpart[MAX_LOOP_LEVEL];
  SgExpression *dovar;
  SgValueExp c1(1);
  int i=0, nloop=0, ndo=0, iout;
  SgStatement *stl, *st, *first_do;
  SgForStmt *stdo;
  int ub; /*OMP*/
  SgSymbol  *newj = NULL; /*OMP*/
  SgExpression *clause[13] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};

  // initialize global variables
  parallel_dir = stmt;
  redgref = NULL;
  red_list = NULL;
  irg=0; idebrg=0;
  iconsg=0; idebcg=0;
  consgref = NULL;
  iacross = 0;
  newvar_list = NULL;

  ub = 0; /*OMP*/
  if (!OMP_program) {/*OMP*/
     first_do = stmt -> lexNext();// first DO statement of the loop nest
  } else {
     first_do = GetLexNextIgnoreOMP(stmt);// first DO statement of the loop nest /*OMP*/
     newj = ChangeParallelDir (stmt);
  }
  
//analysis of clauses
  CheckClauses(stmt,clause);

  int interface = 0; /*ACC*/
//interface selection: 0 - RTS1, 1- RTS1+RTS2(by handler), 2 - RTS2(by handler)
  if(IN_COMPUTE_REGION || parloop_by_handler) 
     interface = 1; 
  if(parloop_by_handler == 2) {  
     interface = WhatInterface(stmt);
     if(interface == 1)
        err("Illegal clause",150,stmt );
  }  
//initialization vpart[]
  for(i=0; i<MAX_LOOP_LEVEL; i++)
     vpart[i] = NULL;
  
//looking through the do_variables list
  if(opt_loop_range) CreateIndexVariables(stmt->expr(2));
  for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs())
     nloop++;

  LINE_NUMBER_AFTER(stmt,stmt); // line number of PARALLEL directive
  TransferLabelFromTo(first_do, stmt->lexNext());
//generating call to 'bploop' function of performance analizer (begin of parallel interval)
  if(perf_analysis && perf_analysis != 2)
     InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb'

  //par_st = cur_st;

//renewing loop-header's variables (used in start-expr, end-expr, step-expr)
  if(IN_COMPUTE_REGION || parloop_by_handler)      /*ACC*/
     ACC_RenewParLoopHeaderVars(first_do,nloop);
 
//allocating LoopRef and OutInitIndexArray,OutLastIndexArray,OutStepArray 
  iplp = ndvm++;
  iout = ndvm; 
  if(interface != 2)
     ndvm += 3*nloop;
   
//looking through the loop nest 
  for(st=first_do,stl=NULL,i=0; i<nloop; st=st->lexNext(),i++) {
     stdo = isSgForStmt(st);
     if(!stdo)
       break;     
     else if( stl && !TightlyNestedLoops_Test(stl,st))
       err("Non-tightly-nested loops",339,st);       
        
     stl = st;
       //if(opt_loop_range) {
     ChangeDistArrayRef(stdo->start());
     ChangeDistArrayRef(stdo->end());
     ChangeDistArrayRef(stdo->step());
       // }
     do_var[i] = stdo->symbol(); 
     step[i]   = stdo->step();
     if(!step[i])
       step[i] = & c1.copy();  // by default: step = 1
     init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,do_var);
     if( init[i] )
         step[i] = & c1.copy(); 
      else
         init[i]   = stdo->start();
  
     last[i]   = stdo->end();  
    
     if (OMP_program) {/*OMP*/      
         if (newj != NULL) {/*OMP*/
             if (ub == 0) {/*OMP*/
                 if (isOmpGetNumThreads(last[i])) ub=1;/*OMP*/
                 if (ub == 0) {/*OMP*/
                     isOmpGetNumThreads(init[i]);/*OMP*/
                     ub=2;/*OMP*/
                 }/*OMP*/
             }  /*OMP*/
         } /*OMP*/
     } /*OMP*/    
     // setting new loop parameters
     if(!opt_loop_range) {
        if(vpart[i]) 
           stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form
                                                       //step is not replaced
        else { 
           stdo->setStart(*DVM000(iout+i));         
        }
        stdo->setEnd(*DVM000(iout+i+nloop));
     }
     else
        stdo->setEnd(*DVM000(iout+i+nloop) - *new SgVarRefExp(*INDEX_SYMBOL(do_var[i])));    

     if(dvm_debug) 
        SetDoVar(stdo->symbol());      
  }

  ndo = i; 

// test whether the PARALLEL directive is correct
  if( !TestParallelDirective(stmt, nloop, ndo, first_do) )
     return(0);    // directive is ignored

  if(interface == 2)
     Interface_2(stmt,clause,init,last,step,nloop,ndo,first_do); //,iout,stl,newj,ub);
  else
     Interface_1(stmt,clause,do_var,init,last,step,nloop,ndo,first_do,iplp,iout,stl,newj,ub);

  cur_st = st->lexPrev();  // set cur_st on last DO satement of loop nest
        // cur_st = stl->lexNext(); 

  return(1);
  
}

void CopyHeaderElems(SgStatement *st_after)
{symb_list *sl;
 SgStatement *stat;
 SgExpression *e;
 int i,rank;
 coeffs *c;
 stat=cur_st;
 cur_st= st_after; //par_st;
 for(sl=dvm_ar;sl;sl=sl->next) {
    c = AR_COEFFICIENTS(sl->symb); //((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF));
    
    rank=Rank(sl->symb);
    for(i=2;i<=rank;i++)
       doAssignTo_After(new SgVarRefExp(*(c->sc[i])), header_ref(sl->symb,i));
    e = opt_base ? (&(*header_ref(sl->symb,rank+2) + * new SgVarRefExp(*(c->sc[1])))) :  header_ref(sl->symb,rank+2);
    doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), e);
    //doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), header_ref(sl->symb,rank+2));
 }
 cur_st=stat;
 //dvm_ar=NULL;
}

void EndOfParallelLoopNest(SgStatement *stmt, SgStatement *end_stmt, SgStatement *par_do,SgStatement *func)

{ //stmt is last statement of parallel loop or is body of logical IF , which
  // is last statement
       SgStatement *go_stmt;
   
       if(HPF_program) {
                                 //first_hpf_exec = first_dvm_exec;
          INDLoopBegin(); 
          OffDoVarsOfNest(end_stmt); 
       } else if(!IN_COMPUTE_REGION && !parloop_by_handler) {     /*ACC*/   
          CopyHeaderElems(parallel_dir->lexNext());
          dvm_ar=NULL;
       }
               
       // replacing the label of DO statements locating  above parallel loop  in nest,
       // which is ended by stmt(or stmt->controlParent()),
       // by new label and inserting CONTINUE with this label 
       ReplaceDoNestLabel_Above(end_stmt, par_do, GetLabel());

       if(dvm_debug) {
          CloseDoInParLoop(end_stmt); //on debug regim end_stmt==stmt
          end_stmt = cur_st; 
       } else if(perf_analysis == 4 && !IN_COMPUTE_REGION && !parloop_by_handler) { // RTS calls can not be inserted into the handler     
          SeqLoopEndInParLoop(end_stmt,stmt);
          end_stmt = cur_st; 
       }
       if(!IN_COMPUTE_REGION && !parloop_by_handler) {
       // generating GO TO statement:  GO TO begin_lab
       // and inserting it after last statement of parallel loop nest 
          go_stmt = new SgGotoStmt(*begin_lab);     
          go_stmt->addAttribute (OMP_MARK); /*OMP*/
          cur_st->insertStmtAfter(*go_stmt,*par_do->controlParent());
          cur_st = go_stmt; // GO TO statement
          SgStatement *continue_stat = new SgStatement(CONT_STAT); /*OMP*/      
          continue_stat->addAttribute (OMP_MARK); /*OMP*/
          InsertNewStatementAfter( continue_stat,cur_st,cur_st->controlParent()); /*OMP*/     
       }          
       if(dvm_debug) {
       // generating call statement : call dendl(...)
          CloseParLoop(end_stmt->controlParent(),cur_st,end_stmt);
       }
       if(!dvm_debug && stmt->lineNumber())
       {
          LINE_NUMBER_AFTER_WITH_CP(stmt,cur_st,par_do->controlParent());
       }  
       // generating statements for special ACROSS:
       if(iacross == -1){
          SendArray(spec_accr);
          iacross = 0;
       }
       if(IN_COMPUTE_REGION)  /*ACC*/
       // generating call statement to unregister remote_access buffers: 
       // call dvmh_destroy_array(...)  
          ACC_UnregisterDvmBuffers();
       if(parloop_by_handler != 2 || (parloop_by_handler==2 && WhatInterface(parallel_dir) != 2))   
       // generating call statement:
       //  call endpl(LoopRef)
          doCallAfter(EndParLoop(iplp));

       // generating statements for ACROSS:
       if(iacross){
          doCallAfter(SendBound(DVM000(iacross)));
          doCallAfter(WaitBound(DVM000(iacross)));
          doCallAfter(DeleteObject_H (DVM000(iacross)));
       }
       // actualizing of reduction variables
       if(redgref)
          ReductionVarsStart(red_list);
     
       if(irg) {//there is synchronous REDUCTION clause in PARALLEL
          // generating call statement:
          //  call strtrd(RedGroupRef)
          doCallAfter(StartRed(redgref));

          // generating call statement:
          //  call waitrd(RedGroupRef)
          doCallAfter(WaitRed(redgref));
     
          if(IN_COMPUTE_REGION || parloop_by_handler)       /*ACC*/   
             ACC_ReductionVarsAreActual();
           
	  if(idebrg){
             if(dvm_debug)
               doCallAfter( D_CalcRG(DVM000(idebrg)));
             doCallAfter( D_DelRG (DVM000(idebrg)));
          }
          // generating statement:
          //  call dvmh_delete_object(RedGroupRef)     //dvm000(i) = delobj(RedGroupRef)
          doCallAfter(DeleteObject_H(redgref));
       }

       // actualizing of consistent arrays
       if(consgref)
          ConsistentArraysStart(cons_list);

       if(iconsg) {//there is synchronous CONSISTENT clause in PARALLEL
         if(IN_COMPUTE_REGION)    /*ACC*/        
         // generating call statement:
         //  call dvmh_handle_consistent(ConsistGroupRef)
            doCallAfter(HandleConsistent(consgref));    
         // generating assign statement:
         //  dvm000(i) = strtcg(ConsistGroupRef)
         doAssignStmtAfter(StartConsGroup(consgref));

         // generating statement:
         //  dvm000(i) = waitcg(ConsistGroupRef)
         doAssignStmtAfter(WaitConsGroup(consgref));
         
         // generating statement:
         //  call dvmh_delete_object(ConsistGroupRef)   //dvm000(i) = delobj(ConsistGroupRef)
         doCallAfter(DeleteObject_H(consgref));
       }

        // generating call eloop(...) - end of parallel interval
        // (performance analyzer function)
       if(perf_analysis && perf_analysis != 2) {
         InsertNewStatementAfter(St_Enloop(INTERVAL_NUMBER,INTERVAL_LINE),cur_st,cur_st->controlParent());
         CloseInterval();
         if(perf_analysis != 4)
           OverLoopAnalyse(func);
       }
       if(!IN_COMPUTE_REGION && !parloop_by_handler) {
       // setting label of ending parallel loop nest
       if(!go_stmt->lexNext()->label())
         (go_stmt->lexNext())->setLabel(*end_lab);
       else                
         go_stmt->insertStmtAfter(*ContinueWithLabel(end_lab), *go_stmt->controlParent());
       }
       // implementing parallel loop nest in compute region:
       // generating host- and cuda-handlers and cuda kernel for loop body
       if(IN_COMPUTE_REGION || parloop_by_handler)          /*ACC*/ 
       {   ACC_ParallelLoopEnd(par_do);
           if(!IN_COMPUTE_REGION)
             DeleteNonDvmArrays();     
       }
           
       //completing REMOTE_ACCESS 
       if(rma && !rma->rmout) 
          RemoteAccessEnd();
          
       SET_DVM(iplp);

} 



void CheckClauses(SgStatement *stmt, SgExpression *clause[])
{
   SgExpression *el,*e; 
// looking through the specification list
  for(el=stmt->expr(1); el; el=el->rhs()) {
     e = el->lhs();            // specification
     switch (e->variant()) {
           case NEW_SPEC_OP:
	     if(!clause[NEW_]){
                clause[NEW_] = e;
             }  else
                err("Double NEW clause",153,stmt);
                break;
           case REDUCTION_OP:
	     if(!clause[REDUCTION_]){
                clause[REDUCTION_] = e;
             }  else
                err("Double REDUCTION clause",154,stmt);
                break;
                 
           case SHADOW_RENEW_OP:
	     if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){
                clause[SHADOW_RENEW_] = e;
             }  else
                err("Double shadow-renew-clause",155,stmt);
                break;

           case SHADOW_START_OP:
	     if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){
                clause[SHADOW_START_] = e;
             }  else
                err("Double shadow-renew-clause",155,stmt);
                break;

           case SHADOW_WAIT_OP:
	     if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){
                clause[SHADOW_WAIT_] = e;
             }  else
                err("Double shadow-renew-clause",155,stmt);
                break;

           case SHADOW_COMP_OP:
	     if(!clause[SHADOW_COMPUTE_]){
                clause[SHADOW_COMPUTE_] = e;
             }  else
                err("Double SHADOW_COMPUTE clause",155,stmt);
                break;

           case REMOTE_ACCESS_OP:
	     if(!clause[REMOTE_ACCESS_]){
                clause[REMOTE_ACCESS_] = e;
             }  else
                err("Double REMOTE_ACCESS clause",156,stmt);
                break;

           case CONSISTENT_OP:
	     if(!clause[CONSISTENT_]){
                clause[CONSISTENT_] = e;
             }  else
                err("Double CONSISTENT clause",296,stmt);       
                break;
  
           case STAGE_OP:
	     if(!clause[STAGE_]){
                clause[STAGE_] = e;
             }  else
                err("Double STAGE clause",298,stmt);
                break; 

           case ACC_PRIVATE_OP:
	     if(!clause[PRIVATE_]){
                clause[PRIVATE_] = e;
             }  else
                err("Double PRIVATE clause",607,stmt);
                break; 

           case ACC_CUDA_BLOCK_OP:
	     if(!clause[CUDA_BLOCK_]){
                clause[CUDA_BLOCK_] = e;
             }  else
                err("Double CUDA_BLOCK clause",608,stmt);
                break; 

           case ACC_TIE_OP:
	     if(!clause[TIE_]){
                clause[TIE_] = e;
             }  else
                err("Double TIE clause",608,stmt);
                break; 

           case ACROSS_OP:
	     if(!clause[ACROSS_]){
                clause[ACROSS_] = e;
             }  else
                err("Double ACROSS clause",157,stmt);       
                break;  
     }
  }      
   
  if(clause[SHADOW_COMPUTE_] && clause[REDUCTION_])
     err("Inconsistent clauses: SHADOW_COMPUTE and REDUCTION",443,stmt);

  if(IN_COMPUTE_REGION && ( clause[SHADOW_START_] || clause[SHADOW_WAIT_] || clause[CONSISTENT_] && clause[CONSISTENT_]->symbol() || clause[REMOTE_ACCESS_] && clause[REMOTE_ACCESS_]->symbol()))
     err("Illegal clause of PARALLEL directive in region (SHADOW_START,SHADOW_WAIT,asynchronous CONSISTENT or asynchronous REMOTE_ACCESS)",445,stmt);       

}

int WhatInterface(SgStatement *stmt)
{
   SgExpression *el,*e;
// undistributed parallel loop
   if(!stmt->expr(0))
      return(2);
// is mapped on template? 
   //if(stmt->expr(0)->symbol()->attributes() & TEMPLATE_BIT)
   //   return (1); 
// looking through the specification list of PARALLEL directive
   for(el=stmt->expr(1); el; el=el->rhs()) {
      e = el->lhs();            // specification
      switch (e->variant()) {
           case ACC_PRIVATE_OP:
           case ACC_CUDA_BLOCK_OP:
           case SHADOW_RENEW_OP:
           case SHADOW_COMP_OP:
           case ACROSS_OP:
           case ACC_TIE_OP:
           case CONSISTENT_OP:
           case STAGE_OP:
                break;
           case REDUCTION_OP:
                if(TestReductionClause(e))
                  break;
                else
                  return(1);
           default:
                return (1);
      }
   }
   return (2);
}

int areIllegalClauses(SgStatement *stmt)
{ 
  SgExpression *el;
  for(el=stmt->expr(1); el; el=el->rhs()) 
    if(el->lhs()->variant() != REDUCTION_OP && el->lhs()->variant() != ACC_PRIVATE_OP && el->lhs()->variant() != ACC_CUDA_BLOCK_OP && el->lhs()->variant() != ACROSS_OP && el->lhs()->variant() != ACC_TIE_OP)
      return 1;
  return 0;                 
}          

int TestParallelWithoutOn(SgStatement *stmt, int flag)
{
  if(!stmt->expr(0) && parloop_by_handler != 2) //undistributed parallel loop
  {
     if(flag)
        warn("PARALLEL directive is ignored, -Opl2 option should be specified",621,stmt);
     return(0);
  } else
     return (1);         
}

int TestParallelDirective(SgStatement *stmt, int nloop, int ndo, SgStatement *first_do)
{ // stmt - PARALLEL directive; nloop - number of items in the do-variable list of directive;
  // ndo - number of loops (do-statements) in the nest
  SgExpression *dovar;  
  SgStatement *st;
  int flag_err=1; //flag of an error message
   
  if(!nloop)  // not determined yet (AnalyzeRegion())
  {  flag_err = 0;
     // first DO statement of the loop nest   
     first_do = OMP_program ? GetLexNextIgnoreOMP(stmt) : stmt->lexNext();   
     //looking through the do_variable list of directive
     for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs())
        nloop++;
 
     //looking through the loop nest 
     for(st=first_do,ndo=0; ndo<nloop; st=st->lexNext(),ndo++) 
     {     
        if(!isSgForStmt(st))
           break;     
     }
  }

  if(ndo == 0) {
    if(flag_err)
      err("Directive PARALLEL must be followed by DO statement", 97, stmt); 
    return(0);
  }

  if(nloop > ndo) { 
    if(flag_err) 
      err("Length of do-variable list in  PARALLEL directive is greater than the number of nested DO statements", 158,stmt);
    return(0);
  }

  for(st=first_do,dovar=stmt->expr(2); dovar; st=st->lexNext(),dovar=dovar->rhs()) 
  { 
    if(dovar->lhs()->symbol() != st->symbol()) {
      if(flag_err)
        err("Illegal do-variable list in PARALLEL directive",159,stmt);      
      return(0);
    }     
  }

  if(!stmt->expr(0) && areIllegalClauses(stmt)) //undistributed parallel loop
  {
    if(flag_err)
      err("Illegal clause",150,stmt );
    return(0);
       
  }

  if(!only_debug && stmt->expr(0) && !HEADER(stmt->expr(0)->symbol())) {
     if(flag_err)   
       Error("'%s' isn't distributed array", stmt->expr(0)->symbol()->identifier(), 72,stmt); 
     return(0);
  }

  return(1);
}

int doParallelLoopByHandler(int iplp, SgStatement *first, SgExpression *clause[], SgExpression *oldGroup, SgExpression *newGroup,SgExpression *oldGroup2, SgExpression *newGroup2)
{ /*ACC*/
    int ilh = ndvm;    
    LINE_NUMBER_AFTER(first,cur_st);      
    cur_st->addComment(ParallelLoopComment(first->lineNumber()));    
    doAssignStmtAfter(LoopCreate_H(cur_region ? cur_region->No : 0, iplp));       
    if (clause[REDUCTION_])  //there is REDUCTION clause in parallel loop
        InsertReductions_H(clause[REDUCTION_]->lhs(), ilh);

    if (clause[CUDA_BLOCK_])  //there is CUDA_BLOCK clause
    {
        int ib;
        ib = ndvm;
        CudaBlockSize(clause[CUDA_BLOCK_]->lhs());
        InsertNewStatementAfter(SetCudaBlock_H(ilh, ib), cur_st, cur_st->controlParent());
    }

    if (clause[TIE_])  //there is TIE clause
    {
        SgExpression *el;
        for (el=clause[TIE_]->lhs(); el; el=el->rhs())
            InsertNewStatementAfter(Correspondence_H(ilh, HeaderForArrayInParallelDir(el->lhs()->symbol(),parallel_dir,1), AxisList(parallel_dir,el->lhs())), cur_st, cur_st->controlParent());
    }

    if (oldGroup) // loop with ACROSS clause
        InsertNewStatementAfter(LoopAcross_H(ilh, oldGroup, newGroup), cur_st, cur_st->controlParent());

    if (oldGroup2) // loop with ACROSS clause
        InsertNewStatementAfter(LoopAcross_H(ilh, oldGroup2, newGroup2), cur_st, cur_st->controlParent());
        
    return(ilh);
}

void Interface_1(SgStatement *stmt,SgExpression *clause[],SgSymbol *do_var[],SgExpression *init[],SgExpression *last[],SgExpression *step[],int nloop,int ndo,SgStatement *first_do,int iplp,int iout,SgStatement *stl,SgSymbol *newj,int ub)
{  
  SgStatement *stc,*if_stmt=NULL,*st2=NULL,*st3=NULL;
  SgStatement *stdeb = NULL,*stat = NULL,*stg = NULL,*stcg = NULL;
  SgValueExp c0(0),c1(1);
  SgExpression *stage=NULL,*dopl=NULL,*dovar,*head;
  SgExpression *oldGroup = NULL, *newGroup=NULL;  /*ACC*/
  SgExpression *oldGroup2 = NULL, *newGroup2=NULL; /*ACC*/  
  SgSymbol  *spat;
  int all_positive_step=-1;
  int iacrg=-1,iinp;
  int iaxis,i, isg = 0;
  int nr; //number of aligning rules i.e. length of align-loop-index-list 
  int ag[3] = {0, 0, 0};
  int        step_mask[MAX_LOOP_LEVEL],
             loop_num[MAX_DIMS];


  stc = cur_st;  // saving
  // generating assign statement:
  //   dvm000(iplp) = crtpl(Rank);
                   //iplp = CreateParLoop( nloop); 
  doAssignTo_After(DVM000(iplp),CreateParLoop(nloop));

  if(dvm_debug && dbg_if_regim>1) {  //copy loop nest
     SgStatement *last_st,*lst;
     last_st= LastStatementOfDoNest(first_do);
     if(last_st != (lst=first_do->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) 
     { last_st=ReplaceLabelOfDoStmt(first_do,last_st, GetLabel());
       ReplaceDoNestLabel_Above(last_st,first_do,GetLabel());
     }
     stdeb=first_do->copyPtr();         
  }
  //---------------------------------------------------------------------------
  // processing specifications/clauses

     if(clause[NEW_])
        NewVarList(clause[NEW_]->lhs(),stmt);

     if(clause[REDUCTION_])
     {
        red_list = clause[REDUCTION_]->lhs();
        stat = cur_st; //store current statement    
        cur_st = stc; //insert statements for creating reduction group 
		      //before CrtPL i.e. before creating parallel loop             
        if( clause[REDUCTION_]->symbol()) {
           redgref = new SgVarRefExp(clause[REDUCTION_]->symbol());
           doIfForReduction(redgref,1);
           nloopred++;
           stg = doIfForCreateReduction( clause[REDUCTION_]->symbol(),nloopred,0);
        } else {
           irg = ndvm; 
           redgref = DVM000(irg);
           doAssignStmtAfter(CreateReductionGroup());
           if(debug_regim){
              idebrg = ndvm; 
              doAssignStmtAfter( D_CreateDebRedGroup());
           }
           stg = cur_st;//store current statement
        }   
        cur_st = stat; // restore cur_st 

     }
     if(clause[SHADOW_RENEW_])
     {
        isg = ndvm++;// index for BoundGroupRef
        CreateBoundGroup(DVM000(isg));  
        //looking through the array_with_shadow_list
        ShadowList(clause[SHADOW_RENEW_]->lhs(), stmt, DVM000(isg));
        if(ACC_program)      /*ACC*/
        {// generating call statement ( in and out compute region):
         //  call dvmh_shadow_renew( BoundGroupRef)
              
           doCallAfter(ShadowRenew_H(DVM000(isg)));   //(GPU000(ish_gpu),StartShadow_GPU(cur_region->No,DVM000(isg)));
        }
         // generating assign statement:
         //  dvm000(i) = strtsh(BoundGroupRef)
        doCallAfter(StartBound(DVM000(isg)));
     }

     if(clause[SHADOW_START_])      //sh_start
     { 
        SgExpression *sh_start = new SgVarRefExp(clause[SHADOW_START_]->symbol());
        if(ACC_program)      /*ACC*/
        {// generating call statement ( in and out compute region):
         //  call dvmh_shadow_renew( BoundGroupRef)              
           doCallAfter(ShadowRenew_H(sh_start));   
        }
        // generating assign statement:
        //   dvm000(i) = exfrst(LoopRef,BounGroupRef)
        doCallAfter(BoundFirst(iplp,sh_start));
     }

     if(clause[SHADOW_WAIT_])        //sh_wait
     // generating assign statement:
     //   dvm000(i) = imlast(LoopRef,BounGroupRef)
        doCallAfter(BoundLast(iplp,new SgVarRefExp(clause[SHADOW_WAIT_]->symbol())));

     if(clause[SHADOW_COMPUTE_])
     {
        if( (clause[SHADOW_COMPUTE_]->lhs()))
	   ShadowComp(clause[SHADOW_COMPUTE_]->lhs(),stmt,0);
        else 
           doCallAfter(AddBound());             
     }
     if(clause[REMOTE_ACCESS_])
     {
        //adding new element to remote_access directive/clause list
        AddRemoteAccess(clause[REMOTE_ACCESS_]->lhs(),NULL);        
     }
     if(clause[CONSISTENT_])
     {
        SgExpression *e = clause[CONSISTENT_];
        cons_list = e->lhs();
        stat = cur_st; //store current statement    
        cur_st = stc; //insert statements for creating reduction group 
		     //before CrtPL i.e. before creating parallel loop             
        if(  e->symbol()){
           consgref = new SgVarRefExp(e->symbol());
           doIfForConsistent(consgref);
           nloopcons++;
           stcg = doIfForCreateReduction( e->symbol(),nloopcons,0);
        } else {
           iconsg = ndvm; 
           consgref = DVM000(iconsg);
           doAssignStmtAfter(CreateConsGroup(1,1));
                  //!!!??? if(debug_regim){
                  //  idebcg = ndvm; 
                  //  doAssignStmtAfter( D_CreateDebRedGroup());
                  //}
           stcg = cur_st;//store current statement
        }  
        cur_st = stat; // restore cur_st 
     }

     if(clause[STAGE_])
     {  
        if( clause[STAGE_]->lhs()->variant()==MINUS_OP && INTEGER_VALUE(clause[STAGE_]->lhs()->lhs(),1) ) //STAGE(-1)
           stage = IN_COMPUTE_REGION ? GetStage(first_do,iplp) : &c0.copy(); 
        else
           stage = ReplaceFuncCall(clause[STAGE_]->lhs());
     }

     if (clause[TIE_])     
        for (SgExpression *el=clause[TIE_]->lhs(); el; el=el->rhs())  //list of tied arrays     
           AxisList(stmt, el->lhs());    //for testing

     if(clause[ACROSS_])
     { 
        int not_in=0;
        SgExpression *e_spec[2];
        SgExpression *e = clause[ACROSS_];
        int all_steps = Analyze_DO_steps(step,step_mask,ndo);
        InOutAcross(e,e_spec,stmt);
        SgExpression *in_spec =e_spec[IN_];
        SgExpression *out_spec=e_spec[OUT_];
        if(not_in && in_spec && !out_spec) { // old implementation
           stat = cur_st;//store current statement    
           cur_st = stc; //insert statements for creating shadow group 
		         //before CrtPL i.e. before creating parallel loop   
           iacross = ndvm++;// index for ShadowGroupRef
           //looking through the dependent_array_list
           if(DepList(e->lhs(), stmt, DVM000(iacross),ANTIDEP)){
              doCallAfter(StartBound(DVM000(iacross)));
              doCallAfter(WaitBound(DVM000(iacross)));
              doAssignStmtAfter(DeleteObject(DVM000(iacross)));
              SET_DVM(iacross+1); 
           }
           if(DepList(e->lhs(), stmt, DVM000(iacross),FLOWDEP)){
              doCallAfter(ReceiveBound(DVM000(iacross)));
              doCallAfter(WaitBound(DVM000(iacross)));
              SET_DVM(iacross+1);
           } else {
              if (iacross == -1)
                 spec_accr = e->lhs();
              else
                 iacross =  0;
           }
           cur_st = stat; // restore cur_st 
        } else  {// new implementation
           iacrg=ndvm; ndvm+=3;
           if(IN_COMPUTE_REGION || parloop_by_handler)
              ndvm+=3;   
           CreateShadowGroupsForAccross(in_spec,out_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+1),ACC_GroupRef(iacrg+2),ag,all_steps,step_mask,(clause[TIE_] ? clause[TIE_]->lhs() : NULL) ); 
          /*                                    
           if(all_positive_step) //(PositiveDoStep(step,ndo))
              CreateShadowGroupsForAccross(in_spec,out_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+1),ACC_GroupRef(iacrg+2),ag,all_positive_step,loop_num);
           else {
              //ag[1] = -1;              
              if(out_spec  || in_spec->rhs() ) 
               //if(in_spec->rhs()) in_spec->rhs()->unparsestdout();     
                 err("Illegal ACROSS clause",444,stmt); 
              else if (stmt->expr(0)->symbol()  != (in_spec->lhs()->variant() == ARRAY_OP ? in_spec->lhs()->lhs()->symbol() : in_spec->lhs()->symbol()))
                 Error("The base array '%s' should be specified in ACROSS clause", stmt->expr(0)->symbol()->identifier(), 256, stmt); 
              DefineLoopNumberForNegStep(step_mask,DefineLoopNumberForDimension(stmt,loop_num),loop_num);
              CreateShadowGroupsForAccrossNeg(in_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+2),ag,all_positive_step,loop_num);
              //k=ag[2]; ag[2] = ag[0]; ag[0] = k;   
                            
           }  */                
        }
     }

//------------------------------------------------------------------------------

  iinp = ndvm;    
  if(dvm_debug) 
     OpenParLoop_Inter(stl,iinp,iinp+nloop,do_var,nloop);
// creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray
// and InpStepArray  
  for(i=0,dovar=stmt->expr(2); i<nloop; i++,dovar=dovar->rhs()) 
     doAssignStmtAfter(GetAddres(do_var[i]));
  
  for(i=0; i<nloop; i++)
     doAssignStmtAfter( new SgValueExp(LoopVarType(do_var[i],stmt)));
  for(i=0; i<nloop; i++)
     doAssignStmtAfter( init[i] );
  for(i=0; i<nloop; i++)
     doAssignStmtAfter( last[i] );
  for(i=0; i<nloop; i++)
     doAssignStmtAfter( step[i] );

// creating AxisArray, CoeffArray and ConstArray 
  spat = (stmt->expr(0))->symbol();   // target array symbol
  head = HeaderRef(spat);
  iaxis = ndvm; 
  nr = doAlignIteration(stmt,NULL);

  if(isg) {
         // generating assign statement:
         //  dvm000(i) = waitsh(BoundGroupRef)
         doCallAfter(WaitBound(DVM000(isg)));
          }
     
// generating assign statement:
//   dvm000(i) =
//       mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[],
//              LoopVarAdrArray[], InpInitIndexArray[], InpLastIndexArray[],
//              InpStepArray[], 
//              OutInitIndexArray[], OutLastIndexArray[], OutStepArray[])
  
  doCallAfter( BeginParLoop (iplp, head, nloop, iaxis, nr, iinp, iout));

  if(redgref) {
    if(!irg) {
        st2 = doIfForCreateReduction( redgref->symbol(),nloopred,1);
        st3 = cur_st;
        ReductionList(red_list,redgref,stmt,stg,st2,0);
        cur_st = st3;
        InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent());
    } else  
        ReductionList(red_list,redgref,stmt,stg,cur_st,0); 
  }

  if(consgref) {
    if(!iconsg) {
        st2 = doIfForCreateReduction( consgref->symbol(),nloopcons,1);
        st3 = cur_st;
        ConsistentArrayList(cons_list,consgref,stmt,stcg,st2);
        cur_st = st3;
        InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent());
    } else  
        ConsistentArrayList(cons_list,consgref,stmt,stcg,cur_st);      
  }

  if(clause[REMOTE_ACCESS_])  //rvle
    RemoteVariableList(clause[REMOTE_ACCESS_]->symbol(), clause[REMOTE_ACCESS_]->lhs(), stmt);

  if(iacross == -1)
    ReceiveArray(spec_accr,stmt);

  if(clause[ACROSS_] && !clause[STAGE_])    // there is ACROSS clause and is not STAGE clause
       stage = &c0.copy(); //IN_COMPUTE_REGION ? GetStage(first_do,iplp) : &c0.copy();
      
  if(all_positive_step) {
  if(ag[0]) {
       pipeline=1;
       doAssignTo_After(new SgVarRefExp(Pipe), stage);
                                   
       if(ACC_program && ag[2])      /*ACC*/
       // generating call statement ( in and out compute region):
       //  call dvmh_shadow_renew( BoundGroupRef)              
         doCallAfter(ShadowRenew_H (DVM000(iacrg+2) ));   
       doCallAfter(InitAcross(0,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),DVM000(iacrg)));
       if(IN_COMPUTE_REGION || parloop_by_handler)
       { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/
         newGroup = DVM000(iacrg+3);                       /*ACC*/
       }
     if(ag[1]) {                                        
       doCallAfter(InitAcross(1,  ConstRef(0),  DVM000(iacrg+1)));
       if(IN_COMPUTE_REGION || parloop_by_handler)
       { oldGroup2 =  ConstRef(0);                         /*ACC*/
         newGroup2 =  DVM000(iacrg+4);                      /*ACC*/
       }
      } 
  } 
  else {
    if(ag[1]){
       pipeline=1; 
       doAssignTo_After(new SgVarRefExp(Pipe), stage);    
         
       if(ACC_program && ag[2])                          /*ACC*/
       // generating call statement ( in and out compute region):
       //  call dvmh_shadow_renew( BoundGroupRef)              
         doCallAfter(ShadowRenew_H (DVM000(iacrg+2) ));   

       doCallAfter(InitAcross(1,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),DVM000(iacrg+1)));
       if(IN_COMPUTE_REGION || parloop_by_handler)        
       { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/
         newGroup = DVM000(iacrg+4);                       /*ACC*/
       }
    } 
    else if(ag[2]){
       //err("SHADOW_RENEW clause is required",...,stmt);
       pipeline=1; 
       doAssignTo_After(new SgVarRefExp(Pipe), stage);    
       if(ACC_program)      /*ACC*/
       // generating call statement ( in and out compute region):
       //  call dvmh_shadow_renew( BoundGroupRef)              
         doCallAfter(ShadowRenew_H (DVM000(iacrg+2) ));   
       //doCallAfter(StartBound(DVM000(iacrg+2)));              /*09.12.19*/
       //doCallAfter(WaitBound (DVM000(iacrg+2)));              /*09.12.19*/
       doCallAfter(InitAcross(1,DVM000(iacrg+2), ConstRef(0))); /*09.12.19*/
       if(IN_COMPUTE_REGION || parloop_by_handler)        
       { oldGroup = DVM000(iacrg+5);                      /*ACC*/
         newGroup = ConstRef(0);                          /*ACC*/
       }
    }
  } 
  } else{ //there is negative loop step
       if(ag[0]  || ag[2]) {
       pipeline=1;
       doAssignTo_After(new SgVarRefExp(Pipe), stage);
                                   
       if(ACC_program && ag[2])      /*ACC*/
       // generating call statement ( in and out compute region):
       //  call dvmh_shadow_renew( BoundGroupRef)              
         doCallAfter(ShadowRenew_H (DVM000(iacrg+2) ));   
       doCallAfter(InitAcross(0,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),(ag[0] ? DVM000(iacrg) : ConstRef(0))));        
       if(IN_COMPUTE_REGION || parloop_by_handler)      
       { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/
         newGroup = ag[0] ? DVM000(iacrg+3) : ConstRef(0); /*ACC*/
       }
    }
  }
  if(dvm_debug) {
      pardo_line = first_do->lineNumber();
      DebugParLoop(cur_st,nloop,iinp+2*nloop);
  } 
 
  StoreLoopPar(init,nloop,iout,NULL);
  StoreLoopPar(last,nloop,iout+nloop,NULL);

  if(opt_loop_range) ChangeLoopInitPar(first_do,nloop,init,stmt->lexNext());//must be after StoreLoopPar

  if (OMP_program == 1) { /*OMP*/
	  if (clause[ACROSS_]) { /*OMP*/
	      ChangeAccrossOpenMPParam (first_do,newj,ub); /*OMP*/
	  } /*OMP*/
  } /*OMP*/


  if(!IN_COMPUTE_REGION && !parloop_by_handler)
  {
   // generating Logical IF statement:
       // begin_lab  IF (DoPL(LoopRef) .EQ. 0) GO TO end_lab
       // and inserting it before  loop nest
       SgStatement *stn = cur_st;
       SgStatement *continue_stat = new SgStatement(CONT_STAT); /*OMP*/
       continue_stat->addAttribute (OMP_MARK);
       InsertNewStatementAfter(continue_stat,cur_st,cur_st->controlParent()); /*OMP*/
       LINE_NUMBER_AFTER(first_do,cur_st);
       begin_lab = GetLabel();
       stn->lexNext()-> setLabel(*begin_lab); 
       end_lab   = GetLabel();
       if(dvm_debug && dbg_if_regim)
       {
           int ino;
	   ino = ndvm;
           doAssignStmtAfter(new SgValueExp(pardo_No)); 
           dopl = doPLmb(iplp,ino);
       } else
         dopl =  doLoop(iplp);
                     //if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab));
                     //if_stmt -> setLabel(*begin_lab); /*29.06.01*/
                     //          BIF_LABEL(stmt->thebif) = NULL;  
       doAssignStmtAfter(dopl);  // podd 17.05.11 (doLoop(iplp));/*OMP*/
       SgGotoStmt *go=new SgGotoStmt(*end_lab);/*OMP*/
       go->addAttribute (OMP_MARK);/*OMP*/
       if_stmt = new SgLogIfStmt(SgEqOp(*DVM000(ndvm-1), c0), *go);/*OMP*/
       if_stmt->addAttribute (OMP_MARK);/*OMP*/
                     //if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab));
                     //cur_st->insertStmtAfter(*if_stmt);
       InsertNewStatementAfter (if_stmt, cur_st, cur_st->controlParent ());/*OMP*/
       if(opt_loop_range) 
       {
            cur_st=if_stmt->lexNext()->lexNext();
            doAssignIndexVar(stmt->expr(2),iout,init);   
       }          
       (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF
                                                               // (error Sage)
  } 
       	      
  if(IN_COMPUTE_REGION || parloop_by_handler)      /*ACC*/
  {    int ilh = doParallelLoopByHandler(iplp, first_do, clause, oldGroup, newGroup,oldGroup2, newGroup2); 
       ACC_CreateParallelLoop(ilh,first_do,nloop,stmt,clause,1);
  }

  if(dvm_debug && dbg_if_regim>1) 
  {
          SgStatement *ifst = new SgIfStmt(*DebugIfNotCondition(), *stdeb); //*new SgStatement(CONT_STAT));// *stdeb); //, *new SgStatement(CONT_STAT));
           
          (if_stmt->lexNext())->insertStmtAfter(*ifst,*if_stmt->controlParent());

          // generating GO TO statement:  GO TO begin_lab
          // and inserting it after last statement of parallel loop nest copy
                // InsertNewStatementBefore(new SgGotoStmt(*begin_lab),ifst->lastNodeOfStmt());
                //(ifst->lastNodeOfStmt())->insertStmtBefore(*new SgGotoStmt(*begin_lab),*ifst);
                //InsertNewStatementAfter(new SgGotoStmt(*begin_lab),stdeb->lastNodeOfStmt(),ifst);
          (stdeb->lastNodeOfStmt())->insertStmtAfter(*new SgGotoStmt(*begin_lab),*ifst);
          TranslateBlock(stdeb);          
   } 

}

void ChangeLoopInitPar(SgStatement*first_do,int nloop,SgExpression *do_init[],SgStatement *after)
{ SgStatement *stat, *st;
  SgForStmt *stdo;
  SgSymbol *s,*do_var, *s_start;
  SgExpression *init;
  int i;
  stat=cur_st;
  cur_st=after;

  for(st=first_do,i=0; i<nloop; st=st->lexNext(),i++) {
    stdo = isSgForStmt(st);
    if(!stdo) break;  
    do_var = stdo->symbol();     
    init   = stdo->start();
//   for(i=0; i<n; i++) 
    if(isSgVarRefExp(init)) {
      s = init->symbol();
      if(s && isInSymbList(newvar_list,s)){
        s_start = CreateInitLoopVar(do_var,s);
        doAssignTo_After(new SgVarRefExp(s_start),&(init->copy()));
        stdo->setStart(*new SgVarRefExp(s_start));
        do_init[i] = stdo->start(); 
      }
    }
  }
  cur_st=stat;
}

int PositiveDoStep(SgExpression *step[], int i)
{int s;
 SgExpression *es;
 if(step[i]->isInteger())
    s=step[i]->valueInteger();
 else if((es=Calculate(step[i]))->isInteger())
    s= es->valueInteger();
 else
 { err("Non constant step in parallel loop nest with ACROSS clause",613,par_do);
   s =0;
 } 
 if(s >= 0)
    return(1);
 else
    return(0);

}

int Analyze_DO_steps(SgExpression *step[], int step_mask[],int ndo)
{ int s,i;
 s=1;
 for(i=0; i<ndo; i++) {
    step_mask[i] = PositiveDoStep(step, i);
    s = s && step_mask[i];
 }
  if(s) return(1);
  s = -1;
  for(i=0; i<ndo; i++)  
     if(step_mask[i] > 0)
        return (0);
  return (-1);
}

void InOutAcross(SgExpression *e, SgExpression* e_spec[], SgStatement *stmt)
{    
   e_spec[IN_] = NULL;
   e_spec[OUT_]= NULL;
   InOutSpecification(e->lhs(), e_spec);
   InOutSpecification(e->rhs(), e_spec);
   if(e->lhs() && e->rhs() && (e_spec[IN_] == NULL || e_spec[OUT_] == NULL))
      err("Double IN/OUT specification in ACROSS clause",257 ,stmt); 
}

void InOutSpecification(SgExpression *ea,SgExpression* e_spec[])
{
           SgKeywordValExp *kwe;
                 
           if(!ea) return;
           if(ea->variant() != DDOT) { 
              e_spec[IN_] = ea; 
           } else {
              if((kwe=isSgKeywordValExp(ea->lhs())) && (!strcmp(kwe->value(),"in")))
                     e_spec[IN_]  = ea->rhs();
              else           
                     e_spec[OUT_] = ea->rhs();
           }            
}

void CreateShadowGroupsForAccross(SgExpression *in_spec,SgExpression *out_spec,SgStatement * stmt,SgExpression *gleft,SgExpression *g,SgExpression *gright,int ag[],int all_steps,int step_mask[],SgExpression *tie_list)
{
  RecurList(in_spec, stmt,gleft, ag,0,all_steps,step_mask,tie_list); 
  RecurList(out_spec,stmt,gleft, ag,0,all_steps,step_mask,tie_list);
  RecurList(in_spec, stmt,gright,ag,2,all_steps,step_mask,tie_list); 
  RecurList(out_spec,stmt,gright,ag,2,all_steps,step_mask,tie_list); 
  if(ag[1] == -1)
     ag[1] = 0;
  else
     RecurList(out_spec,stmt,g,ag,1,all_steps,step_mask,tie_list); 
}

void DefineLoopNumberForNegStep(int step_mask[], int n,int loop_num[])
{int i;
 for(i=0;i<n;i++)
   if(loop_num[i] > 0)
     if(step_mask[loop_num[i]-1] > 0)
       loop_num[i] = 0;
}

void DefineStepSignForDimension( int step_mask[], int n, int loop_num[], int sign[] )
{int i;
  for(i=0; i<MAX_DIMS; i++)
    sign[i] = 0; 
  for(i=0;i<n;i++)
    if(loop_num[i] > 0)
      sign[i] = step_mask[loop_num[i]-1] > 0 ? 1 : -1;
}

/*
void CreateShadowGroupsForAccrossNeg(SgExpression *in_spec, SgStatement * stmt, SgExpression *gleft,SgExpression *gright,int ag[],int all_positive_step,int loop_num[])
{
  RecurList(in_spec, stmt,gleft, ag,0,all_positive_step,loop_num);
 // RecurList(out_spec,stmt,gleft, ag,0);
  RecurList(in_spec, stmt,gright,ag,2,all_positive_step,loop_num);
 // RecurList(out_spec,stmt,gright,ag,2);
  if(ag[1] == -1)
     ag[1] = 0;
 // else
 //    RecurList(out_spec,stmt,g,ag,1); 
}
*/

SgExpression *FindArrayRefWithLoopIndexes(SgSymbol *ar, SgStatement *st, SgExpression *tie_list)
{
  SgExpression *arr_ref = NULL;
  if( ar == st->expr(0)->symbol())
    arr_ref =  st->expr(0);
  else  
    arr_ref = tie_list ? isInTieList(ar, tie_list) : NULL;
  if(!arr_ref)
    Error("Array from ACROSS clause should be specified in TIE clause: %s", ar->identifier(), 648, st);
  return arr_ref;
}

int RecurList (SgExpression *el, SgStatement *st, SgExpression *gref, int *ag, int gnum,int all_steps,int step_mask[],SgExpression *tie_list)
{ SgValueExp c1(1);
  int rank,ndep;
  int  ileft,idv[6];
  SgExpression *es, *ear, *head, *esec, *esc, *lrec[MAX_DIMS], *rrec[MAX_DIMS], *gref_acc = NULL;
  SgSymbol *ar;
  int loop_num[MAX_DIMS], sign[MAX_DIMS];
  //int nel = 0;

  // looking through the dependent_array_list
  for(es = el; es; es = es->rhs()) {
    if( es->lhs()->variant() == ARRAY_OP){
      ear = es->lhs()->lhs();
      esec= es->lhs()->rhs();
      //corner = 1;
    } else {
      ear = es->lhs(); // dependent_array 
      esec = NULL;
      //corner = 0;
      if(!ear->lhs()){ //whole array
        iacross = -1;
        return(0);
      }
    }
     ar = ear->symbol();
     if(HEADER(ar))
       head = HeaderRef(ar);
     else 
     {
       Error("'%s' isn't distributed array", ar->identifier(), 72,st);
       return(0);
     }
     rank = Rank(ar);
     ileft = ndvm;   
     if(!all_steps) 
       DefineStepSignForDimension(step_mask, DefineLoopNumberForDimension(st, FindArrayRefWithLoopIndexes(ar,st,tie_list), loop_num), loop_num, sign); 
     ndep = doRecurLengthArrays(ear->lhs(), ear->symbol(), st, gnum, all_steps, sign); 
     if(!ndep) continue;
     if(GROUP_INDEX(gref))
       gref_acc=DVM000(*GROUP_INDEX(gref));
     ag[gnum]++;
     if(ag[gnum] == 1)
     { CreateBoundGroup(gref);        
       if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) )  /*ACC*/
          CreateBoundGroup(gref_acc);
     }

     if(!esec)
     { doCallAfter(InsertArrayBoundDep(gref, head, ileft, ileft+rank, 1, ileft+2*rank));
       if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) )  /*ACC*/
          doCallAfter(InsertArrayBoundDep(gref_acc, head, ileft, ileft+rank, 1, ileft+2*rank));
     }
     else {
       if(!Recurrences(ear->lhs(),lrec,rrec,MAX_DIMS))
          err("Recurrence list is not specified", 261, st);
       for(esc=esec; esc; esc=esc->rhs()) {
          doSectionIndex(esc->lhs(), ear->symbol(), st, idv, ileft, lrec, rrec);
          doCallAfter(InsertArrayBoundSec(gref, head, idv[0],idv[1],idv[2], idv[3],idv[4], idv[5], 1, ileft+2*rank));  
          if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) )  /*ACC*/
            doCallAfter(InsertArrayBoundSec(gref_acc, head, idv[0],idv[1],idv[2], idv[3],idv[4], idv[5], 1, ileft+2*rank));    
       }

     }     
  }
  return(ag[gnum]);
}

int doRecurLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int rtype, int all_steps,int sign[])
{SgValueExp c0(0),c1(1),cM1(-1),c3(3), c5(5);
 int rank,nw,nnl,positive=0;
 int i=0;
 nnl = 0;
 SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS],*eneg;
 rank = Rank(ar);
 if(!shl)  //without dependence-list ,
           // by default dependence length is equal to the maximal size of shadow edge
   for(i=rank-1,nnl=1; i>=0; i--) {
        bound[i]  = &cM1;
        null[i]   = &c0;
        shsign[i] = &c3;
   }
 if(!TestMaxDims(shl,ar,st))
     return(0);
 for(wl = shl; wl; wl = wl->rhs(),i++) {
     ew = wl->lhs();
     positive = (all_steps == 1 || all_steps == 0 && sign[i] >= 0) ? 1 : 0;
     if(rtype > 0) {
       if(positive)  
         bound[i] = &(ew->rhs())->copy();//right bound 
       else 
         bound[i] = &(ew->lhs())->copy();//left bound
         
     } 
     else {
      if(positive)   
         bound[i] = &(ew->lhs())->copy();//left bound
       else
         bound[i] = &(ew->rhs())->copy();//right bound
     }  
     null[i] = &c0;
     if(bound[i]->variant() != INT_VAL) {
         Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st);
         shsign[i] = &c1;
     }
     else if(bound[i]->valueInteger() != 0) {           
             nnl++;
             if(positive) 
                 shsign[i] = (rtype > 0) ?  &c5 : &c3;
             else {
                 shsign[i] = (rtype > 0) ?  &c3 : &c5; 
                 eneg = null[i] ;
                 null[i] = bound[i];
                 bound[i] = eneg;
             }
     }    else
               shsign[i] = &c1;
 }
  nw = i; 

  if (rank && (nw != rank) ) {// wrong dependence length list length
    if(rtype == 0)
    Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); 
    return(0);
  }
  if(!nnl) return(0);
  if(rtype > 0){
    TestShadowWidths(ar, null, bound, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);   
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(shsign[i]);
  }
  else {
    TestShadowWidths(ar, bound, null, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(shsign[i]);
  }
  return(nnl);
}

/* according Language Description (by dependence length)
int doRecurLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int rtype,int all_positive_step,int loop_num[])
{SgValueExp c0(0),c1(1),cM1(-1),c3(3), c5(5);
 int rank,nw,nnl,flag;
 int i=0;
 nnl = 0;
 SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS],*eneg;
 rank = Rank(ar);
 if(!shl)  //without dependence-list ,
           // by default dependence length is equal to the maximal size of shadow edge
   for(i=rank-1,nnl=1; i>=0; i--){
        bound[i]  = &cM1;
        null[i]   = &c0;
        shsign[i] = &c3;
   }
 if(!TestMaxDims(shl,ar,st))
     return(0);
 for(wl = shl; wl; wl = wl->rhs(),i++) {
     ew = wl->lhs();
     flag = all_positive_step ? 0 : loop_num[i];
     if(rtype > 0) {
                      //if(!flag)  
         bound[i] = &(ew->rhs())->copy();//right bound 
                      //else 
                      //  bound[i] = &(ew->lhs())->copy();//left bound
         
     } 
     else {
                     //if(!flag) 
         bound[i] = &(ew->lhs())->copy();//left bound
                     //else
                     //  bound[i] = &(ew->rhs())->copy();//right bound
     }  
     null[i] = &c0;
     if(bound[i]->variant() != INT_VAL) {
         Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st);
         shsign[i] = &c1;
     }
     else if(bound[i]->valueInteger() != 0) {           
             nnl++;
             if(!flag)
                 shsign[i] = (rtype > 0) ?  &c5 : &c3;
             else {
                 shsign[i] = (rtype > 0) ?  &c3 : &c5; 
                 eneg = null[i] ;
                 null[i] = bound[i];
                 bound[i] = eneg;
             }
     }    else
               shsign[i] = &c1;
 }
  nw = i; 

  if (rank && (nw != rank) ) {// wrong dependence length list length
    if(rtype == 0)
    Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); 
    return(0);
  }
  if(!nnl) return(0);
  if(rtype > 0){
    TestShadowWidths(ar, null, bound, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);   
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(shsign[i]);
  }
  else {
    TestShadowWidths(ar, bound, null, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(shsign[i]);
  }
  return(nnl);
}
*/

int Recurrences(SgExpression *shl, SgExpression *lrec[], SgExpression *rrec[],int n)
{SgValueExp c0(0),c1(1);
 int i;
 SgExpression *wl,*ew;
 if(!shl) //without recurrence list
    return(0);
 for(i=n; i;i--){
     rrec[i-1] = &c0.copy();
     lrec[i-1] = &c0.copy();
 }
  for(wl = shl,i=0; wl; wl = wl->rhs(),i++) {
     ew = wl->lhs();
     rrec[i] = &(ew->rhs())->copy();//right bound 
     lrec[i] = &(ew->lhs())->copy();//left bound
} 
 return(i);
}

int DepList (SgExpression *el, SgStatement *st, SgExpression *gref, int dep)
{ SgValueExp c1(1);
  int corner,rank,ndep;
  int  ileft;
  SgExpression *es, *ear, *head;
  SgSymbol *ar;
  int nel = 0;
  // looking through the dependent_array_list
  for(es = el; es; es = es->rhs()) {
    if( es->lhs()->variant() == ARRAY_OP){
      ear = es->lhs()->lhs();
      corner = 1;
    } else {
      ear = es->lhs(); // dependent_array 
      corner = 0;
      if(!ear->lhs()){ //whole array
        iacross = -1;
        return(0);
      }
    }
     ar = ear->symbol();
     if(HEADER(ar))
       head = HeaderRef(ar);
     else {
       Error("'%s' isn't distributed array", ar->identifier(), 72,st);
       return(0);
     }
     rank = Rank(ar);
     ileft = ndvm;  
     ndep = doDepLengthArrays(ear->lhs(), ear->symbol(), st,dep);
     if(!ndep) continue;
     nel++;
     if(nel == 1)
       CreateBoundGroup(gref);
     if(dep == ANTIDEP)
       doCallAfter(InsertArrayBound(gref, head, ileft, ileft+rank, corner));  
     else 
       doCallAfter(InsertArrayBoundDep(gref, head, ileft, ileft+rank,(corner ? rank : 1), ileft+2*rank));       
  }
  return(nel);
}
/*
int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep)
{SgValueExp c0(0);
 int rank,iright,nw,nnl;
 int i=0;
 SgExpression *wl,*ew, *lbound[7], *ubound[7];
 rank = Rank(ar);
 nnl = 0;
 for(wl = shl; wl; wl = wl->rhs(),i++) {
     ew = wl->lhs();
     if(dep == ANTIDEP){
       lbound[i] = &c0;                 //left bound 
       ubound[i] = &(ew->rhs())->copy();//right bound 
       if(ubound[i]->variant() != INT_VAL)
        Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st);
       else if(ubound[i]->valueInteger() != 0)
         nnl++;    
     } else {
       lbound[i] = &(ew->lhs())->copy();//left bound
       ubound[i] = &c0;                 //right bound 
       if(lbound[i]->variant() != INT_VAL)
        Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st);
       else if(lbound[i]->valueInteger() != 0)
         nnl++; 
     }
  }
  nw = i; 
  TestShadowWidths(ar, lbound, ubound, nw, st);
  if (rank && (nw != rank)) {// wrong shadow width list length
     Error("Length of shadow-edge-list is not equal to  the rank of array '%s'",ar->identifier(),88,st); 
     return(0);
  }
  if(dep == ANTIDEP)
  for(i=rank-1;i>=0; i--)
     doAssignStmtAfter(lbound[i]);
  iright = 0;
  if(nnl)
    iright = ndvm;
    for(i=rank-1;i>=0; i--)
      doAssignStmtAfter(ubound[i]);
  return(iright);

}
*/

int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep)
{SgValueExp c0(0),c1(1),cM1(-1),c3(3);
 int rank,nw,nnl;
 int i=0;
 nnl = 0;
 SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS];
 rank = Rank(ar);
 if(!shl)  //without dependence-list ,
           // by default dependence length is equal to the maximal size of shadow edge
   for(i=rank-1,nnl=1; i>=0; i--){
        bound[i]  = &cM1;
        null[i]   = &c0;
        shsign[i] = &c3;
   }
 if(!TestMaxDims(shl,ar,st))
     return(0);  
 for(wl = shl; wl; wl = wl->rhs(),i++) {
     ew = wl->lhs();
     if(dep == ANTIDEP)
       bound[i] = &(ew->rhs())->copy();//right bound 
     else
       bound[i] = &(ew->lhs())->copy();//left bound
     null[i] = &c0;
     if(bound[i]->variant() != INT_VAL) {
         Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st);
         shsign[i] = &c1;
     } 
     else if(bound[i]->valueInteger() != 0) {
             nnl++;
             shsign[i] = &c3;
     }    else
             shsign[i] = &c1;
 }
  nw = i; 

  if (rank && (nw != rank)) {// wrong dependence length list length
    if(dep == ANTIDEP)
    Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); 
     return(0);
  }
  if(!nnl) return(0);
  if(dep == ANTIDEP){
    TestShadowWidths(ar, null, bound, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);   
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
  }
  else {
    TestShadowWidths(ar, bound, null, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(shsign[i]);
  }
  return(nnl);
}

/*
int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep, int *maxn)
{SgValueExp c0(0),c1(1),cM1(-1);
 int rank,nw,nnl,nsh;
 int i=0;
 nnl = 0;
 nsh = 0;
 SgExpression *wl,*ew, *bound[7],*null[7],*shsign[7];
 rank = Rank(ar);
 if(!shl)  //without dependence-list ,
           // by default dependence length is equal to the maximal size of shadow edge
   for(i=rank-1,nnl=1; i>=0; i--){
        bound[i]  = &cM1;
        null[i]   = &c0;
        shsign[i] = new SgValueExp(7);
   }
  
 for(wl = shl; wl; wl = wl->rhs(),i++) {
     ew = wl->lhs();
     if(dep == ANTIDEP){
       bound[i] = &(ew->rhs())->copy();//right bound 
       null[i] = &c0;
     }
     else {
       bound[i] = &(ew->lhs())->copy();//left bound
       null[i] =  &(ew->rhs())->copy();//right bound 
     }
     if(bound[i]->variant() != INT_VAL)
         Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st);
     else if(bound[i]->valueInteger() != 0) {
             nnl++; nsh++;
             shsign[i] = new SgValueExp(7);
     }    else if(null[i]->valueInteger() != 0){
             shsign[i] = new SgValueExp(5);
             nsh++;
     }    else
             shsign[i] = &c1;
     null[i]   = &c0;
 }
  nw = i; 
  *maxn = nsh;
  if (rank && (nw != rank) && (dep == ANTIDEP)) {// wrong dependence length list length
     Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); 
     return(0);
  }
  if(!nnl) return(0);
  if(dep == ANTIDEP){
    TestShadowWidths(ar, null, bound, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);   
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
  }
  else {
    TestShadowWidths(ar, bound, null, nw, st);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(bound[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(null[i]);
    for(i=rank-1;i>=0; i--)
        doAssignStmtAfter(shsign[i]);
  }
  return(nnl);
}
*/

SgExpression *doLowHighList(SgExpression *shl, SgSymbol *ar, SgStatement *st)
{
  SgValueExp c1(1);
  int nw, i;
  SgExpression *wl, *ew, *lbound[MAX_DIMS], *hbound[MAX_DIMS];
  int rank = Rank(ar);
  if(!TestMaxDims(shl,ar,st))
     return(NULL);
  for(wl = shl,i=0; wl; wl = wl->rhs(),i++) {
     ew = wl->lhs();
     lbound[i] = &(ew->lhs())->copy(); 
     hbound[i] = &(ew->rhs())->copy();
     
     if(lbound[i]->variant() != INT_VAL || hbound[i]->variant() != INT_VAL) {
        Error("Wrong dependence length of distributed array '%s'",ar->identifier(), 179, st);
        lbound[i] = hbound[i] = &c1;
     }
  }

  nw = i; 

  if (rank && (nw != rank) ) 
     Error("Wrong dependence length list of distributed array '%s'", ar->identifier(), 180, st); 

  TestShadowWidths(ar, lbound, hbound, nw, st);
  
  SgExpression *shlist = NULL; 
  for(i=0; i<nw; i++)
  { 
     shlist = AddElementToList(shlist, DvmType_Ref(hbound[i]));
     shlist = AddElementToList(shlist, DvmType_Ref(lbound[i]));
  }

  return( shlist );
}

SgExpression  *isInTieList(SgSymbol *ar, SgExpression *tie_list)
{
  SgExpression *el;
  for(el=tie_list; el; el=el->rhs())
  {
    if(el->lhs()->symbol() && el->lhs()->symbol() == ar)
      return (el->lhs());
    else
      continue;
  }
  return NULL;
}

void AcrossList(int ilh, int isOut, SgExpression *el, SgStatement *st, SgExpression *tie_clause)
{ 
  SgExpression *es, *ear, *head=NULL;  
  
  // looking through the dependent_array_list
  for(es = el; es; es = es->rhs()) {
    
    if( es->lhs()->variant() == ARRAY_OP){
      ear = es->lhs()->lhs();
      err("SECTION  specification is not permitted", 643, st);
    } else {
      ear = es->lhs(); 
      if(!ear->lhs()) { //whole array
        Error("Dependence list is not specified for %s", ear->symbol()->identifier(), 644, st);
        continue;
      }
    }
    SgSymbol *ar = ear->symbol();

    if(!st->expr(0) && (!tie_clause || !isInTieList(ar,tie_clause->lhs())))
      Error("Array from ACROSS clause should be specified in TIE clause: %s", ar->identifier(), 648, st);
    
    SgExpression *head = HeaderForArrayInParallelDir(ar, st, 1);
    doCallAfter(LoopAcross_H2(ilh, isOut, head, Rank(ar), doLowHighList(ear->lhs(), ar, st)));  
  }
}

void StoreLoopPar(SgExpression *par[], int n, int ind, SgStatement*stl)
{ SgStatement *stat = NULL;
  SgSymbol*s;
  int i;
 if(!newvar_list) return;
 if(stl) {
   stat=cur_st;
   cur_st=stl;
 }
  for(i=0; i<n; i++) 
    if(isSgVarRefExp(par[i])) {
      s = par[i]->symbol();
      if(s && isInSymbList(newvar_list,s))
        doAssignTo_After(&(par[i]->copy()),DVM000(ind+i));
    }
  if(stl)
    cur_st=stat;
}

void TestReductionList (SgExpression *el, SgStatement *st)
{
  SgExpression  *er, *ev, *ered, *loc_var;
  symb_list *rv_list=NULL;
  for(er = el; er; er=er->rhs()) {
     ered = er->lhs();    //  reduction
     ev = ered->rhs();    // reduction variable reference
     loc_var=NULL;
     if(isSgExprListExp(ev)) { // MAXLOC,MINLOC
       ev = ev->lhs();
       loc_var = ered->rhs()->rhs()->lhs();  
     } 
     if(!ev->symbol()) continue;
     if(isInSymbList(rv_list,ev->symbol()) )
       Error("Reuse of '%s' in REDUCTION clause", ev->symbol()->identifier(), 663, st );
     else
       rv_list = AddToSymbList(rv_list,ev->symbol());
     if(!loc_var || !loc_var->symbol()) continue;
     if(isInSymbList(rv_list,loc_var->symbol()) )
       Error("Reuse of '%s' in REDUCTION clause", loc_var->symbol()->identifier(), 663, st ); 
     else
       rv_list = AddToSymbList(rv_list,loc_var->symbol());
  }
}

void ReductionList  (SgExpression *el,SgExpression *gref, SgStatement *st, SgStatement *stmt1, SgStatement *stmt2, int ilh2)
{ SgStatement *last,*last1;
  SgExpression  *er, *ev, *ered, *loc_var,*len, *loclen, *debgref;
  int   irv, irf, num_red, ia, ntype,sign, num, locindtype;
  int itsk = 0, ilen = 0;
  SgSymbol *var; 
  SgValueExp c0(0),c1(1);

  TestReductionList (el, st); // double use check
  last = stmt2; last1 = stmt1;

  //looking through the reduction list
  for(er = el; er; er=er->rhs()) {
     ered = er->lhs();    //  reduction
     ev = ered->rhs(); // reduction variable reference
     if(!isSgVarRefExp(ev) && !isSgArrayRefExp(ev) && !isSgExprListExp(ev))
     {   err("Wrong reduction variable",151,st);
         continue;
     }
     loc_var = ConstRef(0);
     loclen = &c0;
     locindtype = 0;
     len =&c1;
     num=num_red=RedFuncNumber(ered->lhs()); 
     if( !num_red) 
        err("Wrong reduction operation name", 70,st);
       /* 
        if(num_red == 8)  //EQV
        err("Reduction function EQV is not supported now",st); 
       */
     if(num_red > 8) { // MAXLOC => 9,MINLOC =>10
        num_red -= 6; // MAX => 3,MIN =>4
       // change loc_array       
        ev = ered->rhs()->lhs(); // reduction variable reference 
        if( !ered->rhs()->rhs() || !ered->rhs()->rhs()->rhs() || ered->rhs()->rhs()->rhs()->rhs()){
                                       //the number of operands is not equal to 3
          err("Illegal operand list of MAXLOC/MINLOC",147,st);
          continue;
        }
        loc_var = ered->rhs()->rhs()->lhs();        //location variable reference
        loclen = ered->rhs()->rhs()->rhs()->lhs(); //the number of coordinates
        if(isSgVarRefExp(loc_var))
	    loclen =  TypeLengthExpr(loc_var->type()); //14.03.03 new SgValueExp(TypeSize(loc_var->type())); 
        else if( isSgArrayRefExp(loc_var)) {
            ia = loc_var->symbol()->attributes();
            if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT) || (ia & INHERIT_BIT))
               Error("'%s' is distributed array", loc_var->symbol()->identifier(), 148,st); 
	 /*
            if(!loc_var->lhs()){ //whole array
              if(Rank(loc_var->symbol())>1)
                Error("Wrong operand of MAXLOC/MINLOC: %s",loc_var->symbol()->identifier(), 149,st);
              loclen = ArrayDimSize(loc_var->symbol(),1); // size of vector in elements
              if(!loclen || loclen->variant()==STAR_RANGE){
                Error("Wrong operand of MAXLOC/MINLOC: %s",loc_var->symbol()->identifier(), st); 
                loclen = &c0;
              }
              else
                loclen = &((*ArrayDimSize(loc_var->symbol(),1)) * (*new SgValueExp(TypeSize(loc_var->symbol()->type()->baseType())))) ; // size of vector in bytes 
	    }
	 */   
            loclen = &(*loclen * (*TypeLengthExpr(loc_var->symbol()->type()->baseType()))) ; // size of vector in bytes       
        	//loclen = &(*loclen * (*new SgValueExp(TypeSize(loc_var->symbol()->type()->baseType())))) ; 14.03.03
	}		   
        else        
            err("Wrong operand of MAXLOC/MINLOC",149,st); 
     }
     var = ev->symbol();
     ia = var->attributes();
     if(isSgVarRefExp(ev))  
           redvar_list= AddNewToSymbList(redvar_list,var); 
     else if( isSgArrayRefExp(ev)) {
           
             //if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT))
             //  Error("'%s' is distributed array", var->identifier(), 148,st);
              
           if(!ev->lhs()){ //whole array
              len = ArrayLengthInElems(var,st,1); //size of array 
              ev  = FirstArrayElement(var);  
              if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT))
              { if(!only_debug) 
                   ev = HeaderRefInd(var,1); 
              }
           }  
     }
     else
        err("Wrong reduction variable",151,st); 
     ntype = VarType_RTS(var);  //RedVarType
     if(!ntype)
        Error("Wrong type of reduction variable '%s'", var->identifier(), 152,st);

     sign = 1;
     if(stmt1 != stmt2) 
       cur_st = last1;
     if(gref)   // interface of RTS1
     {  ilen = ndvm; // index for RedArrayLength
        doAssignStmtAfter(len);
        doAssignStmtAfter(loclen);
     }
     if(num > 8 && loc_var->symbol()) //MAXLOC,MINLOC
       locindtype =  LocVarType(loc_var->symbol(),st);

     irv = ndvm; // index for RedVarRef
     if(!only_debug) {
       if(IN_COMPUTE_REGION || inparloop && parloop_by_handler)    /*ACC*/
       { 
         if(ilh2)  // interface of RTS2
         {  
            doCallAfter(LoopReduction(ilh2,RedFuncNumber_2(num),ev,ntype,len,loc_var,loclen));
            continue;
         }
         int *index = new int;
         *index = irv;
         // adding the attribute (REDVAR_INDEX) to expression for reduction operation
          ered->addAttribute(REDVAR_INDEX, (void *) index, sizeof(int)); 

         doCallAfter (GetActualScalar(var));
         if(num > 8 && loc_var->symbol())
           doCallAfter (GetActualScalar(loc_var->symbol()));
       }
       doAssignStmtAfter(ReductionVar(num_red,ev,ntype,ilen, loc_var, ilen+1,sign));       
       if(num > 8 && loc_var->symbol()) {//MAXLOC,MINLOC
         doAssignStmtAfter(LocIndType(irv, locindtype)); //LocVarType(loc_var->symbol(),st)));        
       }  
     }
     if(debug_regim && st->variant()!=DVM_TASK_REGION_DIR) {
       debgref = idebrg ? DVM000(idebrg) : DebReductionGroup(gref->symbol());
       doCallAfter(D_InsRedVar(debgref,num_red,ev,ntype,ilen, loc_var, ilen+1,locindtype));
     }
     last1 = cur_st;
     if(stmt1 != stmt2) 
         cur_st = last;
     if(!only_debug){
       if(!itsk && st->variant()==DVM_TASK_REGION_DIR){
         itsk = ndvm;
         doAssignStmtAfter(new SgVarRefExp(TASK_SYMBOL(st->symbol())));
       }
       irf = (st->variant()==DVM_TASK_REGION_DIR) ? itsk : iplp;
       doCallAfter(InsertRedVar(gref,irv,irf));
     }
     last = cur_st;
  }   
  /*  if(! only_debug)  
   *     doAssignStmtAfter(SaveRedVars(gref));
   */
   return;
}     

void ReductionVarsStart  (SgExpression *el)
{ 
  SgExpression  *er, *ev, *ered;
  int    num_red; 

  //looking through the reduction list
  for(er = el; er; er=er->rhs()) {
     ered = er->lhs();    //  reduction
     num_red=RedFuncNumber(ered->lhs()); 
     if(num_red <= 8) { 
        ev = ered->rhs();    // reduction variable reference
        if(isSgVarRefExp(ev)){
             doAssignStmtAfter(GetAddresMem(ev)) ;
             FREE_DVM(1);
        }
        if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) {
          if(!ev->lhs()) {//whole array
             doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ;
             FREE_DVM(1);  
	  }
          else {
             doAssignStmtAfter(GetAddresMem(ev)) ;
             FREE_DVM(1);
          }   
        }
     } else  { // MAXLOC => 9,MINLOC =>10
        ev = ered->rhs()->lhs(); // reduction variable reference
        if(isSgVarRefExp(ev)){
             doAssignStmtAfter(GetAddresMem(ev)) ;
             FREE_DVM(1);
        }
        if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) {
          if(!ev->lhs()) {//whole array
             doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ;
             FREE_DVM(1);  
	  }
          else {
             doAssignStmtAfter(GetAddresMem(ev)) ;
             FREE_DVM(1);
          }   
        }
     /*
        if( ered->rhs()->rhs()->rhs()){ //there are >1 location variables
          ind = *((int*)(ered)->attributeValue(0,LOC_ARR));
          for ( ind_var_list = ered->rhs()->rhs(),ind_num=0; ind_var_list; ind_var_list=ind_var_list->rhs(), ind_num++)
            doAssignTo_After(DVM000(ind+ind_num),ind_var_list->lhs()) ;
        } else
     */
	if(ered->rhs()->rhs() && isSgVarRefExp( ered->rhs()->rhs()->lhs())){
                                                                       //location variable
            doAssignStmtAfter(GetAddresMem( ered->rhs()->rhs()->lhs())) ;
            FREE_DVM(1);
	}  
	if(ered->rhs()->rhs() && isSgArrayRefExp( ered->rhs()->rhs()->lhs()) && !IS_DVM_ARRAY(ered->rhs()->rhs()->lhs()->symbol())){ //location array
 
          if(!( ered->rhs()->rhs()->lhs())->lhs()) {//whole array
            doAssignStmtAfter(GetAddresMem(FirstArrayElement((ered->rhs()->rhs()->lhs())->symbol()))) ;
            FREE_DVM(1);
	  } else {
            doAssignStmtAfter(GetAddresMem( ered->rhs()->rhs()->lhs())) ;
            FREE_DVM(1);
	  }
	}
	
     }
  }   
  if(redl) {// for HPF_program
    reduction_list *erl;  
    for(erl = redl; erl; erl=erl->next) {
      num_red=erl->red_op;     
      ev = erl->red_var; // reduction variable reference  
      if(isSgVarRefExp(ev)){
          doAssignStmtAfter(GetAddresMem(ev)) ;
          FREE_DVM(1);
      }   
    }  
  }       
}    
/*
void ReductionVarsWait  (SgExpression *el)
{ int ind;
  SgExpression  *er, *ered, *ind_var_list;
  int    num_red, ind_num; 
  //looking through the reduction list
  for(er = el; er; er=er->rhs()) {
     ered = er->lhs();    //  reduction
     num_red=RedFuncNumber(ered->lhs()); 
     if((num_red > 8) && ( ered->rhs()->rhs()->rhs())){ // MAXLOC => 9,MINLOC =>10 and
                                                        //there are >1 location variables
        ind = *((int*)(ered)->attributeValue(0,LOC_ARR));
        for ( ind_var_list = ered->rhs()->rhs(),ind_num=0; ind_var_list; ind_var_list=ind_var_list->rhs(), ind_num++)
          doAssignTo_After(ind_var_list->lhs(),DVM000(ind+ind_num)) ;
       } 
      
  }
     
}    
*/

int LocElemNumber(SgExpression *en)
{
    SgExpression *ec;
    int n;
    n = 0;
    ec = Calculate(en);
    if (ec->isInteger())
        n = ec->valueInteger();
    else
        err("Can not calculate number of elements in location array", 595, parallel_dir);
    return(n);
}

void    InsertReductions_H(SgExpression *red_op_list, int ilh)
{
    SgStatement *last;
    SgExpression  *er, *ev, *ered, *loc_var, *en;
    int   irv, num_red, num;
    SgType *type, *loc_type;

    last = NULL;
    if (!irg && IN_COMPUTE_REGION)
        err("Asynchronous reduction is not implemented yet for GPU", 596, parallel_dir);
    //looking through the reduction_op_list
    for (er = red_op_list; er; er = er->rhs())
    {
        ered = er->lhs();    //  reduction  (variant==ARRAY_OP)
        irv = IND_REDVAR(ered);
        ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC 
        num = num_red = RedFuncNumber(ered->lhs());
        if (num > 8)   // MAXLOC => 9,MINLOC =>10
        {
            num_red -= 6; // MAX => 3,MIN =>4      
            ev = ered->rhs()->lhs(); // reduction variable reference        
            loc_var = ered->rhs()->rhs()->lhs();        //location array reference
            if (loc_var->lhs())  // array element reference, it must be array name
                Error("Wrong operand of MAXLOC/MINLOC: %s", loc_var->symbol()->identifier(), 149, parallel_dir);
            en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array
            loc_el_num = LocElemNumber(en);
            loc_type = loc_var->symbol()->type();
        }

        type = ev->symbol()->type();
        if (isSgArrayType(type))
        {
            if (isSgArrayRefExp(ev) && !ev->lhs() && !HEADER(ev->symbol())) // whole one-dimensional array
                ;
            else
                Error("Reduction variable %s is array (array element), not implemented yet", ev->symbol()->identifier(), 597, parallel_dir);
            type = type->baseType();
        }

        //if((nr =TestType(type)) == 5 || nr == 6)  // COMPLEX or DCOMPLEX
        //   Error("Illegal type of reduction variable %s, not implemented yet for GPU",ev->symbol()->identifier(),592,parallel_dir);

        InsertNewStatementAfter(LoopInsertReduction_H(ilh, irv), cur_st, cur_st->controlParent());

    }
}

void NewVarList(SgExpression *nl,SgStatement *stmt)
{SgExpression *el,*e;
  for(el=nl; el;el=el->rhs()){
     e=el->lhs();
     if(e->symbol()){
        newvar_list=AddToSymbList(newvar_list,e->symbol());
        //testing
        if(IS_DUMMY(e->symbol()) || IS_SAVE(e->symbol()) || IN_COMMON(e->symbol()))
	  Error("Illegal variable in new-clause: %s",e->symbol()->identifier(),168,stmt); // variable in NEW clause may not be dummy argument, have the SAVE attribute,occur in a COMMON block        
     }
  } 
}

void ReceiveArray(SgExpression *spec_accr,SgStatement *parst)
{SgExpression *es,*el;
 SgSymbol *ar;
 int is,tp;
 // looking through the array_list
  for(es = spec_accr; es; es = es->rhs()) {
     ar =  es->lhs()->symbol();
     switch(ar->type()->baseType()->variant()) {
      case T_INT:     tp = 1; break;
      case T_FLOAT:   tp = 3; break;
      case T_DOUBLE:  tp = 4; break;
      case T_BOOL:    tp = 1; break;
      case T_COMPLEX: tp = 6; break;
      case T_DCOMPLEX: tp = 8; break;
      default:        tp = 0; break;
     }
     is = ndvm;
     if(tp == 6 || tp == 8){
       doAssignStmtAfter(&(*ArrayLengthInElems(ar,parst,1)*(*new SgValueExp(2))));
       tp = tp/2;
     } else
       doAssignStmtAfter(ArrayLengthInElems(ar,parst,1));
     el = FirstArrayElement(ar);
     if(HEADER(ar))
       DistArrayRef(el,0,parst);
     doAssignStmtAfter(DVM_Receive(iplp,GetAddresMem(el),tp,is));
 
  }
}

void SendArray(SgExpression *spec_accr)
{SgExpression *es,*el;
 SgSymbol *ar;
 int is,tp;
 // looking through the array_list
  for(es = spec_accr; es; es = es->rhs()) {
     ar =  es->lhs()->symbol();
     switch(ar->type()->baseType()->variant()) {
      case T_INT:     tp = 1; break;
      case T_FLOAT:   tp = 3; break;
      case T_DOUBLE:  tp = 4; break;
      case T_BOOL:    tp = 1; break;
      case T_COMPLEX: tp = 6; break;
      case T_DCOMPLEX: tp = 8; break;
      default:        tp = 0; break;
     }
     is = ndvm;
     if(tp == 6 || tp == 8){
         doAssignStmtAfter(&(*ArrayLengthInElems(ar,cur_st,0)*(*new SgValueExp(2))));
         tp = tp/2;
     } else
         doAssignStmtAfter(ArrayLengthInElems(ar,cur_st,0));
     el = FirstArrayElement(ar);
     if(HEADER(ar))
       DistArrayRef(el,0,cur_st);
     doAssignStmtAfter(DVM_Send(iplp,GetAddresMem(el),tp,is));
 
  }
}

void  CudaBlockSize(SgExpression *cuda_block_list)
{
    SgExpression *el;
    el = cuda_block_list;
    if (!el)  return;
    doAssignStmtAfter(el->lhs());
    el = el->rhs();
    if (el)
        doAssignStmtAfter(el->lhs());
    else
    {
        doAssignStmtAfter(new SgValueExp(1));  //by default sizeY = 1
        doAssignStmtAfter(new SgValueExp(1));  //by default sizeZ = 1
        return;
    }
    el = el->rhs();
    if (el)
        doAssignStmtAfter(el->lhs());
    else
        doAssignStmtAfter(new SgValueExp(1));  //by default sizeZ = 1
}

void  CudaBlockSize(SgExpression *cuda_block_list,SgExpression *esize[])
{
    SgExpression *el;
    el = cuda_block_list;
    esize[0] = el->lhs();
    el = el->rhs();
    if (el)
        esize[1] = el->lhs();
    else
    {
        esize[1] = new SgValueExp(1);  //by default sizeY = 1
        esize[2] = new SgValueExp(1);  //by default sizeZ = 1
        return;
    }
    el = el->rhs();
    if (el)
        esize[2] = el->lhs();
    else
        esize[2] = new SgValueExp(1);  //by default sizeZ = 1
}

//***********************************************************************************************
//  Interface of RTS2
//***********************************************************************************************
int TestReductionClause(SgExpression *e)
{         
   if( e->symbol()) // asynchronous reduction
      return 0;
   SgExpression *er, *ev;
   for(er = e->lhs(); er; er=er->rhs()) 
   {
     ev = er->lhs()->rhs();    // reduction variable reference
     if(isSgArrayRefExp(ev) && HEADER(ev->symbol()) ) 
        return 0;
     if(isSgExprListExp(ev) && HEADER(ev->lhs()->symbol()) )   //MAXLOC,MINLOC
        return 0;
   }
   return 1;     
}

int CreateParallelLoopByHandler_H2(SgExpression *init[], SgExpression *last[], SgExpression *step[], int nloop)
{ SgExpression *e=NULL,*el,*arglist=NULL;
 // generate call dvmh_loop_create(const DvmType *pCurRegion, const DvmType *pRank, /* const DvmType *pStart, const DvmType *pEnd, const DvmType *pStep */...)
   for(int i=nloop-1; i>=0; i--)
   {   
      e =  len_DvmType ? TypeFunction(SgTypeInt(),step[i],new SgValueExp(len_DvmType) ) : step[i];
      (el = new SgExprListExp(*e))->setRhs(arglist);           
      arglist = el; 
      e =  len_DvmType ? TypeFunction(SgTypeInt(),last[i],new SgValueExp(len_DvmType) ) : last[i];
      (el = new SgExprListExp(*e))->setRhs(arglist);           
      arglist = el; 
      e =  len_DvmType ? TypeFunction(SgTypeInt(),init[i],new SgValueExp(len_DvmType) ) : init[i];
      (el = new SgExprListExp(*e))->setRhs(arglist);           
      arglist = el; 
   }
   int ilh = ndvm;
   doAssignStmtAfter(LoopCreate_H2(nloop,arglist));
   return(ilh);
}

SgExpression *AxisList(SgStatement *stmt, SgExpression *tied_array_ref)
{
   SgExpression *axis[MAX_LOOP_LEVEL],
                *coef[MAX_LOOP_LEVEL],
                *cons[MAX_LOOP_LEVEL];
   SgExpression *arglist=NULL, *el, *e, *c;

   int nt = Alignment(stmt,tied_array_ref,axis,coef,cons,2); // 2 - interface of RTS2
   for(int i=0; i<nt; i++)
   {  
      c = Calculate(coef[i]);
      if(c && c->isInteger() && (c->valueInteger() < 0))
         e =  & SgUMinusOp(*DvmType_Ref(axis[i]));
      else
         e =  DvmType_Ref(axis[i]);  
      (el = new SgExprListExp(*e))->setRhs(arglist);
      arglist = el;
   }
   (el = new SgExprListExp(*ConstRef(nt)))->setRhs(arglist);  // add rank to axis list
   arglist = el;
   return arglist;
}

SgExpression *MappingList(SgStatement *stmt, SgExpression *aref)
{
   SgExpression *axis[MAX_LOOP_LEVEL],
                *coef[MAX_LOOP_LEVEL],
                *cons[MAX_LOOP_LEVEL];
   SgExpression *arglist=NULL, *el, *e;

   int nt = Alignment(stmt,aref,axis,coef,cons,2); // 2 - interface of RTS2
   for(int i=0; i<nt; i++)
   {         
      e = AlignmentLinear(axis[i],ReplaceFuncCall(coef[i]),cons[i]);   //Calculate(cons[i])    
      (el = new SgExprListExp(*e))->setRhs(arglist);
      arglist = el;
   }
   (el = new SgExprListExp(*ConstRef(nt)))->setRhs(arglist);  // add rank to axis list
   arglist = el;
   return arglist;
}


void MappingParallelLoop(SgStatement *stmt, int ilh )
{
   SgExpression *axis[MAX_LOOP_LEVEL],
                *coef[MAX_LOOP_LEVEL],
                *cons[MAX_LOOP_LEVEL];
   SgExpression *arglist=NULL, *el, *e;

   if(!stmt->expr(0))   // undistributed parallel loop
      return;
   int nt = Alignment(stmt,NULL,axis,coef,cons,2); // 2 - interface of RTS2
   for(int i=0; i<nt; i++)
   {         
      e = AlignmentLinear(axis[i],ReplaceFuncCall(coef[i]),cons[i]);   //Calculate(cons[i])    
      (el = new SgExprListExp(*e))->setRhs(arglist);
      arglist = el;
   }
   SgExpression *desc = HeaderRef(stmt->expr(0)->symbol()); //Register_Array_H2(HeaderRef(stmt->expr(0)->symbol())); //!!! temporary
   doCallAfter(LoopMap(ilh,desc,nt,arglist));
}

void Interface_2(SgStatement *stmt,SgExpression *clause[],SgExpression *init[],SgExpression *last[],SgExpression *step[],int nloop,int ndo,SgStatement *first_do) //int iout,SgStatement *stl,SgSymbol *newj,int ub))
{ 
  if (clause[SHADOW_RENEW_])  //there is SHADOW_RENEW clause
     ShadowList(clause[SHADOW_RENEW_]->lhs(), stmt, NULL);
                                       
  // create loop
  int ilh = CreateParallelLoopByHandler_H2(init, last, step, nloop);
  MappingParallelLoop(stmt, ilh);
  //--------------------------------------------------------------------------- 
  // processing specifications/clauses
  // 
  if (clause[CUDA_BLOCK_])  //there is CUDA_BLOCK clause
  {
     SgExpression *eSize[3];
     CudaBlockSize(clause[CUDA_BLOCK_]->lhs(), eSize);
     doCallAfter(SetCudaBlock_H2(ilh, eSize[0], eSize[1], eSize[2]));
  }
  if (clause[TIE_])  //there is TIE clause     
     for (SgExpression *el=clause[TIE_]->lhs(); el; el=el->rhs())  //list of tied arrays
     {
        SgExpression *head = HeaderForArrayInParallelDir(el->lhs()->symbol(), stmt, 1);
        doCallAfter(Correspondence_H(ilh, head, AxisList(stmt, el->lhs())));
     }  
  if (clause[CONSISTENT_])  //there is CONSISTENT clause
     for (SgExpression *el = clause[CONSISTENT_]->lhs(); el; el=el->rhs())
        InsertNewStatementAfter(Consistent_H(ilh, HeaderForArrayInParallelDir(el->lhs()->symbol(), stmt, 0), MappingList(stmt, el->lhs())), cur_st, cur_st->controlParent());

  if (clause[SHADOW_COMPUTE_]) //there is SHADOW_COMPUTE clause
  {
     if ( (clause[SHADOW_COMPUTE_]->lhs()))
	ShadowComp(clause[SHADOW_COMPUTE_]->lhs(),stmt,ilh);
     else 
        doCallAfter(ShadowCompute(ilh,HeaderRef(stmt->expr(0)->symbol()),0,NULL));          
        //doCallAfter(ShadowCompute(ilh,Register_Array_H2(HeaderRef(stmt->expr(0)->symbol())),0,NULL));                 
  }
  if (clause[REDUCTION_])  //there is REDUCTION clause
  {
     red_list = clause[REDUCTION_]->lhs();
     ReductionList(red_list,NULL,stmt,cur_st,cur_st,ilh);
  }
  if (clause[ACROSS_])  //there is ACROSS clause
  {
     SgExpression *e_spec[2];
     InOutAcross(clause[ACROSS_],e_spec,stmt);
     if (e_spec[IN_])
        AcrossList(ilh,IN_, e_spec[IN_], stmt, clause[TIE_]);
     if (e_spec[OUT_])
        AcrossList(ilh,OUT_,e_spec[OUT_],stmt, clause[TIE_]);
  }
  if (clause[STAGE_] && !(clause[STAGE_]->lhs()->variant()==MINUS_OP && INTEGER_VALUE(clause[STAGE_]->lhs()->lhs(),1)))  //there is STAGE clause and is not STAGE(-1)
      
      doCallAfter(SetStage(ilh, clause[STAGE_]->lhs()));

  //---------------------------------------------------------------------------
  LINE_NUMBER_AFTER(first_do,cur_st);      
  cur_st->addComment(ParallelLoopComment(first_do->lineNumber()));    

  ACC_CreateParallelLoop(ilh,first_do,nloop,stmt,clause,2);  //oldGroup,newGroup,oldGroup2,newGroup2
}
//************************************************************************************************

int ParallelLoop_Debug(SgStatement *stmt)
{
  SgStatement *st,*stl = NULL,*stg, *st3;
  SgStatement *first_do, *stdeb = NULL;
  SgValueExp c0(0);
  int i,nloop,ndo, iinp,iout,ind, mred;
   
  SgForStmt *stdo;
  SgValueExp c1(1);
  
  SgExpression *step[MAX_LOOP_LEVEL], 
               *init[MAX_LOOP_LEVEL],
               *last[MAX_LOOP_LEVEL],
               *vpart[MAX_LOOP_LEVEL];
  SgSymbol     *do_var[MAX_LOOP_LEVEL];
  
  SgExpression *vl, *dovar, *e, *el;

  if (!OMP_program) {/*OMP*/
	 first_do = stmt -> lexNext();// first DO statement of the loop nest
  } else {
      first_do = GetLexNextIgnoreOMP(stmt);// first DO statement of the loop nest /*OMP*/
  }
  newvar_list = NULL;
  redgref = NULL; red_list = NULL; irg = 0; idebrg = 0; mred =0;
  LINE_NUMBER_AFTER(stmt,stmt);
  TransferLabelFromTo(first_do, stmt->lexNext());

 //generating call to 'bploop' function of performance analizer (begin of parallel interval)
  if(perf_analysis && perf_analysis != 2) 
    InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb'
  
  iplp = 0;
  ndo = i = nloop = 0;
  // looking through the do_variables list
  vl = stmt->expr(2); // do_variables list
  for(dovar=vl; dovar; dovar=dovar->rhs())
        nloop++;

  // looking through the specification list
  for(el=stmt->expr(1); el; el=el->rhs()) {
     e = el->lhs();            // specification
     switch (e->variant()) {       
           case REDUCTION_OP:  
                if(mred !=0) break;
                mred = 1;
                red_list = e->lhs();      
                if(  e->symbol()){
		  redgref = new SgVarRefExp(e->symbol());
                  doIfForReduction(redgref,1);
                  nloopred++;
                  stg = doIfForCreateReduction( e->symbol(),nloopred,1);
                  //cur_st->setControlParent(stmt->controlParent()); //to insert correctly next statements
                  st3 = cur_st;
                  cur_st = stg;
                 //looking through the reduction list
                  ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); 
                  cur_st = st3;
                  InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); 
               
                } else {
                  irg = ndvm; 
                  redgref = DVM000(irg);
                  doAssignStmtAfter(CreateReductionGroup());
                  idebrg = ndvm; 
                  doAssignStmtAfter( D_CreateDebRedGroup());
                  //looking through the reduction list
                  ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); 
                }
                break; 
        
           case CONSISTENT_OP:                                         
           case NEW_SPEC_OP:       
           case SHADOW_RENEW_OP: 
           case SHADOW_COMP_OP:        
           case SHADOW_START_OP:
           case SHADOW_WAIT_OP:
           case REMOTE_ACCESS_OP:  
           case INDIRECT_ACCESS_OP:
           case STAGE_OP:
           case ACROSS_OP:          
                break;  
     }
  }       

  iout = ndvm; 
  //initialization vpart[]
  for(i=0; i<MAX_LOOP_LEVEL; i++)
     vpart[i] = NULL;
  i = 0; 
  // looking through the loop nest 
  for(st=first_do; i<nloop; st=st->lexNext(),i++) {
     stdo = isSgForStmt(st);
     if(!stdo)
       break; 
     stl = st; 
     step[i]   = stdo->step();
     if(!step[i])
       step[i] = & c1.copy();  // by default: step = 1
     init[i]=isSpecialFormExp(&stdo->start()->copy(),i,iout+i,vpart,do_var);
     if(init[i])
         step[i] = & c1.copy(); 
       else
         init[i]   = stdo->start();
        
  
     last[i]   = stdo->end();  
 
     if(dbg_if_regim) {// setting new loop parameters
       if(vpart[i]) 
         stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form
                                                    //step is not replaced
       else  
         stdo->setStart(*DVM000(iout+i));  
       
       stdo->setEnd(*DVM000(iout+i+nloop));
     }

     do_var[i] = stdo->symbol(); 
     SetDoVar(stdo->symbol());  
             
  }
  ndo = i;  

  // test whether the directive is correct
  if( !TestParallelDirective(stmt, nloop, ndo, first_do))
     return(0);    // directive is ignored
  
  if(dbg_if_regim>1) {  //copy loop nest
    SgStatement *last_st,*lst;
    last_st= LastStatementOfDoNest(first_do);
    if(last_st != (lst=first_do->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) 
     { last_st=ReplaceLabelOfDoStmt(first_do,last_st, GetLabel());
       ReplaceDoNestLabel_Above(last_st,first_do,GetLabel());
     }
    stdeb=first_do->copyPtr();         
  }


  for(i=0; i<nloop; i++)
     doAssignStmtAfter( init[i] );
  for(i=0; i<nloop; i++)
     doAssignStmtAfter( last[i] );
  for(i=0; i<nloop; i++)
     doAssignStmtAfter( step[i] );
  
  iplp = iout;
  iinp = ndvm;     
  OpenParLoop_Inter(stl,iinp,iinp+nloop,do_var,nloop);
  // creating LoopVarTypeArray
  ndvm += nloop;
  for(i=0; i<nloop; i++)
     doAssignStmtAfter( new SgValueExp(LoopVarType(do_var[i],stmt)));
     
  pardo_line = first_do->lineNumber();
  DebugParLoop(cur_st,nloop,iout); //DebugParLoop(cur_st,nloop,iinp+2*nloop); 


  if(dbg_if_regim){ // generating Logical IF statement:
       // begin_lab  IF (doplmbseq(...) .EQ. 0) GO TO end_lab
       // and inserting it before  loop nest
       int ino;
       SgExpression *dopl;
       SgStatement *stn, *if_stmt;
       stn = cur_st;
       LINE_NUMBER_AFTER(first_do,cur_st);
       begin_lab = GetLabel();
       stn->lexNext()-> setLabel(*begin_lab); 
       end_lab   = GetLabel();

       ino = ndvm;
       doAssignStmtAfter(new SgValueExp(pardo_No)); 
       dopl = doPLmbSEQ(ino, nloop, iout);

       if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab));
       cur_st->insertStmtAfter(*if_stmt);
       (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF
                                                            // (error Sage)
  

       if(dbg_if_regim>1) {
           SgStatement *ifst;
           ifst = new SgIfStmt(*DebugIfNotCondition(), *stdeb);
           
           (if_stmt->lexNext())->insertStmtAfter(*ifst,*if_stmt->controlParent());

          // generating GO TO statement:  GO TO begin_lab
          // and inserting it after last statement of parallel loop nest copy
          (stdeb->lastNodeOfStmt())->insertStmtAfter(*new SgGotoStmt(*begin_lab),*ifst);
          TranslateBlock(stdeb);          
       }
  }

  cur_st = stl->lexNext();
      //cur_st = st->lexPrev();  // set cur_st on last DO satement of loop nest
  return(1);  
}

int Reduction_Debug(SgStatement *stmt)
{
  int  mred;
  SgExpression  *e, *el;
  SgStatement *stg,*st3;
  redgref = NULL; irg = 0; idebrg = 0; mred =0;
  LINE_NUMBER_BEFORE(stmt,stmt);
  cur_st = stmt->lexPrev();
  // looking through the specification list
  for(el=stmt->expr(1); el; el=el->rhs()) {
     e = el->lhs();            // specification
     if (e->variant() == REDUCTION_OP) {       
                if(mred !=0) break;
                mred = 1;
                red_list = e->lhs();         
                if(  e->symbol()){
		  redgref = new SgVarRefExp(e->symbol());
                  doIfForReduction(redgref,1);
                  nloopred++;
                  stg = doIfForCreateReduction( e->symbol(),nloopred,1);
                  st3 = cur_st;
                  cur_st = stg;
                 //looking through the reduction list
                  ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); 
                  cur_st = st3;
                } else {
                  irg = ndvm; 
                  redgref = DVM000(irg);
                  doAssignStmtAfter(CreateReductionGroup());
                  idebrg = ndvm; 
                  doAssignStmtAfter( D_CreateDebRedGroup());
                  //looking through the reduction list
                  ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); 
                }                                                      
        
     }
  }    
 return(0);   
}
