00001 c rtmrag1rtwt_.F
00002
00003 c*********************************************************************
00004 c* (c) Copyright 1994-2002 David A. Richie. All rights reserved.
00005 c*********************************************************************
00006 c* Created: Jun 19, 2000
00007 c* Last Modified: Aug 19, 2001
00008 c*********************************************************************
00009
00010 subroutine rtmrag1rtwt(
00011 & Msize
00012 & ,mmax
00013 & ,mrastep,mracoef
00014 & ,data
00015 & )
00016
00017 c ****************************************
00018 c ***** COMMON BLOCKS AND PARAMETERS *****
00019 c ****************************************
00020
00021 real H00,H01,H11
00022 parameter(H00=0.70710678118654752440)
00023 parameter(H10=-0.61237243569579452455)
00024 parameter(H11=0.35355339059327376220)
00025
00026 c *******************************
00027 c ***** VARIABLES EXCHANGED *****
00028 c *******************************
00029
00030 integer Msize
00031 integer mmax
00032 integer mrastep
00033 real mracoef(0:1,0:1,0:Msize-1)
00034 real data
00035
00036 c *** mracoef(k,eta,m)
00037
00038 c ****************************
00039 c ***** LOCAL VARIABLES ******
00040 c ****************************
00041
00042 integer mcycle
00043 integer m
00044 real tmp0,tmp1,,tmpold0,tmpold1
00045
00046 c ******************************
00047 c ***** EXTERNAL FUNCTIONS *****
00048 c ******************************
00049
00050 mrastep=mrastep+1
00051
00052 mcycle=0
00053 do while (btest(mrastep,mcycle).and.(mcycle.lt.mmax))
00054 mcycle=mcycle+1
00055 enddo
00056
00057 tmp0=data
00058 tmp1=0
00059
00060 m=1
00061 do while (m.le.mcycle)
00062 tmpold0=mracoef(0,0,m-1)
00063 tmpold1=mracoef(1,0,m-1)
00064 mracoef(0,0,m-1)=tmp0
00065 mracoef(1,0,m-1)=tmp1
00066 mracoef(0,1,m)=H11*(tmpold0-tmp0)-H10*(tmpold1+tmp1)
00067 mracoef(1,1,m)=H00*(tmpold1-tmp1)
00068 tmp0=H00*(tmpold0+tmp0)
00069 tmp1=H10*(tmpold0-tmp0)+H11*(tmpold1+tmp1)
00070 m=m+1
00071 enddo
00072
00073 mracoef(0,0,m-1)=tmp0
00074 mracoef(1,0,m-1)=tmp1
00075
00076 return
00077 end
00078 c********************************************************
