c
C file-name GXUTIL.HTM 190614
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 'farray'
INCLUDE 'satear'
INCLUDE 'grdloc'
INCLUDE 'satgrd'
PARAMETER ( NLG =100, NIG =200, NRG =200, NCG =100 )
COMMON/LGRND/LG(NLG)/IGRND/IG(NIG)/RGRND/RG(NRG)/CGRND/CG(NCG)
LOGICAL LG
CHARACTER*4 CG
PARAMETER ( NLSG=100, NISG=100, NRSG=150, NCSG=10 )
INTEGER ISGD(NIG)
REAL RSGD(NRG)
LOGICAL LSGD(NLG)
CHARACTER*4 CSGD(NCG)
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
EQUIVALENCE (ISGD(1),ISG1), (RSGD(1),RSG1), (LSGD(1),LSG1),
1 (CSGD(1),CSG1)
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,'ISG')) ISGD(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)
IF(WORDIS(1,'RSG')) RSGD(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,'LSG')) LSGD(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')) CG(IRDZZZ(2))=WD(3)
IF(WORDIS(1,'CSG')) CSGD(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 'farray'
INCLUDE '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 'farray'
INCLUDE '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 'farray'
INCLUDE 'grdloc'
INCLUDE 'satgrd'
INCLUDE '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