SUBROUTINE SET_VAR(MGS,ML,NG,NL,NREG,NCHN,TFRAC,QFRAC,PAPR,TAPR,
     &QAPR,VAPRT,VAPR)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  SOFTWARE WRITTEN BY Benjamin T. Marshall.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C      (c) Copyright 1987-1995 by GATS, Inc.
C          28 Research Drive, Hampton, Virginia, 23666
C          Phone: (804) 865-7491
C
C  All Rights Reserved. No part of this software or publication may be
C  reproduced, stored in a retrieval system, or transmitted, in any form
C  or by any means, electronic, mechanical, photocopying, recording, or
C  otherwise without the prior written permission of GATS, Inc.
C
C RCS HISTORY
C
C$Log: set_var.f,v $
CRevision 1.1  2007/12/19 18:19:13  deaver
CInitial revision
C
c Revision 1.1  1996/08/05  18:48:16  thompson
c Initial revision
c
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DIMENSION QFRAC(MGS),PAPR(ML),TAPR(ML),QAPR(ML,MGS),VAPRT(ML,ML),
     &VAPR(ML,ML,MGS)
      DO IL=1,NL
        DO ILL=1,NL
          VAPRT(IL,ILL)=0.0
          DO IG=1,NG
            VAPR(IL,ILL,IG)=0.0
          ENDDO
        ENDDO
        VAPRT(IL,IL)=(TFRAC*TAPR(IL))**2
c      print*, 'vaprt', vaprt(il,il), tfrac, tapr(il)
        DO IG=1,NG
          VAPR(IL,IL,IG)=(QFRAC(IG)*QAPR(IL,IG))**2
c          write(*,*), ig,il,vapr(il,il,ig),qfrac(ig), qapr(il,ig) 
        ENDDO
      ENDDO
      RETURN
      END