/************************************************************************
Name: flecs90_work.c
DESCRITPTION: Does processing of each line of the flecs source code
FUNCITONS: process_standard - processes a line of the flecs source
                              code while in the standard state
DATE: August 3, 1994
*************************************************************************/
/* INCLUDE FILES */
#include "flecs90.h"

void process_standard(int cur_col)

{

  /* External Variables */
  extern int qfortran;      /* if true a fortran output file is
                               produced */
  extern int qlabel;        /* if false flecs loops will not be labeled */
  extern int qselect;       /* if true SELECT (ref_spec) and CASE (ref_spec)
			       are translated to fortran 90 CASE
			       SELECT statements */
  extern FILE *fortran;     /* file pointer to fortran output file */
  extern int line_num;      /* current line number in flecs source file */
  extern char *line;        /* current line from flecs source file */
  extern int line_len;      /* length of the current line */
  extern enum state_type state; 
                            /* state of code being processed */
  extern enum key_type key; /* current flecs key word */
  extern struct key_stacks *fin_stack;
                            /* stack of flecs commands which are not
			       finished yet */
  extern struct key_stacks *cycle_stack;
                            /* stack of command which can have CYCLE
			       or EXIT called */
  extern struct line_stacks *repeat_stack;
                            /* stack of instances associated with
			       REPEAT WHILE or REPEAT UNTIL statememnt */
  extern struct line_stacks *select_stack;
                            /* stack of ref_spec associated with
			       SELECT or CASE statement */
  extern int qto;           /* TRUE if flecs in-line procedures have
			       started */
  extern int nifthen;       /* current number of active fortran IF-THEN
			       statements */
  extern int nloop;         /* Number of flecs loops encountered */
  extern char *error_msg;   /* error message string */
  extern char *flecs_proc;  /* name of in-line flecs procedure calls */
  extern char *scratch;     /* length 80 string for temporary use */
  extern char *keyword[NKEYS+1];
                            /* Vector of Flecs Keywords as Characters */
  /* Local Variables */
  int i;              /* Loop control variable */
  int len;            /* length of flecs procedure name */
  int start_in;       /* beginning line number of flecs command */
  char *flecs_in;     /* current flecs command */
  int flecs_loc;      /* current location in flecs command */
  int flecs_len=0;    /* length of current flecs command */
  int fort_loc;       /* current location in fortran command */
  int open_paren;     /* beginnig of an instance */
  int close_paren;    /* end of an instance */
  int qinstance;      /* TRUE if there is an instance */
  int qotherwise;     /* TRUE if there is an OTHERWISE instance */
  int qword2;         /* TRUE if there is another word in the flecs command */
  int qcall;          /* TRUE if the current word is a flecs procedure
			 call */
  int word2_start;    /* Beginning of second word in command */
  int word2_end;      /* Ending of second word in command */
  enum key_type key2; /* Key for second word in command */
  int condif=0;       /* TRUE if this is the first instance of a
			 CONDITIONAL statement */
  int itemp;          /* temporary integer variable */

  /* BEGIN CODE */
  /* Process line based on keyword */
  switch (key) {

  /*********************************************/
  /* NONE: Encountered a fortran line; echo it */
  /*********************************************/
  case NONE:
    while(1) {
      if (qfortran) {
	for (i=1; i <= line_len; i++) fputc(line[i],fortran);
	print_line_number(line_len,line_num);
      }
      if (!(getline() && qcontinue(line))) break;
    }
    break;

  /*********************************************************/
  /* Process SELECT and CASE_SELECT statements :           */
  /* (when qselect option is TRUE)                         */
  /*                             SELECT (ref_spec)         */
  /*                             CASE (ref_spec)           */
  /*********************************************************/
  case SELECT: case CASE_SELECT:
    if (qselect) {

      /* Get the entire flecs command */
      flecs_in = add_to_command(flecs_in,line,1,line_len,&flecs_len);
      start_in = line_num;
      while (getline() && qcontinue(line))
	flecs_in = add_to_command(flecs_in,line,7,line_len,&flecs_len);
      
      
      /* Set the current location in the command to be
	 after the key word */
      flecs_loc = cur_col+1;
      
      /* Find the ref_spec */
      
      qinstance = getinstance(flecs_in,flecs_len,flecs_loc,&open_paren,
			      &close_paren);
      if (qinstance == 0) {
	flecs_error(0,"Missing control specification.",start_in);
	return;
      } else if (qinstance == 2) {
	flecs_error(0,"Unbalanced paranethesis.",start_in);
	return;
      }
      
      /* print the CASE SELECT (ref_spec) statement */
      if (qfortran) {
	echo_label(flecs_in);
	fort_loc = 6;
	fortran_put("SELECT CASE ",0,11,&fort_loc,start_in);
	fortran_put(flecs_in,open_paren,close_paren,&fort_loc,start_in);
	print_line_number(fort_loc,start_in);
      }
      fin_stack = push_key(fin_stack,key,start_in);
      break;
    }

  /***************************************************************/
  /* Process CONDITIONAL and CASE_CONDITONAL and                 */
  /*         SELECT      and CASE_SELECT statements :            */
  /*         (SELECT and CASE_SELECT only if qselect is FALSE)   */
  /*                                   CONDITIONAL               */
  /*                                   CASE                      */
  /*                                   SELECT (ref_spec)         */
  /*                                   CASE (ref_spec)           */
  /***************************************************************/
  case CONDITIONAL: case CASE_CONDITIONAL:

    /* Get the entire flecs command */
    flecs_in = add_to_command(flecs_in,line,1,line_len,&flecs_len);
    start_in = line_num;
    while (getline() && qcontinue(line))
      flecs_in = add_to_command(flecs_in,line,7,line_len,&flecs_len);

    
    /* Set the current location in the command to be
       after the key word */
    flecs_loc = cur_col+1;

    /* If statement is a SELECT or CASE_SELECT statement find
       the ref_spec and put it on the select_stack */
    if ((key == SELECT) || (key == CASE_SELECT)) {
      
      qinstance = getinstance(flecs_in,flecs_len,flecs_loc,&open_paren,
			      &close_paren);
      if (qinstance == 0) {
	flecs_error(0,"Missing control specification.",start_in);
	return;
      } else if (qinstance == 2) {
	flecs_error(0,"Unbalanced paranethesis.",start_in);
	return;
      }
      select_stack = push_line(select_stack,flecs_in,open_paren,close_paren);
    }
    
    /* If there is a label print it to the fortran file with
       a CONTINUE statement */
    if (qfortran) echo_label_continue(line,line_num);
    
    /* Get the next line and its key */
    key2 = getkey(line,line_len,&itemp);
    
    /* If the next key if FIN statement we are done */
    if (key2 == FIN) {
      if ((key == SELECT) || (key == CASE_SELECT)) 
	select_stack = pop_line(select_stack);
      break;
    }

    /* If the next key is an INSTANCE (like we expect) pop the CONDITONAL
       key onto the fin stack, then fall through to the INSTANCE case
       and process the instance with condif set to 1 so we use IF
       (condition) rather than ELSE IF (condition) */
    else if (key2 == INSTANCE) {
      fin_stack = push_key(fin_stack,key,line_num);
      key = key2;
      condif = 1;
    }

    /* Otherwise echo an error message. The line will be processed
       on the next loop */
    else {
      if ((key == SELECT) || (key == CASE_SELECT)) 
	select_stack = pop_line(select_stack);
      sprintf(error_msg,"Only INSTANCE or FIN valid. (%s line %d)",
	      keyword[key],line_num-1);
      flecs_error(1,error_msg,line_num);
      break;
    }
    
  /****************************************/
  /* Process INSTANCE statements :        */
  /*                          (<text>)    */
  /****************************************/
  case INSTANCE:
    /* Get the entire flecs command */
    flecs_len = 0;
    flecs_in = add_to_command(flecs_in,line,1,line_len,&flecs_len);
    start_in = line_num;
    while (getline() && qcontinue(line))
      flecs_in = add_to_command(flecs_in,line,7,line_len,&flecs_len);

    /* Identify the location of the instance in flecs_in */
    qinstance = getinstance(flecs_in,flecs_len,7,&open_paren,
			    &close_paren);

    /* If the parenthesis are unbalanced ignore the line. This
       is the same as not finding an instance. */
    if (qinstance == 2) {
      state = BRANCH_FIN;
      flecs_error(0,"Unbalanced parenthesis.",start_in);
      /* If this is the first instance after a CONDITONAL or CASE
	 statement then echo an error that the conditonal wasn't
	 finished */
      if (condif) {
	sprintf(error_msg,"Only INSTANCE or FIN valid. (%s line %d)",
		keyword[fin_stack->key],fin_stack->line_num);
	flecs_error(1,error_msg,line_num);
	fin_stack = pop_key(fin_stack);
	if ((key == SELECT) || (key == CASE_SELECT))
	  select_stack = pop_line(select_stack);
      }
      return;
    }
    
    /* Assign the location in the flecs command and echo the lable */
    flecs_loc = close_paren+1;
    if (qfortran) {
      echo_label(flecs_in);
      fort_loc = 6;
    }
    
    /* An instance must be proceeded by a CONDITIONAL,SELECT or
       CASE statement. If it is not echo an error and print the
       the line as is */
    if ((fin_stack->key != CONDITIONAL) && 
	(fin_stack->key != CASE_CONDITIONAL) &&
	(fin_stack->key != SELECT) && 
	(fin_stack->key != CASE_SELECT)) {
      flecs_error(2,"INSTANCE without CASE/CONDITIONAL/SELECT.",start_in);
      if (qfortran) {
	fortran_put(flecs_in,open_paren,flecs_len,&fort_loc,start_in);
	print_line_number(fort_loc,start_in);
      }
    } else {
      /* Determine if this is an OTHERWISE instance */
      if (getword(flecs_in,close_paren-1,open_paren+1,&word2_start,&word2_end))
	if ((qotherwise = key_match(flecs_in,word2_start,word2_end,
				    "OTHERWISE")))
	  key = OTHERWISE;
      

      /* Determine if there is another word */
      qword2 = getword(flecs_in,flecs_len,flecs_loc,&word2_start,
		       &word2_end);
      
      if (qfortran) {
	
	/* Print fortran line corresponding to instance */
	
	/* If it is an (OTHERWISE) instance:
	   (1st instance) - IF (.TRUE.) THEN
	   (not 1st instance) - ELSE 
	   For qselect TRUE
	   CASE DEFAULT                      */
	if (qotherwise)
	  if (qselect && ((fin_stack->key == SELECT) || 
			  (fin_stack->key == CASE_SELECT)))
	    fortran_put("CASE DEFAULT",0,11,&fort_loc,start_in);
	  else if (condif) 
	    fortran_put("IF (.TRUE.) THEN",0,15,&fort_loc,start_in);
	  else
	    fortran_put("ELSE",0,3,&fort_loc,start_in);
	
	/* If it is not an (OTHERWISE) instance:
	   SELECT (1st instance) IF ((instance).EQ.(ref_spec)) THEN
	   SELECT (not 1st instace) ELSE IF  ((instance).EQ.(ref_spec)) THEN
	   CONDITIONAL (1st instance) - IF (instance) THEN
	   CONDITIONAL (not 1st instance) - ELSE IF (instance) THEN 
	   If qselect is TRUE                 
	   CASE (instance)                                                */
	
	else {
	  if (qselect && ((fin_stack->key == SELECT) || 
			  (fin_stack->key == CASE_SELECT)))
	    fortran_put("CASE",0,3,&fort_loc,start_in);
	  else if (condif)
	    fortran_put("IF ",0,2,&fort_loc,start_in);
	  else
	    fortran_put("ELSE IF ",0,7,&fort_loc,start_in);
	  
	  if ((!qselect) && ((fin_stack->key == SELECT) || 
			     (fin_stack->key == CASE_SELECT)))
	    fortran_put("(",0,0,&fort_loc,start_in);
	  fortran_put(flecs_in,open_paren,close_paren,&fort_loc,start_in);
	  if ((fin_stack->key == SELECT) || (fin_stack->key == CASE_SELECT)) {
	    if (!qselect) {
	      fortran_put(".EQ.",0,3,&fort_loc,start_in);
	      len = length(select_stack->line) - 1;
	      fortran_put(select_stack->line,0,len,&fort_loc,start_in);
	      fortran_put(")",0,0,&fort_loc,start_in);
	      fortran_put(" THEN",0,4,&fort_loc,start_in);
	    }
	  } else fortran_put(" THEN",0,4,&fort_loc,start_in);
	}
	print_line_number(fort_loc,start_in);
      }

      /* Check to see if there is another word after the INSTANCE
	 if so then it is finished */

      if (qword2) {
	if (qotherwise) state = OTHERWISE_FIN;
	else state = BRANCH_FIN;
	if (qfortran) {
	  fprintf(fortran,"      ");
	  fort_loc = 6;
	}
	parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		   fort_loc,start_in);
      }
      /* If there is no word after the INSTANCE it is unfinsihed */
      else {
	state = STANDARD;
	fin_stack = push_key(fin_stack,key,start_in);
      }
    }
    break;
    
  /* Flecs keys which can not be continued; any text following these
     keys is ignored */
  case FIN: case CYCLE: case EXIT: case REVERT: case ENDIF:
  case LOOP: case PROCEDURE_CALL:

    /*****************************************************/
    /* Process flecs in-line procedure call:             */
    /*                         <TEXT>-<TEXT>             */
    /*****************************************************/
    if (key == PROCEDURE_CALL) {
      if (qfortran) {
	echo_label(line);
	fort_loc = 6;
	len = length(flecs_proc)-1;
	fortran_put("CALL ",0,4,&fort_loc,line_num);
	fortran_put(flecs_proc,0,len,&fort_loc,line_num);
	print_line_number(fort_loc,line_num);
      }
    }

    /****************************************/
    /* Process LOOP statements:             */
    /*                       LOOP           */
    /****************************************/
    else if (key == LOOP) {
      nloop++;
      fin_stack = push_key(fin_stack,key,line_num);
      cycle_stack = push_key(cycle_stack,key,nloop);
      if (qfortran) {
	echo_label(line);
	fort_loc = 6;
	sprintf(scratch,"FLECS_LOOP_%d",nloop);
	len = length(scratch) - 1;
	if (qlabel) {
	  fortran_put(scratch,0,len,&fort_loc,line_num);
	  fortran_put(": ",0,1,&fort_loc,line_num);
	}
	fortran_put("DO",0,1,&fort_loc,line_num);
	print_line_number(fort_loc,line_num);
      }
    }

    /****************************************/
    /* Process REVERT statements:           */
    /*                       REVERT         */
    /****************************************/
    else if (key == REVERT) {
      /* If we are instide a TO statement print RETURN to fortran file */
      if (qto) {
	if (qfortran) {
	  echo_label(line);
	  fort_loc = 6;
	  fortran_put("RETURN",0,5,&fort_loc,line_num);
	  print_line_number(fort_loc,line_num);
	}
      }
      /* Otherwise give an error message */
      else {
	flecs_error(0,"Nothing to REVERT",line_num);
      }
    }

    /************************************************/
    /* Process CYCLE and EXIT statements:           */
    /*                               CYCLE          */
    /*                               EXIT           */
    /************************************************/
    else if ((key == CYCLE) || (key == EXIT)) {
      /* If there is no looping structure on the stack give an error */
      if (cycle_stack == NULL) {
	sprintf(error_msg,"Nothing to %s",keyword[key]);
	flecs_error(0,error_msg,line_num);
      }
      /* Othewise print CYCLE or EXIT and structure name */
      else {
	if (qfortran) {
	  echo_label(line);
	  fort_loc = 6;
	  if (key == CYCLE)
	    fortran_put("CYCLE",0,4,&fort_loc,line_num);
	  else 
	    fortran_put("EXIT",0,3,&fort_loc,line_num);
	  sprintf(scratch,"FLECS_LOOP_%d",cycle_stack->line_num);
	  len = length(scratch) - 1;
	  if (qlabel) {
	    fortran_put(" ",0,0,&fort_loc,line_num);
	    fortran_put(scratch,0,len,&fort_loc,line_num);
	  }
	  print_line_number(fort_loc,line_num);
	}
      }
    }

    /***************************************/
    /* Process ENDIF statements:           */
    /*                       ENDIF         */
    /***************************************/
    else if (key == ENDIF) {
      /* If there is no active fortran BLOCK-IF statement give an error */
      if (nifthen < 1) {
	flecs_error(0,"No BLOCK-IF for ENDIF to match",line_num);
      } else {
	nifthen--;
	if (qfortran) {
	  echo_label(line);
	  fort_loc = 6;
	  fortran_put("END IF",0,5,&fort_loc,line_num);
	  print_line_number(fort_loc,line_num);
	}
      }
    }

    /*************************************/
    /* Process FIN statements:           */
    /*                       FIN         */
    /*************************************/
    else if (key == FIN) {
      /* IF there is nothing to finish print an ERROR and ignore the line */
      if (fin_stack == NULL) {
	flecs_error(0,"Nothing for FIN to match.",line_num);
      }
      /* Otherwise print the appropriate output to the fortran file */
      else finish();
    }

    /* Ignore continuation lines */
    while (getline() && qcontinue(line)) ;
    break;

  /***************************************************/
  /* Pre-Process FORTRAN ELSE statements :           */
  /***************************************************/
  case ELSE:
    /* if the ELSE statement does not match a flecs WHEN command
       dump the command as is. If it does not match a Fortran
       IF-THEN block echo an error. */
    if (fin_stack->key != WHEN) {
      if (nifthen < 1) {
	flecs_error(2,"No WHEN or BLOCK-IF for ELSE to match.",line_num);
      }
      while(1) {
	if (qfortran) {
	  for (i=1; i <= line_len; i++) fputc(line[i],fortran);
	  print_line_number(line_len,line_num);
	}
	if (!(getline() && qcontinue(line))) break;
      }
      break;
    }

  /* The remaining flecs keys are commands which can be continued */
  default:
    /* Get the entire flecs command */
    flecs_in = add_to_command(flecs_in,line,1,line_len,&flecs_len);
    start_in = line_num;
    while (getline() && qcontinue(line))
      flecs_in = add_to_command(flecs_in,line,7,line_len,&flecs_len);
    
    /* Set the current location in the command to be
       after the key word */
    flecs_loc = cur_col+1;

    /* Process command based on keyword */
    switch (key) {

    /* The following keys require an instance : key (condition) */
    case REPEAT_WHILE: case REPEAT_UNTIL: case DO: case FOR: case WHILE:
    case UNTIL: case IF: case UNLESS: case WHEN:

      qinstance = getinstance(flecs_in,flecs_len,flecs_loc,&open_paren,
			      &close_paren);
      if (qinstance == 0) {
	flecs_error(0,"Missing control specification.",start_in);
	return;
      } else if (qinstance == 2) {
	flecs_error(0,"Unbalanced paranethesis.",start_in);
	return;
      }
      
      /* Determine the current location in the flecs command and
	 echo the lable to the fortran file */
      flecs_loc = close_paren+1;
      if (qfortran) {
	echo_label(flecs_in);
	fort_loc = 6;
      }

      /* Determine if there is another word and if it is a flecs
	 in-line procedure call */
      qword2 = getword(flecs_in,flecs_len,flecs_loc,&word2_start,
			    &word2_end);

      /*****************************************************/
      /* Process IF statements : IF (condition) <command>  */
      /*****************************************************/
      if (key == IF) {
	if (qfortran) {
	  fortran_put("IF ",0,2,&fort_loc,start_in);
	  fortran_put(flecs_in,open_paren,close_paren,&fort_loc,start_in);
	}
	/* Check to see if there is another word after the condition
	   if so then it is a finished IF statement or
	   a Fortran IF-THEN statement */
	if (qword2) {
	  /* If the next word is THEN it is a Fortran IF-THEN statement */
	  if (key_match(flecs_in,word2_start,word2_end,"THEN")) {
	    key = IFTHEN;
	    /* If there is any more text after THEN echo the line as
	       is and issue a warning */
	    if (flecs_len > word2_end) {
	      if (qfortran) {
		fortran_put(" ",0,0,&fort_loc,start_in);
		fortran_put(flecs_in,word2_start,flecs_len,&fort_loc,start_in);
		print_line_number(fort_loc,start_in);
	      }
	    }
	    /* Otherwise print an IF-THEN statement */
	    else {
	      if (qfortran) {
		fortran_put(" THEN",0,4,&fort_loc,start_in);
		print_line_number(fort_loc,start_in);
	      }
	      nifthen++;
	    }
	  }
	  /* If the next work is not THEN we have a finished IF
	     statement */
	  else {
	    if (qfortran) fortran_put(" ",0,0,&fort_loc,start_in);
	    parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		       fort_loc,start_in);
	  }
	}
	/* If there is no word after the condition it is an unfinsihed
	   flecs IF statement */
	else {
	  if (qfortran) {
	    fortran_put(" THEN",0,4,&fort_loc,start_in);
	    print_line_number(fort_loc,start_in);
	  }
	  fin_stack = push_key(fin_stack,key,start_in);
	}
      }

      
      /*************************************************************/
      /* Process UNLESS statements : UNLESS (condition) <command>  */
      /*************************************************************/
      else if (key == UNLESS) {
	if (qfortran) {
	  fortran_put("IF (.NOT.",0,8,&fort_loc,start_in);
	  fortran_put(flecs_in,open_paren,close_paren,&fort_loc,start_in);
	  fortran_put(")",0,0,&fort_loc,start_in);
	}
	/* Check to see if there is another word after the condition
	   if so then it is a finished UNLESS statement */
	if (qword2) {
	  if (qfortran) fortran_put(" ",0,0,&fort_loc,start_in);
	  parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		     fort_loc,start_in);
	}
	/* If there is no word after the condition it is an unfinsihed
	   flecs UNLESS statement */
	else {
	  if (qfortran) {
	    fortran_put(" THEN",0,4,&fort_loc,start_in);
	    print_line_number(fort_loc,start_in);
	  }
	  fin_stack = push_key(fin_stack,key,start_in);
	}
      }
      
      /*********************************************************/
      /* Process WHEN statements : WHEN (condition) <command>  */
      /*********************************************************/
      else if (key == WHEN) {
	if (qfortran) {
	  fortran_put("IF ",0,2,&fort_loc,start_in);
	  fortran_put(flecs_in,open_paren,close_paren,&fort_loc,start_in);
	  fortran_put(" THEN",0,4,&fort_loc,start_in);
	  print_line_number(fort_loc,start_in);
	}
	/* Check to see if there is another word after the condition
	   if so then it is a finished WHEN statement */
	if (qword2) {
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	  }
	  parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		     fort_loc,start_in);
	  fin_stack = push_key(fin_stack,key,start_in);
	  state = WHEN_FIN;
	}
	/* If there is no word after the condition it is an unfinsihed
	   flecs WHEN statement */
	else {
	  fin_stack = push_key(fin_stack,key,start_in);
	}
      }

      /*****************************************************/
      /* Process DO and FOR statements :                   */
      /*                    DO (i=e1,e2 [,e2])) <command>  */
      /*                    FOR (i=e1,e2 [,e2])) <command> */
      /*****************************************************/
      else if ((key == DO) || (key == FOR)) {
	nloop++;
	if (qfortran) {
	  sprintf(scratch,"FLECS_LOOP_%d",nloop);
	  len = length(scratch) - 1;
	  if (qlabel) {
	    fortran_put(scratch,0,len,&fort_loc,start_in);
	    fortran_put(": ",0,1,&fort_loc,start_in);
	  }
	  fortran_put("DO ",0,2,&fort_loc,start_in);
	  fortran_put(flecs_in,open_paren+1,close_paren-1,&fort_loc,start_in);
	  print_line_number(fort_loc,start_in);
	}
	/* Check to see if there is another word after the condition
	   if so then it is a finished FOR statement */
	if (qword2) {
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	  }
	  parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		     fort_loc,start_in);
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	    fortran_put("END DO",0,5,&fort_loc,start_in);
	    if (qlabel) {
	      fortran_put(" ",0,0,&fort_loc,start_in);
	      fortran_put(scratch,0,len,&fort_loc,start_in);
	    }
	    print_line_number(fort_loc,start_in);
	  }
	}
	/* If there is no word after the condition it is an unfinsihed
	   flecs FOR statement */
	else {
	  fin_stack = push_key(fin_stack,key,start_in);
	  cycle_stack = push_key(cycle_stack,key,nloop);
	}
      }

      /***********************************************************/
      /* Process WHILE and UNTIL statements :                    */
      /*                             WHILE (condition) <command> */
      /*                             UNTIL (condition) <command> */
      /***********************************************************/
      else if ((key == WHILE) || (key == UNTIL)) {
	nloop++;
	if (qfortran) {
	  sprintf(scratch,"FLECS_LOOP_%d",nloop);
	  len = length(scratch) - 1;
	  if (qlabel) {
	    fortran_put(scratch,0,len,&fort_loc,start_in);
	    fortran_put(": ",0,1,&fort_loc,start_in);
	  }
	  fortran_put("DO WHILE ",0,8,&fort_loc,start_in);
	  if (key == UNTIL) fortran_put("(.NOT.",0,5,&fort_loc,start_in);
	  fortran_put(flecs_in,open_paren,close_paren,&fort_loc,start_in);
	  if (key == UNTIL) fortran_put(")",0,0,&fort_loc,start_in);
	  print_line_number(fort_loc,start_in);
	}
	/* Check to see if there is another word after the condition
	   if so then it is a finished WHILE or UNTIL statement */
	if (qword2) {
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	  }
	  parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		     fort_loc,start_in);
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	    fortran_put("END DO",0,5,&fort_loc,start_in);
	    if (qlabel) {
	      fortran_put(" ",0,0,&fort_loc,start_in);
	      fortran_put(scratch,0,len,&fort_loc,start_in);
	    }
	    print_line_number(fort_loc,start_in);
	  }
	}
	/* If there is no word after the condition it is an unfinsihed
	   flecs WHILE statement */
	else {
	  fin_stack = push_key(fin_stack,key,start_in);
	  cycle_stack = push_key(cycle_stack,key,nloop);
	}
      }

      /***********************************************************/
      /* Process REPEAT WHILE and REPEAT UNTIL statements :      */
      /*                      REPEAT WHILE (condition) <command> */
      /*                      REPEAT UNTIL (condition) <command> */
      /***********************************************************/
      else if ((key == REPEAT_WHILE) || (key == REPEAT_UNTIL)){
	nloop++;
	if (qfortran) {
	  sprintf(scratch,"FLECS_LOOP_%d",nloop);
	  len = length(scratch) - 1;
	  if (qlabel) {
	    fortran_put(scratch,0,len,&fort_loc,start_in);
	    fortran_put(": ",0,1,&fort_loc,start_in);
	  }
	  fortran_put("DO",0,1,&fort_loc,start_in);
	  print_line_number(fort_loc,start_in);
	}
	/* Check to see if there is another word after the condition
	   if so then it is a finished REPEAT WHILE or 
	   REPEAT UNTIL statement */
	if (qword2) {
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	  }
	  parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		     fort_loc,start_in);
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	    fortran_put("IF ",0,2,&fort_loc,start_in);
	    if (key == REPEAT_WHILE)
	      fortran_put("(.NOT.",0,5,&fort_loc,start_in);
	    fortran_put(flecs_in,open_paren,close_paren,&fort_loc,start_in);
	    if (key == REPEAT_WHILE)
	      fortran_put(")",0,0,&fort_loc,start_in);
	    fortran_put(" EXIT",0,4,&fort_loc,start_in);
	    if (qlabel) {
	      fortran_put(" ",0,0,&fort_loc,start_in);
	      fortran_put(scratch,0,len,&fort_loc,start_in);
	    }
	    print_line_number(fort_loc,start_in);
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	    fortran_put("END DO",0,5,&fort_loc,start_in);
	    if (qlabel) {
	      fortran_put(" ",0,0,&fort_loc,start_in);
	      fortran_put(scratch,0,len,&fort_loc,start_in);
	    }
	    print_line_number(fort_loc,start_in);
	  }
	}
	/* If there is no word after the condition it is an unfinsihed
	   flecs REPEAT WHILE or REPEAT UNTIL statement */
	else {
	  repeat_stack = push_line(repeat_stack,flecs_in,
				   open_paren,close_paren);
	  fin_stack = push_key(fin_stack,key,start_in);
	  cycle_stack = push_key(cycle_stack,key,nloop);
	}
      }
      break;

    /* The remaining cases are continuable flecs command which
       do not require an instance */

    /*************************************************/
    /* Process flecs ELSE statements :               */
    /*                    WHEN ...                   */
    /*                    ELSE <command>             */
    /*************************************************/
    case ELSE:

      /* Determine if there is another word and if it is a flecs
	 in-line procedure call */
      if ((qword2 = getword(flecs_in,flecs_len,flecs_loc,&word2_start,
			    &word2_end)))
	qcall = ((qproc(flecs_in,word2_start,word2_end)) && 
		 (word2_end >= flecs_len));
      
      /* Remove the WHEN statement from the fin stack */
      fin_stack = pop_key(fin_stack);
      if (qfortran) {
        echo_label(flecs_in);
        fort_loc = 6;
        fortran_put("ELSE",0,3,&fort_loc,start_in);
        print_line_number(fort_loc,start_in);
      }
      /* Check to see if there is another word after the condition
         if so then it is a finished ELSE statement */
      if (qword2) {
        if (qfortran) {
          fprintf(fortran,"      ");
          fort_loc = 6;
	}
	parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		   fort_loc,start_in);
	if (qfortran) {
          fprintf(fortran,"      ");
          fort_loc = 6;
          fortran_put("END IF",0,5,&fort_loc,start_in);
          print_line_number(fort_loc,start_in);
        }
      }
      /* If there is no word after the condition it is an unfinsihed
         flecs ELSE statement */
      else {
        fin_stack = push_key(fin_stack,key,start_in);
      }
      break;

    /*****************************************************/
    /* Process flecs in-line procedure:                  */
    /*                         CALL <TEXT>-<TEXT>        */
    /*****************************************************/
    case TO:

      /* Determine if there is another word and if it is a flecs
	 in-line procedure call */
      if ((qword2 = getword(flecs_in,flecs_len,flecs_loc,&word2_start,
			    &word2_end)))
	qcall = qproc(flecs_in,word2_start,word2_end);
      
      /* If there is no word the flecs procedure name is missing */
      if (!qword2) {
	flecs_error(0,"Missing flecs procedure name.",start_in);
	if (qto) state = TO_FIN;
      }
      /* If the next word is not a valid procedure name print an error */
      else if (!qcall) {
	flecs_error(0,"Invalid flecs procedure name.",start_in);
      }
      /* Otherwise we have a TO statement */
      else {
	len = length(flecs_proc) - 1;
	/* if This is the first TO encountered print the CONTAINS statement
	   to the fortran file */
	if (!qto) {
	  qto = 1;
	  if (qfortran) {
	    fprintf(fortran,"      CONTAINS");
	    fort_loc = 14;
	    print_line_number(fort_loc,start_in);
	  }
	}
	/* Print SUBROUTINE procedure_name to the fortran file */
	if (qfortran) {
	  echo_label(line);
	  fort_loc = 6;
	  fortran_put("SUBROUTINE ",0,10,&fort_loc,start_in);
	  fortran_put(flecs_proc,0,len,&fort_loc,start_in);
	  print_line_number(fort_loc,start_in);
	}

	/* Check to see if there is another word after the
	   procedure name. If so this is a completed procedure call */
	flecs_loc = word2_end + 1;
	if ((qword2 = getword(flecs_in,flecs_len,flecs_loc,&word2_start,
			      &word2_end)))
	  qcall = ((qproc(flecs_in,word2_start,word2_end)) && 
		   (word2_end >= flecs_len));
	
	if (qword2) {
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	  }
	  parse_cont(flecs_in,flecs_len,word2_start,word2_end,
		     fort_loc,start_in);
	  if (qfortran) {
	    fprintf(fortran,"      ");
	    fort_loc = 6;
	    fortran_put("END SUBROUTINE",0,13,&fort_loc,start_in);
	    print_line_number(fort_loc,start_in);
	  }
	  state = TO_FIN;
	}
	/* If there is no word after the proceduer name it is an
	   unfinished flecs procedure */
	else {
	  fin_stack = push_key(fin_stack,key,start_in);
	}
      }
      break;
    }
    break;
  }
}