PHOTON USE
  p;;;;;;;;
 
  msg There is no need to press RETURN
  upause 3
  msg The grid outline.
  gr ou z 1  co 8
  upause 3
  msg The complete grid
  gr z 1 co 10
  upause 3
  gr off
  red
  msg The left-hand part of the active grid
  gr co 8
  z 1
  1 5 1 10
  upause 3
  msg The right-hand part of the active grid
  gr  co 4
  z 1
  9  13 1 10
  upause 3
  red
  msg Velocity vectors on the left
  vec z 1 x 1 5 y 1 10 sh
  upause 3
  msg Velocity vectors on the right
  vec z 1 x 8 13 y 1 10 sh
  upause 3
  red
  msg The pressure field
  con  p1 fi
  z 1
  1 5 1 10
  0.01
  con p1 fi
  z 1
  8 13 1 10
  0.01
  upause 3
  con off
  red
  msg The temperature field
  con temp fi
  z 1
  1 5 1 10
  0.01
  con temp fi
  z 1
  8 13 1 10
  0.01
  vec z 1 x 1 5 y 1 10
  vec z 1 x 8 13 y 1 10
  msg Press e to END
  enduse
 
    GROUP 1. Run title and other preliminaries
TEXT(Multi-Blocking By Shear, XY Plane 
TITLE
mesg(PC486/50 time last reported as appx. 45.sec
  DISPLAY
 
  Grid-restructuring (also called domain-decomposition or multi-
  blocking) allows parts of grids to be moved from their usual
  positions and linked with unusual neighbours. The advantage is
  that irregular shapes can then be fitted without significant
  waste of computer storage or execution time.
 
  The method is here illustrated for a simple rectangular shape
  which has one part shifted relative to the other, as indicated.
            +-------+
            |       |                            ^ shift right-hand
            |       |                            | of the grid up
    +-------+       |                 +-------+-------+
    |               |                 |       |       |
    |               |                 |       |       |
    |       +-------+                 |       |       |  grid
    |       |      desired            |       |       |  used
    |       |        shape            |       |       |
    +-------+                         +-------+-------+
 
  LSG58=T, so as to ensure that BFC=T for display purposes only,
  ie in SATELLITE and PHOTON, but BFC=F in the EARTH run, because
  the grid is cartesian. This saves much storage.
  press return to continue.
  ENDDIS
READVDU(ANS,CHAR,N)
REAL(XLENGTH,YLENGTH,ZLENGTH)
INTEGER(NXNOM,IYSHFT,ISHIFT,IEXTRA)
XLENGTH=1.0;YLENGTH=1.0;ZLENGTH=1.0
NXNOM=10;NPHI=20;NX=NXNOM+2;NY=10;NZ=1
XLENGTH=XLENGTH*NX/NXNOM
MESG(NXNOM=:NXNOM:; NY=:NY:; NZ=1
MESG(What y-direction shift would you like ? (from 1-ny to ny-1 )
READVDU(IYSHFT,INT,0)
ISHIFT=2*NY-IYSHFT
mesg(the offset between linked points is 2*ny - iyshft ie :ishift:
    GROUP 3. X-direction grid specification
   **Domain is XLENGTH m long in x-direction, with equal intervals
GRDPWR(X,NX,XLENGTH,1.0)
    GROUP 4. Y-direction grid specification
   **Domain is YLENGTH m long in y-direction, with equal intervals
GRDPWR(Y,NY,YLENGTH,1.0)
    GROUP 5. Z-direction grid specification
   **Domain is ZLENGTH m long in z-direction, with equal intervals
GRDPWR(Z,NZ,ZLENGTH,1.0)
IEXTRA=0;BFC=T;IEXTRA=1;NX=NX+1;XULAST=1.3
mesg(Create an initial grid. Press return
READVDU(ANS,CHAR,N)
GSET(D,NX,NY,NZ,XULAST,YVLAST,ZWLAST)
ISHIFT=ISHIFT+NY
VIEW(K,1)
mesg(Shift one part relative to the other. Press return
READVDU(ANS,CHAR,N)
GSET(C,K1,F,K1,NXNOM/2+3,NX,1,NY,+,-3.0/13.0*XLENGTH, YVLAST*IYSHF$
T/NY,0.0)
VIEW(K,1)
GSET(C,K2,F,K1,1,NX,1,NY,+,0.0,0.0,ZLENGTH)
    GROUP 7. Variables stored, solved & named
   **Choose first-phase enthalpy (H1) as dependent variable
     and activate the whole-field elliptic solver
SOLUTN(H1,Y,Y,Y,N,N,N);NAME(H1)=TEMP
STORE(VPOR);SOLVE(P1,U1,V1);SOLUTN(P1,Y,Y,Y,N,N,N)
    GROUP 8. Terms (in differential equations) & devices
   **For pure conduction, cut out built-in source and convection
     terms
TERMS(TEMP,N,N,Y,N,Y,Y)
    GROUP 9. Properties of the medium (or media)
   **Thermal conductivity will be ENUL*RHO1/PRNDTL(TEMP), so :
ENUL=1.0;RHO1=1.0;PRNDTL(TEMP)=1.0
    GROUP 11. Initialization of variable or porosity fields
INIADD=F
FIINIT(VPOR)=1.0
IF(IYSHFT.GT.0) THEN
 CONPOR(BAR1,0.0,CELL,NXNOM/2+1,NXNOM/2+1,1,IYSHFT,1,NZ)
 CONPOR(BAR2,0.0,CELL,NXNOM/2+2+IEXTRA,NXNOM/2+2+IEXTRA, NY-IYSHFT+$
1,NY,1,NZ)
ENDIF
IF(IYSHFT.LT.0) THEN
 CONPOR(BAR1,0.0,CELL,NXNOM/2+1,NXNOM/2+1,NY+1+IYSHFT,NY,1,NZ)
 CONPOR(BAR2,0.0,CELL,NXNOM/2+2+IEXTRA,NXNOM/2+3+IEXTRA, 1,-IYSHFT,$
1,NZ)
ENDIF
IF(BFC) THEN
 CONPOR(EXTRACEL,0.0,CELL,NXNOM/2+2,NXNOM/2+2,1,NY,1,NZ)
ENDIF
FIINIT(P1)=0.45
PATCH(BLOK2,INIVAL,NX/2+1,NX,1,NY,1,NZ,1,LSTEP)
INIT(BLOK2,P1,0.0,-0.45)
    GROUP 13. Boundary conditions and special sources
   **Cold
PATCH(COLD,CELL,1,1,1,NY,1,1,1,1)
COVAL(COLD,TEMP,1.E5,-0.9)
COVAL(COLD,P1,FIXVAL,0.9)
PATCH(HOT,CELL,NX,NX,1,NY,NZ,NZ,1,1)
COVAL(HOT,TEMP,1.E5,0.9)
COVAL(HOT,P1,FIXVAL,-0.9)
  link feature: for patch names beginning with +. This feature
  makes val = phi(i + nint(vphie i + ishift
IF(IYSHFT.GE.0) THEN
 PATCH(+1,CELL,NXNOM/2+1,NXNOM/2+1,1+IYSHFT,NY,1,1,1,1)
ELSE
 PATCH(+1,CELL,NXNOM/2+1,NXNOM/2+1,1,NY+IYSHFT,1,1,1,1)
ENDIF
COVAL(+1,TEMP,FIXVAL,ISHIFT)
COVAL(+1,P1,FIXVAL,ISHIFT)
COVAL(+1,U1,FIXVAL,ISHIFT)
COVAL(+1,V1,FIXVAL,ISHIFT)
IF(IYSHFT.GE.0) THEN
 PATCH(+2,CELL,NXNOM/2+2+IEXTRA,NXNOM/2+2+IEXTRA, 1,NY-IYSHFT,1,1,1$
,1)
ELSE
 PATCH(+2,CELL,NXNOM/2+2+IEXTRA,NXNOM/2+2+IEXTRA, 1-IYSHFT,NY,1,1,1$
,1)
ENDIF
COVAL(+2,TEMP,FIXVAL,-ISHIFT)
COVAL(+2,P1,FIXVAL,-ISHIFT)
COVAL(+2,U1,FIXVAL,-ISHIFT)
COVAL(+2,V1,FIXVAL,-ISHIFT)
    GROUP 15. Termination of sweeps
LSWEEP=20;SELREF=T;RESFAC=1.E-2
    GROUP 16. Termination of iterations
LITER(TEMP)=-10;LITER(P1)=-1
    GROUP 17. Under-relaxation devices
RELAX(U1,FALSDT,0.1);RELAX(V1,FALSDT,0.1)
    GROUP 21. Print-out of variables
   **Print fields of temperature
OUTPUT(TEMP,Y,Y,Y,Y,Y,Y)
    GROUP 22. Spot-value print-out
IXMON=NX/2+1;IYMON=NY/2+1;IZMON=NZ/2+1
    GROUP 23. Field print-out and plot control
NXPRIN=NX/5;NYPRIN=NY/5;NZPRIN=NZ/5
   **Plot a profile along the line Iy=ny/2
PATCH(YLINE,PROFIL,1,NX,NY/2,NY/2,1,1,1,1)
PLOT(YLINE,TEMP,0.0,0.0);PLOT(YLINE,P1,0.0,0.0)
PLOT(YLINE,U1,0.0,0.0)
   ** Plot contour diagrams for the plane
PATCH(FIRST,CONTUR,1,NXNOM/2,1,NY,1,NZ,1,1)
PLOT(FIRST,TEMP,0.0,20.0);PLOT(FIRST,P1,0.0,20.0)
PATCH(SECOND,CONTUR,NXNOM/2+3,NX,1,NY,1,NZ,1,1)
PLOT(SECOND,TEMP,0.0,20.0);PLOT(SECOND,P1,0.0,20.0)
    GROUP 24. Dumps for restarts
NXPRIN=1;NYPRIN=1
IXMON=NXNOM/2;RESREF(TEMP)=1.E-10;TSTSWP=12345
IXPRF=NXNOM/2-1;IXPRL=NXNOM/2+1+IEXTRA
Q1QUIT=T
TSTSWP=-1
  ** set LSG58=t in order to switch off bfc treatment in earth
     until dumping to phi, and also rename u1 and v1 in order that
     PHOTON can plot vectors
LSG58=T
  NAME(U1)=UCRT;NAME(V1)=VCRT