c
C FILE NAME SATLIT.FOR -------------------------------------- 031019
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
C (C) COPYRIGHT 2016
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 'tab_mem'
INCLUDE 'stackdta'
INCLUDE 'vrvvars'
INCLUDE 'clpcmn'
INCLUDE 'parcmn'
INCLUDE 'plncmn'
INCLUDE 'vrvmof'
INCLUDE 'strmcmn' ! to set MAXSTRM
INCLUDE 'gcvlnk'
INCLUDE '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=200,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 NOTE: For Unix/DOS NHPL should be set identically to MAXFCT
C This is not used for OpenGL Editor/Viewer
PARAMETER (NHPL=10000)
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*196 MENSVA(NMSM)
COMMON /MENSVD/ MENSVA
COMMON /MENSVI/ NMNSAV
COMMON /SPEDAI/NSPMAX,NSPEDA
COMMON /LVDEC/ LV32,LVDE; LOGICAL LV32,LVDE
LOGICAL LRELOAD
COMMON /LVDRL/ LRELOAD
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= 5000
MXTCV =100000; MXFRC =10000
MXSTACK = 0; MAXSTK0=5000
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 GET_FMEM(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
100 CONTINUE
LRELOAD=.FALSE.
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)
IF(LRELOAD) GOTO 100
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 FREE_FMEM
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
CALL CLEAR_ALL_CORNERS
C... deallocate ARRJB arrays
CALL ARRJB_MEM(5,0)
C... deallocate INTPOL table arrays if present
CALL CLEAR_TABS
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 'satear'
INCLUDE '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 'farray'
INCLUDE 'satear'
INCLUDE '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 'stackdta'
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 '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
C************************************************************
SUBROUTINE REDRAW_ALL
CALL UPDATE_WINDOWZ
END
C************************************************************
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