c

C file-name               GXUTIL.HTM             050405
c
      SUBROUTINE GXRDQ1
C     SUBROUTINE GXRDQ1 is activated by setting READQ1=T in the Q1 file.
C     Data to be read must be placed between an upper line consisting of
C     word READQ1_BEGIN and a lower line consisting of the word
C     READQ1_END, starting in column numbered 3 or higher.
C
      INCLUDE '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/satgrd'
      COMMON/LGRND/LG(100)/IGRND/IG(200)/RGRND/RG(200)/CGRND/CG(100)
      LOGICAL LG
      COMMON/LBFC/STORSA(6),STORWD(6),LBFCSP
      LOGICAL STORSA,STORWD,LBFCSP
      COMMON/LUNITS/LUNIT(60)
C
      LOGICAL WORDIS,RDWERR
      COMMON/WORDC1/WD(20),INLINE
      COMMON /NAMFN/NAMFUN,NAMSUB
      common/linsav/linesav
      CHARACTER*6 NAMFUN,NAMSUB
 
      CHARACTER WD*20,INLINE*120,LINESAV*68
C
      NAMSUB = 'GXRDQ1'
      CALL OPENQ1('READQ1_BEGIN',IERR)
      IF(IERR.EQ.0) THEN
        CALL WRYT40('Q1 opened for reading of data           ')
        CALL WRITBL
        CALL WRIT40('>>> Data read in from the Q1 file    <<<')
        CALL WRITBL
    4   CALL RDLNQ1('READQ1_END',IERR)
        IF(IERR.EQ.0) THEN
          WRITE(LUNIT(14),*) LINESAV
          CALL PUT_LINE(linesav,.TRUE.)
C.... Integers
          IF(WORDIS(1,'LSWEEP')) LSWEEP=IRDZZZ(2)
          IF(WORDIS(1,'LSTEP'))  LSTEP=IRDZZZ(2)
          IF(WORDIS(1,'ISOLX'))  ISOLX=IRDZZZ(2)
          IF(WORDIS(1,'ISOLY'))  ISOLY=IRDZZZ(2)
          IF(WORDIS(1,'ISOLZ'))  ISOLZ=IRDZZZ(2)
          IF(WORDIS(1,'ISOLBK')) ISOLBK=IRDZZZ(2)
          IF(WORDIS(1,'LITER'))  LITER(IRDZZZ(2))=IRDZZZ(3)
          IF(WORDIS(1,'ITERMS')) ITERMS(IRDZZZ(2))=IRDZZZ(3)
          IF(WORDIS(1,'ISLN'))   ISLN(IRDZZZ(2))=IRDZZZ(3)
          IF(WORDIS(1,'IPRN'))   IPRN(IRDZZZ(2))=IRDZZZ(3)
          IF(WORDIS(1,'IDAT'))   IDAT(IRDZZZ(2))=IRDZZZ(3)
          IF(WORDIS(1,'IG'))     IG(IRDZZZ(2))=IRDZZZ(3)
          IF(WORDIS(1,'IDEB'))   IDEB(IRDZZZ(2))=IRDZZZ(3)
C.... Reals
          IF(WORDIS(1,'CMU'))    CMU=RRDZZZ(2)
          IF(WORDIS(1,'CD'))     CD =RRDZZZ(2)
          IF(WORDIS(1,'C1E'))    C1E=RRDZZZ(2)
          IF(WORDIS(1,'C2E'))    C2E=RRDZZZ(2)
          IF(WORDIS(1,'AK'))     AK= RRDZZZ(2)
          IF(WORDIS(1,'EWAL'))   EWAL=RRDZZZ(2)
          IF(WORDIS(1,'RHO1'))   RHO1=RRDZZZ(2)
          IF(WORDIS(1,'RHO2'))   RHO2=RRDZZZ(2)
          IF(WORDIS(1,'ENUL'))   ENUL=RRDZZZ(2)
          IF(WORDIS(1,'ENUT'))   ENUT=RRDZZZ(2)
          IF(WORDIS(1,'CFIPS'))  CFIPS=RRDZZZ(2)
          IF(WORDIS(1,'CMDOT'))  CMDOT=RRDZZZ(2)
          IF(WORDIS(1,'DTFALS')) DTFALS(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'PRNDTL')) PRNDTL(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'PRT'))    PRT(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'ENDIT'))  ENDIT(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'FIINIT')) FIINIT(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'PHINT'))  PHINT(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'CINT'))   CINT(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'VARMIN')) VARMIN(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'VARMAX')) VARMAX(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'RESREF')) RESREF(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'RDAT'))   RDAT(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'RDEB'))   RDEB(IRDZZZ(2))=RRDZZZ(3)
          IF(WORDIS(1,'RG'))     RG(IRDZZZ(2))=RRDZZZ(3)
