| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576 |
- *DECK DEFER
- SUBROUTINE DEFER (COFX, COFY, IDMN, USOL, GRHS)
- C***BEGIN PROLOGUE DEFER
- C***SUBSIDIARY
- C***PURPOSE Subsidiary to SEPELI
- C***LIBRARY SLATEC
- C***TYPE SINGLE PRECISION (DEFER-S)
- C***AUTHOR (UNKNOWN)
- C***DESCRIPTION
- C
- C This subroutine first approximates the truncation error given by
- C TRUN1(X,Y)=DLX**2*TX+DLY**2*TY where
- C TX=AFUN(X)*UXXXX/12.0+BFUN(X)*UXXX/6.0 on the interior and
- C at the boundaries if periodic (here UXXX,UXXXX are the third
- C and fourth partial derivatives of U with respect to X).
- C TX is of the form AFUN(X)/3.0*(UXXXX/4.0+UXXX/DLX)
- C at X=A or X=B if the boundary condition there is mixed.
- C TX=0.0 along specified boundaries. TY has symmetric form
- C in Y with X,AFUN(X),BFUN(X) replaced by Y,DFUN(Y),EFUN(Y).
- C The second order solution in USOL is used to approximate
- C (via second order finite differencing) the truncation error
- C and the result is added to the right hand side in GRHS
- C and then transferred to USOL to be used as a new right
- C hand side when calling BLKTRI for a fourth order solution.
- C
- C***SEE ALSO SEPELI
- C***ROUTINES CALLED DX, DY
- C***COMMON BLOCKS SPLPCM
- C***REVISION HISTORY (YYMMDD)
- C 801001 DATE WRITTEN
- C 890531 Changed all specific intrinsics to generic. (WRB)
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900402 Added TYPE section. (WRB)
- C***END PROLOGUE DEFER
- C
- COMMON /SPLPCM/ KSWX ,KSWY ,K ,L ,
- 1 AIT ,BIT ,CIT ,DIT ,
- 2 MIT ,NIT ,IS ,MS ,
- 3 JS ,NS ,DLX ,DLY ,
- 4 TDLX3 ,TDLY3 ,DLX4 ,DLY4
- DIMENSION GRHS(IDMN,*) ,USOL(IDMN,*)
- EXTERNAL COFX ,COFY
- C***FIRST EXECUTABLE STATEMENT DEFER
- DO 40 J=JS,NS
- YJ = CIT+(J-1)*DLY
- CALL COFY (YJ,DJ,EJ,FJ)
- DO 30 I=IS,MS
- XI = AIT+(I-1)*DLX
- CALL COFX (XI,AI,BI,CI)
- C
- C COMPUTE PARTIAL DERIVATIVE APPROXIMATIONS AT (XI,YJ)
- C
- CALL DX (USOL,IDMN,I,J,UXXX,UXXXX)
- CALL DY (USOL,IDMN,I,J,UYYY,UYYYY)
- TX = AI*UXXXX/12.0+BI*UXXX/6.0
- TY = DJ*UYYYY/12.0+EJ*UYYY/6.0
- C
- C RESET FORM OF TRUNCATION IF AT BOUNDARY WHICH IS NON-PERIODIC
- C
- IF (KSWX.EQ.1 .OR. (I.GT.1 .AND. I.LT.K)) GO TO 10
- TX = AI/3.0*(UXXXX/4.0+UXXX/DLX)
- 10 IF (KSWY.EQ.1 .OR. (J.GT.1 .AND. J.LT.L)) GO TO 20
- TY = DJ/3.0*(UYYYY/4.0+UYYY/DLY)
- 20 GRHS(I,J) = GRHS(I,J)+DLX**2*TX+DLY**2*TY
- 30 CONTINUE
- 40 CONTINUE
- C
- C RESET THE RIGHT HAND SIDE IN USOL
- C
- DO 60 I=IS,MS
- DO 50 J=JS,NS
- USOL(I,J) = GRHS(I,J)
- 50 CONTINUE
- 60 CONTINUE
- RETURN
- END
|
