c

C FILE NAME SATLIT.FOR -------------------------------------- 221209
contains the following:
C      SUBROUTINE SAT_MAIN0(NFDIM1)
C      SUBROUTINE SAT
C      SUBROUTINE SATLIT
C      SUBROUTINE USERST
C      SUBROUTINE INQ1JB(MKEY)
C      SUBROUTINE WRQ1JB(MKEY)
C      SUBROUTINE FTNJB(MKEY,IFTN)
C      SUBROUTINE SPPMJB(IGO)
C      SUBROUTINE STKJB(IFUN,IPOSTN,IVALUE,CVALUE)
C      SUBROUTINE ARRJB(IFUN,I1,I2,I3,R1,C1,L1)
C      SUBROUTINE GEOSTK(IFUN,I1,IPOIN,IARR,NIARR,RARR,NRARR,
C      SUBROUTINE REDRAW_ALL
C      SUBROUTINE DXFJB(INFILE,OUTFILE,XSIZ,YSIZ,ZSIZ,XPOS,YPOS,ZPOS,
C
C   (C) COPYRIGHT 2011
C   CONCENTRATION HEAT AND MOMENTUM LTD. ALL RIGHTS RESERVED.
C   This subroutine and the remainder of the PHOENICS code are
C   proprietary software owned by Concentration Heat and Momentum
C   Limited, 40 High Street, Wimbledon, London SW19 5AU, England.
C-----------------------------------------------------------------------
      SUBROUTINE SAT_MAIN0(NFDIM1,IGO)
      INCLUDE '/phoenics/d_includ/stack'
      INCLUDE '/phoenics/d_includ/vrvvars'
      INCLUDE '/phoenics/d_includ/clpcmn'
      INCLUDE '/phoenics/d_includ/parcmn'
      INCLUDE '/phoenics/d_includ/plncmn'
      INCLUDE '/phoenics/d_includ/vrvmof'
      INCLUDE '/phoenics/d_includ/gcvlnk'
      INCLUDE '/phoenics/d_includ/pltcfile'
C
C 3   Set dimension of run array to MAXRUN.
      PARAMETER (MAXRUN=500)
C
C 4   Set dimensions of data-for-GROUND arrays here. WARNING: the
C     corresponding arrays in the MAIN program of EARTH (see
C     GROUND) must have the same dimensions.
      PARAMETER (NLG=100, NIG=200, NRG=200, NCG=100)
C
C 5   Set dimensions of data-for-GREX3 arrays here. WARNING: the
C     corresponding arrays in the MAIN program of EARTH (see
C     GROUND) must have the same dimensions.
      PARAMETER(NLSG=100, NISG=100, NRSG=150,NCSG=10)
C
C 7   For more than 150 variables, increase following dimensions.
C     WARNING: the corresponding arrays in the MAIN program of
C     EARTH (see GROUND) must be given the same dimensions.
      PARAMETER (NUMPHI=150,                    NM=NUMPHI)
C
C 8   Set dimension of menu saving array here:
      PARAMETER (NMSM=100)
C
C 9   Set grid generation dimensions here:
C          NREM    maximum number of regions in each direction
      PARAMETER (NREM=5000)
C
C 10       NHPL    maximum number of polygons
C       This is not used for OpenGL Editor/Viewer
      PARAMETER (NHPL=20000)
C
C 17  The dimensions of the arrays pertaining to the stack, the
C     graphics stack and user-declared arrays are to be found in
C     separate subroutines at the bottom of this file.
C
C-----------------------------------------------------------------------
C
      LOGICAL TALK,RUN,LVAL
      COMMON /DVMOD/IDVCGR
      COMMON/RUNS/RUN(MAXRUN)
      COMMON/LGRND/LG(NLG)/IGRND/IG(NIG)/RGRND/RG(NRG)/CGRND/CG(NCG)
      LOGICAL LG
      CHARACTER*4 CG
      COMMON/LSG/LSGD(NLSG)/ISG/ISGD(NISG)/RSG/RSGD(NRSG)/CSG/CSGD(NCSG)
      LOGICAL LSGD
      CHARACTER*4 CSGD
      COMMON/LDB1/DBGPHI(NM)/IDA1/ITERMS(NM)/IDA2/LITER(NM)
     1 /IDA3/I0PHCV(NM)/IDA4/I0PHCL(NM)/IDA5/ISLN(NM)/IDA6/IPRN(NM)
     1 /HDA1/NAME(NM)/RDA1/DTFALS(NM)/RDA2/RESREF(NM)
     1 /RDA3/PRNDTL(NM)/RDA4/PRT(NM)/RDA5/ENDIT(NM)/RDA6/VARMIN(NM)
     1 /RDA7/VARMAX(NM)/RDA8/FIINIT(NM)/RDA9/PHINT(NM)
     1 /RDA10/CINT(NM)/RDA11/EX(NM)/RDA12/RMXINC(NM)
     1 /IPIP1/IP1(NM)/HPIP2/IHP2(NM)/RPIP1/RVAL(NM)
     1 /LPIP1/LVAL(NM)
      LOGICAL DBGPHI
      CHARACTER IHP2*4,NAME*4
      COMMON /MNTEST/ ISTMN,ISTMS
      COMMON/GRDGEN/NPNTMX,NLINMX,NARCMX,NCRVMX,NFRMMX,NCPMAX,
     1              NPCVMX,NPFMMX,NCELMX,NREGMX,NOBJMX
      COMMON /CRTLOG/ REGSET(4*NREM)
      LOGICAL REGSET
      COMMON /PWGO/ PWRGEO(4*NREM)
      LOGICAL PWRGEO
      COMMON /HPOLI/NPOL,IFST,NPOMAX/HPOLI1/IPTRR(NHPL)
      COMMON /HPOLI2/IPBR(NHPL)/HPOLI3/ICPL(NHPL)/HPOLJ3/ICOT(NHPL)
      COMMON /HPOLI4/IHOBJ(NHPL)/HPOLI5/IFOBJ(3*NHPL)
      COMMON /HPOLR/XYPOL(8,NHPL)/HPOLR1/ZPOL(NHPL)
      COMMON /HBOXR1/XA(2,NHPL)/HBOXR2/YA(2,NHPL)/HBOXR3/ZA(2,NHPL)
      COMMON /HBOXII/NFATOT/HBOXR6/XFA(4,3*NHPL)/HBOXR7/YFA(4,3*NHPL)
      COMMON /VPOLI1/IPTR2(NHPL)/VPOLI2/IPBR2(NHPL)
C
      CHARACTER*96 MENSVA(NMSM)
      COMMON /MENSVD/ MENSVA
      COMMON /MENSVI/ NMNSAV
      COMMON /SPEDAI/NSPMAX,NSPEDA
C... Streamline commons
      COMMON /VDOST1/MAXSTRM,NUMSTREAM,ISTRM,ISTRD,ISTRC,NSTRSEG
      COMMON /LVDEC/ LV32,LVDE
      LOGICAL LV32,LVDE,LJAVA
      logical dbsat
      common /dbs/dbsat
      COMMON /SATOK/ SATNOTOK
      LOGICAL SATNOTOK
      COMMON /STACKSIZ/ MXSTACK
      COMMON/LINCNT/KOUNQ1,KOUNQ2,KOUNTI,KOUNTR,KOUNTL,KOUNTC,
     1KERROR,KSTACK,KBLK,KOUN14,KOUN14R,KOUN14I,KOUN14L
      CHARACTER*132 BUFF
      SAVE MXTCV,MXFRC,MXBFC,NFDIM2
C-----------------------------------------------------------------------
      call showit('start of sat_main0')
      IF(IGO.NE.2.AND.IGO.NE.4) THEN
C... Default dimensions MAXTCV=100000, MAXFRC=10000, MAXSTK= 1000
        MXTCV =100000; MXFRC =10000
        MXSTACK = 0; MAXSTK0=1000
C... Now read user-values from CHAM.INI
        CALL GETINI(2,'[SATELLITE]','MAXTCV',RDUM,MXTCV,.FALSE.,' ')
        CALL GETINI(2,'[SATELLITE]','MAXFRC',RDUM,MXFRC,.FALSE.,' ')
        CALL GETINI(2,'[SATELLITE]','MAXSTK',RDUM,MAXSTK0,.FALSE.,' ')
        CALL GETINI(2,'[F-array]','Satellite',RDUM,NFDIM2,.FALSE.,' ')
C
        NFDIM2=MAX(NFDIM2,MXTCV+MXFRC+1)
C        
        NFDIM3=ITWO(NFDIM2,NFDIM1,NFDIM1.EQ.0)
C... Allocate F array according to CHAM.INI
        CALL GETMEM(NFDIM3,NFDIM2,1)
C... Allocate NAMPAT array, default dimension 5000
        NPNAM=5000
        CALL GETINI(2,'[SATELLITE]','NPNAM',RDUM,NPNAM,.FALSE.,' ')
        CALL PATCMN_MEM(1,NPNAM,NPNAM1)
C... Allocate initial PIL variable arrays:
C... PIL Integers, Reals, Logicals, Characters, Character length
        NIPIL1=200; NRPIL1=300; NLPIL1=200; NCPIL1=400; NCPILL1=40
        CALL PILVARS_MEM(1,NIPIL1,NRPIL1,NLPIL1,NCPIL1,NCPILL1,
     1                     NIPIL,NRPIL,NLPIL,NCPIL,NCPILL)        
C        
C... Set MXBFC to use up remaining memory after patch/coval and grid
        MXBFC=ITWO(NFDIM1,NFDIM2,NFDIM1.NE.0)-MXTCV-MXFRC
        MXBFC=MAX(MXBFC,0)
        NSPMAX=0; NOBJMX=0; MXCLP=0; MPARSOL=0
        NPNTMX=0; NLINMX=0; NARCMX=0
        NCRVMX=0; NFRMMX=0; NPCVMX=0
        NPFMMX=0; NCELMX=0; NCPMAX=0
        MAXLINK=0; MXSTACK = 0
      ENDIF
C
      NPOMAX=NHPL; NMNSAV=NMSM; NREGMX=NREM
      MAXSTRM=0; MXPLN=0; NUM_PLINE=0
C
      IF(IGO.NE.2.AND.IGO.NE.4) THEN
        CALL READQ1(TALK,RUN,MAXRUN)
      ENDIF
C
      CALL SMAIN1(TALK,MXTCV,MAXRUN,MXBFC,NM,NLG,NIG,NRG,NCG,
     1  NLSG,NISG,NRSG,NCSG,NIPIL,NRPIL,NLPIL,NCPIL,NCPILL,NPNAM1,MXFRC)
C
C... On exit, deallocate memory, unless exiting VR Editor/Viewer in OpenGL mode
      IF(IGO.NE.1.AND.IGO.NE.3) THEN
        IF(SATNOTOK) THEN ! file exists
          CALL SPEDAT('TESTBAT','FILE',-4,RV,IV,.FALSE.,BUFF,IERR)
          IF(IERR.EQ.0) THEN
            LL=LENGZZ(BUFF)
            WRITE(61,*) 'Filename is: ',BUFF(1:LL)
          ELSE
            WRITE(61,*) 'Filename is not known'
          ENDIF
          CLOSE(61,IOSTAT=IOS) ! close SATNOTOK file
          SATNOTOK=.FALSE.
        ENDIF
        CALL FREEMEM
        CALL CLPMEM(3,0,0,0,0,0,0,0,0,0,0)
        CALL PRSMEM(3,0,0,0,0)
        CALL PATCMN_MEM(3,0,0)
C... release PIL variable arrays and counters       
        CALL PILVARS_MEM(3,0,0,0,0,0,0,0,0,0,0)        
        KOUNQ1=0; KERR0R=0; KOUNTI=0; KOUNTR=0
        KOUN14I=0; KOUN14R=0; KOUNTL=0; KOUNTC=0
        CALL OBJ_ATTR_MEM(3,0,0)
        CALL SPEDAT_MEM(3,0,0)
        CALL BFCARRAY_MEM(3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
        CALL VRVMOF_MEM(3,0,0)
        CALL INFATT_MEM(3,0,0)
C... initialise NREFFS when releasing MOF memory
        NREFFS=0
        CALL STREAM_MEM(3,0,0)
        CALL PLINE_MEM(3,0,0)
        CALL GCVLNK_MEM(3,0,0)
        CALL STACK_MEM(3,0,0)
        MAXLINK=0
C... clear Viewer corner value stores on exit
        IF(ASSOCIATED(VAR)) THEN
          DEALLOCATE(VAR, STAT=IERR)
          NULLIFY(VAR)
        ENDIF
C... deallocate ARRJB arrays
        CALL ARRJB_MEM(5,0)
      ENDIF
      IF(IDVCGR.EQ.0) THEN
        if(dbsat) write(60,*)'calling wayout(0) from satlit'
        CALL WAYOUT(0)
      ENDIF
      END
C************************************************************
      SUBROUTINE SAT
C
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/satloc'
C
      IF(NAMSAT.EQ.'USER') THEN
C---- Call the users USERST subroutine.
        CALL USERST
      ELSEIF(NAMSAT.EQ.'CHKC') THEN
C---- Call input checking routine for PIL tutorials.
        CALL CHKINP
C=!   ELSEIF(NAMSAT.EQ.'CHEM') THEN
C=!     CALL CHEMST
      ELSEIF(NAMSAT.EQ.'MOSG') THEN
C
      ELSE
C---- Call the SATLIT subroutine.
        CALL SATLIT
      ENDIF
      END
C************************************************************
      SUBROUTINE SATLIT
      include '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/satloc'
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX USER SECTION STARTS:
C
C 1   Set dimensions of data-for-GROUND arrays here. WARNING: the
C     corresponding arrays in the MAIN program of the
C     satellite program and the EARTH program must have the same
C     dimensions.
      PARAMETER (NLG=100, NIG=200, NRG=200, NCG=100)
C
      COMMON/LGRND/LG(NLG)/IGRND/IG(NIG)/RGRND/RG(NRG)/CGRND/CG(NCG)
      LOGICAL LG
      CHARACTER*4 CG
C
C 2   Introduce SATLIT-only commons, arrays, equivalences.
C
C 3   User places his data statements here.
C
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
     122,23,24),IGR
C
C--- GROUP 1. Run title and other preliminaries
    1 CONTINUE
      RETURN
C
C--- GROUP 2. Transience; time-step specification
    2 CONTINUE
      RETURN
C
C--- GROUP 3. X-direction grid specification
    3 CONTINUE
      RETURN
C
C--- GROUP 4. Y-direction grid specification
    4 CONTINUE
      RETURN
C
C--- GROUP 5. Z-direction grid specification
    5 CONTINUE
      RETURN
C
C--- GROUP 6. Body-fitted coordinates or grid distortion
    6 CONTINUE
      RETURN
C
C--- GROUP 7. Variables stored, solved & named
    7 CONTINUE
      RETURN
C
C--- GROUP 8. Terms (in differential equations) & devices
    8 CONTINUE
      RETURN
C
C--- GROUP 9. Properties of the medium (or media)
    9 CONTINUE
      RETURN
C
C--- GROUP 10. Inter-phase-transfer processes and properties
   10 CONTINUE
      RETURN
C
C--- GROUP 11. Initialization of variable or porosity fields
   11 CONTINUE
      RETURN
C
C--- GROUP 12. Convection and diffusion adjustments
   12 CONTINUE
      RETURN
C
C--- GROUP 13. Boundary conditions and special sources
   13 CONTINUE
      RETURN
C
C--- GROUP 14. Downstream pressure for PARAB=.TRUE.
   14 CONTINUE
      RETURN
C
C--- GROUP 15. Termination of sweeps
   15 CONTINUE
      RETURN
C
C--- GROUP 16. Termination of iterations
   16 CONTINUE
      RETURN
C
C--- GROUP 17. Under-relaxation devices
   17 CONTINUE
      RETURN
C
C--- GROUP 18. Limits on variables or increments to them
   18 CONTINUE
      RETURN
C
C--- GROUP 19. Data communicated by satellite to GROUND
   19 CONTINUE
      RETURN
C
C--- GROUP 20. Preliminary print-out
   20 CONTINUE
      RETURN
C
C--- GROUP 21. Print-out of variables
   21 CONTINUE
      RETURN
C
C--- GROUP 22. Spot-value print-out
   22 CONTINUE
      RETURN
C
C--- GROUP 23. Field print-out and plot control
   23 CONTINUE
      RETURN
C
C--- GROUP 24. Dumps for restarts
   24 CONTINUE
      END
C************************************************************
      SUBROUTINE USERST
      CALL WRIT40('Dummy subroutine USERST called.         ')
      END
C************************************************************
C
C.... INQ1JB is called at the start of a menu session for
C.... interogating Q1 settings.
C
      SUBROUTINE INQ1JB(MKEY)
      CHARACTER*1 MKEY
      IF(MKEY.NE.'V')THEN
        CALL CNVGRD(MKEY)
      ELSE
        CALL INQ1VD
      ENDIF
      END
C
C.... WRQ1JB is called at the end of a menu session for
C.... writing menu settings in Q1.
C
      SUBROUTINE WRQ1JB(MKEY)
      CHARACTER*1 MKEY
      IF(MKEY.NE.'V') THEN
        CALL WRECQ1(MKEY)
      ELSE
        CALL WRQ1VD
      ENDIF
      END
C
C.... FTNJB is called when command FTNJB(iftn) in a menu
C.... library case is executed, or when the action string
C.... of a selected menu option is FTN-iftn.
C
      SUBROUTINE FTNJB(MKEY,IFTN)
      CHARACTER*1 MKEY
      IF(MKEY.EQ.'C') CALL CVDJB(IFTN)
      IF(MKEY.EQ.'M'.OR.MKEY.EQ.'H'.OR.MKEY.EQ.'F'.OR.MKEY.EQ.'V')
     1                CALL GMNJB(IFTN)
      END
C***********************************************************************
      SUBROUTINE SPPMJB(IGO)
C-----------------------------------------------------------------------
C
C.... Junction Box for SPP menus using VDI
C     IGO = 1    Reading data
C     IGO = 2    Menu settings
C     IGO = 3    Writing data
C
C-----------------------------------------------------------------------
C.... Core and other SPPNAM
      CALL SPPSET(IGO)
      END
C************************************************************
      SUBROUTINE STKJB(IFUN,IPOSTN,IVALUE,CVALUE)
C
C     This subroutine acts as a Junction box for all STACK manipulation
C     It is included in open source so the user can determine how much
C     of the STACK is held in-core before paging to disc begins.
C
C     The size of the STACK can be re-dimensioned by altering the
C     setting of the parameter MAXSTK. The task size increases by
C     76 bytes for every extra STACK-element reserved.
C
C     The initial value of MAXSTK is held in CHAM.IN, and the arrays
C     are increased dynamically as needed
C
      INCLUDE '/phoenics/d_includ/stack'
      COMMON /STACKSIZ/ MXSTACK
C
      CHARACTER CVALUE*(*)
      logical dbsat
      common /dbs/dbsat
C
C*    Ensure IPOSTN has positive value for FORTRAN index
      IF(IPOSTN.LT.1) IPOSTN=1
C
C... allocate stack dynamically
      IF(MXSTACK.LE.0) THEN               ! not set yet
        CALL STACK_MEM(1,MAXSTK0,MXSTACK)
      ELSEIF(IPOSTN.GE.MXSTACK) THEN      ! not big enough
        NEEDED=3*MXSTACK/2
        CALL STACK_MEM(2,NEEDED,MXSTACK)
      ENDIF
C
      GOTO (1,2,3,4) IFUN
  1   CALL SETPTR(IPOSTN,IVALUE,MXSTACK)
      RETURN
  2   CALL GETPTR(IPOSTN,IVALUE,MXSTACK)
      RETURN
  3   CALL SETSTK(IPOSTN,CVALUE,MXSTACK)
      RETURN
  4   CALL GETSTK(IPOSTN,CVALUE,MXSTACK)
      END
C************************************************************
      SUBROUTINE ARRJB(IFUN,I1,I2,I3,R1,C1,L1)
C
C     This subroutine acts as the junction box for all user-declared
C     array manipulation. It is included in open source to allow the
C     space allocated for user-arrays to be changed according to
C     memory limitations on any machine.
C
C     Altering the PARAMETERs MXISP, MXRSP, MXCSP and MXLSP changes
C     the total amount of space available for INTEGER, REAL, CHARACTER
C     and LOGICAL arrays respectively.
C     IFUN = 1 - get value
C            2 - set value
C            3 - check size
C     I1 (for IFUN 1 & 2) = 1 integer, 2 real, 3 character, 4 logical
C             IFUN 3        size of array
C     I2 (for IFUN 1 & 2)   index of array element to get or set
C             IFUN 3      = 1 integer, 2 real, 3 character, 4 logical
      include '/phoenics/d_includ/arrjb'
      CHARACTER*68 C1
      LOGICAL L1
C
      IF(IFUN.EQ.1) THEN      ! Get value
         IF(I1.EQ.1) THEN
            I3=ISP(I2)
         ELSEIF(I1.EQ.2) THEN
            R1=RSP(I2)
         ELSEIF(I1.EQ.3) THEN
            C1=CSP(I2)
         ELSEIF(I1.EQ.4) THEN
            L1=LSP(I2)
         ENDIF
      ELSE IF(IFUN.EQ.2) THEN ! Set value
         IF(I1.EQ.1) THEN
            ISP(I2)=I3
         ELSEIF(I1.EQ.2) THEN
            RSP(I2)=R1
         ELSEIF(I1.EQ.3) THEN
            CSP(I2)=C1
         ELSEIF(I1.EQ.4) THEN
            LSP(I2)=L1
         ENDIF
      ELSE IF(IFUN.EQ.3) THEN ! check size of array. Allocate/stretch as needed
         CALL ARRJB_MEM(I2,I1)
         IF(I2.EQ.1) THEN
            L1=I1.GT.MXISP
         ELSEIF(I2.EQ.2) THEN
            L1=I1.GT.MXRSP
         ELSEIF(I2.EQ.3) THEN
            L1=I1.GT.MXCSP
         ELSEIF(I2.EQ.4) THEN
            L1=I1.GT.MXLSP
         ENDIF
      ENDIF
      END
C************************************************************
      SUBROUTINE GEOSTK(IFUN,I1,IPOIN,IARR,NIARR,RARR,NRARR,
     1                  CARR,NCARR)
C
C     This subroutine acts as the junction box for all
C     graphic stack sizing. It is included in open source
C     to allow the space allocated for Graphic commands
C     to be changed .
C
C     Altering the PARAMETERs MXGLIN ,MXGTXT , MXPLIN , MXGLIN
C     changes the total amount of space available for the graphical
C     stacks used by commands GLINE , GTEXT , PLINE and PTEXT.
C
      PARAMETER (MXGLIN=40000,MXGTXT=500,MXPLIN=1000,MXPTXT=100)
C
C-----Storage for GLINE subroutine
C
      COMMON/STRGLI/IGLSTO(MXGLIN,8)
C
C-----Storage for GTEXT subroutine
C
      COMMON/STRGTX/GTXSTO(MXGTXT)
      CHARACTER*80 GTXSTO
      COMMON/STRGTP/IGTINF(MXGTXT,5)
C
C-----Storage for PLINE subroutine
C
      COMMON/STRPL1/RPLSTO(MXPLIN,4)
      COMMON/STRPL2/IPLSTO(MXPLIN,2)
C
C-----Storage for PTEXT subroutine
C
      COMMON/STRPT1/CPTSTO(MXPTXT)
      CHARACTER*80 CPTSTO
      COMMON/STRPT2/IPTSTO(MXPTXT,2)
      COMMON/STRPT3/RPTSTO(MXPTXT,2)
      SAVE /STRGLI/,/STRGTX/,/STRGTP/,/STRPL1/,/STRPL2/,/STRPT1/,
     1     /STRPT2/,/STRPT3/
C
      DIMENSION IARR(NIARR),RARR(NRARR),CARR(NCARR)
      CHARACTER*80 CARR
C
      GOTO (1,2,3) IFUN
    1 CONTINUE
      IF(I1.EQ.1) THEN
        DO 100 ICO=1,NIARR
          IARR(ICO)=IGLSTO(IPOIN,ICO)
  100   CONTINUE
      ELSEIF(I1.EQ.2) THEN
        DO 200 ICO=1,NIARR
          IARR(ICO)=IGTINF(IPOIN,ICO)
  200   CONTINUE
        CARR(1)=GTXSTO(IPOIN)
      ELSEIF(I1.EQ.3) THEN
        DO 300 ICO=1,NIARR
          IARR(ICO)=IPLSTO(IPOIN,ICO)
  300   CONTINUE
        DO 400 ICO=1,NRARR
          RARR(ICO)=RPLSTO(IPOIN,ICO)
  400   CONTINUE
      ELSEIF(I1.EQ.4) THEN
        CARR(1)=CPTSTO(IPOIN)
        DO 500 ICO=1,NIARR
          IARR(ICO)=IPTSTO(IPOIN,ICO)
  500   CONTINUE
        DO 600 ICO=1,NRARR
          RARR(ICO)=RPTSTO(IPOIN,ICO)
  600   CONTINUE
      ENDIF
      RETURN
    2 CONTINUE
      IF(I1.EQ.1) THEN
        DO 700 ICO=1,NIARR
          IGLSTO(IPOIN,ICO)=IARR(ICO)
  700   CONTINUE
      ELSEIF(I1.EQ.2) THEN
        DO 800 ICO=1,NIARR
          IGTINF(IPOIN,ICO)=IARR(ICO)
  800   CONTINUE
        GTXSTO(IPOIN)=CARR(1)
      ELSEIF(I1.EQ.3) THEN
        DO 900 ICO=1,NIARR
          IPLSTO(IPOIN,ICO)=IARR(ICO)
  900   CONTINUE
        DO 1000 ICO=1,NRARR
          RPLSTO(IPOIN,ICO)=RARR(ICO)
 1000   CONTINUE
      ELSEIF(I1.EQ.4) THEN
        CPTSTO(IPOIN)=CARR(1)
        DO 1100 ICO=1,NIARR
          IPTSTO(IPOIN,ICO)=IARR(ICO)
 1100   CONTINUE
        DO 1200 ICO=1,NRARR
          RPTSTO(IPOIN,ICO)=RARR(ICO)
 1200   CONTINUE
      ENDIF
      RETURN
    3 CONTINUE
      IARR(1)=MXGLIN
      IARR(2)=MXGTXT
      IARR(3)=MXPLIN
      IARR(4)=MXPTXT
      END
      SUBROUTINE REDRAW_ALL
      call update_windowz
      END
C************************************************************
      SUBROUTINE DXFJB(INFILE,OUTFILE,XSIZ,YSIZ,ZSIZ,XPOS,YPOS,ZPOS,
     1                 NP,NF,IERR)
C     This subroutine is provided in open source, to allow the arrays
C     used in the DXF converter to be reset by the user.
C
      PARAMETER (MAXBLK=10, MAXFAC=1000, MAXINS=10, MAXPOL=100)
C
      CHARACTER*(*) INFILE,OUTFILE*80
      CHARACTER*30 BLOCK_NAME(maxblk)
      INTEGER NUM_FACETS(maxblk)
      REAL FACET_COORDS(12,maxfac,maxblk)
      INTEGER NUM_INSERTS(maxblk)
      CHARACTER*30 INS_BLK_NAME(maxins,maxblk)
      REAL INS_BLK_POS(3,maxins,maxblk)
      REAL INS_BLK_SCA(3,maxins,maxblk)
      REAL INS_BLK_EXT(3,maxins,maxblk)
      REAL INS_BLK_ROT(maxins,maxblk)
      REAL FACDAT(12,MAXFAC)
      REAL XPOL(maxpol),YPOL(maxpol),ZPOL(maxpol)
C... call DXF converter
      CALL DXFCHAM(INFILE,OUTFILE,XSIZ,YSIZ,ZSIZ,XPOS,YPOS,ZPOS,
     1 NP,NF,IERR,BLOCK_NAME,NUM_FACETS,FACET_COORDS,NUM_INSERTS,
     2 INS_BLK_NAME,INS_BLK_POS,INS_BLK_SCA,INS_BLK_EXT,INS_BLK_ROT,
     1 FACDAT,XPOL,YPOL,ZPOL,MAXBLK,MAXFAC,MAXINS,MAXPOL)
      END
C----------------------------------------------------------------------
      INTEGER FUNCTION GETREFF(NAME)
      CHARACTER*(*) NAME
      GETREFF=0
      END
C----------------------------------------------------------------------
      SUBROUTINE GETMATT(RMATT,I)
      REAL RMATT(*)
      END
C----------------------------------------------------------------------
      SUBROUTINE MATRIX_IDENT(RM)
      REAL RM(*)
      END
C----------------------------------------------------------------------
      SUBROUTINE MATRIX_MULPOSINV(RM,PIN,POUT)
      REAL RM(*), PIN(*), POUT(*)
      END
c