C.... Logicals
          IF(WORDIS(1,'STEADY')) STEADY=WORDIS(2,'T')
          IF(WORDIS(1,'CARTES')) CARTES=WORDIS(2,'T')
          IF(WORDIS(1,'NONORT')) NONORT=WORDIS(2,'T')
          IF(WORDIS(1,'DEBUG'))  DEBUG=WORDIS(2,'T')
          IF(WORDIS(1,'FLAG'))   FLAG=WORDIS(2,'T')
          IF(WORDIS(1,'DBGPHI')) DBGPHI(IRDZZZ(2))=WORDIS(3,'T')
          IF(WORDIS(1,'LDAT'))   LDAT(IRDZZZ(2))=WORDIS(3,'T')
          IF(WORDIS(1,'LDEB'))   LDEB(IRDZZZ(2))=WORDIS(3,'T')
          if(WORDIS(1,'LG'))     LG(IRDZZZ(2))=WORDIS(3,'T')
          if(WORDIS(1,'STORSA')) STORSA(IRDZZZ(2))=WORDIS(3,'T')
          if(WORDIS(1,'STORWD')) STORWD(IRDZZZ(2))=WORDIS(3,'T')
C.... Characters
          IF(WORDIS(1,'NAME(U2)')) NAME(U2)=WD(2)
          IF(WORDIS(1,'NAME'))   NAME(IRDZZZ(2))=WD(3)
          IF(WORDIS(1,'CG'))     NAME(IRDZZZ(2))=WD(3)
          IF(RDWERR())
     1       CALL WRYT40('!!! GREX3 failed to read data from Q1 !!')
          GO TO 4
        ENDIF
      ENDIF
      IF(.NOT.NULLPR) THEN
        CALL WRITBL
        CALL WRIT40('>>> End of data read in from Q1      <<<')
        CALL WRITST
        CALL WRITBL
        NAMSUB = 'gxrdq1'
      ENDIF
      END
c
      SUBROUTINE GXCOSA(L0VAL,L0XH,L0XV,GH0,GV0,NY)
      INCLUDE '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/grdear'
      COMMON /NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
C... compute cos(alfa) and store in VAL
      LOGICAL LVRCEL
      NAMSUB='GXCOSA'
      IPV=0
      DO IX=IXF,IXL
        IADD=NY*(IX-1)
        DO IY=IYF,IYL
          IPV=IPV+1
          I=IY+IADD
          IF(LVRCEL(IPV)) THEN
            GDV = F(L0XV+I)-GV0
            GDH = F(L0XH+I)-GH0
            GCOSA=GDH/SQRT(GDV*GDV+GDH*GDH+1.E-10)
            F(L0VAL+I)=GCOSA
          ELSE
            F(L0VAL+I)=0.
          ENDIF
        ENDDO
      ENDDO
      NAMSUB='gxcosa'
      END
c
      SUBROUTINE GXSINA(L0VAL,L0XH,L0XV,GH0,GV0,NY)
      INCLUDE '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/grdear'
      COMMON /NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
C... compute cos(alfa) and store in VAL
      LOGICAL LVRCEL
      NAMSUB='GXSINA'
      IPV=0
      DO 1 IX=IXF,IXL
        IADD=NY*(IX-1)
      DO 1 IY=IYF,IYL
        IPV=IPV+1
        I=IY+IADD
        IF(LVRCEL(IPV)) THEN
          GDV = F(L0XV+I)-GV0
          GDH = F(L0XH+I)-GH0
          GSINA=GDV/SQRT(GDV*GDV+GDH*GDH+1.E-10)
          F(L0VAL+I)=GSINA
        ELSE
          F(L0VAL+I)=0.
        ENDIF
1     CONTINUE
      NAMSUB='gxsina'
      END
c
      SUBROUTINE GXIPOL
      INCLUDE '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/satgrd'
      INCLUDE '/phoenics/d_includ/grdear'
      COMMON/IDATA/NX,NY,IFL2(118)
      COMMON/RDA8/FIINIT(150)
      COMMON/NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
C
      NAMSUB = 'GXIPOL'
c.... u's are set to fiinit(v)*sin(xu+fiinit(u)+pi/2)
c.... v's are set to fiinit(v)*cos(xg+fiinit(u))
      L0VAL=L0F(VAL)
      IF(INDVAR.EQ.U1 .OR. INDVAR.EQ.U2) THEN
        L0X=L0F(XU2D)
        ANGADD=FIINIT(INDVAR) + 3.14159*0.5
        FACTOR=FIINIT(INDVAR+2)
      ELSEIF(INDVAR.EQ.V1. OR. INDVAR.EQ.V2) THEN
        L0X=L0F(XG2D)
        ANGADD=FIINIT(INDVAR-2)
        FACTOR=FIINIT(INDVAR)
      ENDIF
      DO 10 I=1,NX*NY
        F(L0VAL+I)=FACTOR * COS(ANGADD+F(L0X+I))
   10 CONTINUE
      NAMSUB = 'gxipol'
      END
c