1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
| PROGRAM progRHS
IMPLICIT NONE
! EXTERNAL upwdRHS
INTEGER :: nx,ny,lsize,MS1N,nxnylsize,erreur
INTEGER::ind1,ind2,ind3,ind4,ind5,ind6,ind7,ind8,ind9,ind10
REAL, ALLOCATABLE, dimension ( : ) :: Cin,Cout,Cp0,Cix,Cfx,Ciy,Cfy
REAL, ALLOCATABLE, dimension ( : , : , : ) :: N0L,NpL,NmL2
REAL, ALLOCATABLE, dimension ( : , : , : ) :: M0L,MpL,MmL
REAL, ALLOCATABLE, dimension ( : , : , : , : ) :: Cp00
INTEGER :: ix,iy,ix0,iy0,iiyp,iiym,iixp,iixm
INTEGER, ALLOCATABLE, dimension( : ) :: maskMx,maskPx,tabMx,tabPx
INTEGER, ALLOCATABLE, dimension( : ) :: maskMy,maskPy,tabMy,tabPy
interface
SUBROUTINE upwdRHS(Cin, Cp00, NpL, NmL2, MpL, MmL, Cout)
INTEGER :: ix,iy,ix0,iy0,iiyp,iiym,iixp,iixm
REAL, dimension ( : ) :: Cp0,Cix,Cfx,Ciy,Cfy
INTEGER :: ind1,ind2,ind3,ind4,ind5,ind6,ind7,ind8,ind9,ind10
END SUBROUTINE UPWDRHS
END interface
nx=3
ny=3
MS1N=4
lsize=2*2*MS1N
nxnylsize=nx*ny*lsize
ALLOCATE(Cin(nxnylsize),STAT=erreur)
ALLOCATE(N0L(lsize,lsize,nx),STAT=erreur)
ALLOCATE(NpL(lsize,lsize,nx),STAT=erreur)
ALLOCATE(NmL2(lsize,lsize,nx),STAT=erreur)
ALLOCATE(M0L(lsize,lsize,ny),STAT=erreur)
ALLOCATE(MpL(lsize,lsize,ny),STAT=erreur)
ALLOCATE(MmL(lsize,lsize,ny),STAT=erreur)
ALLOCATE(maskMx(nx),STAT=erreur)
ALLOCATE(maskPx(nx),STAT=erreur)
ALLOCATE(maskMy(ny),STAT=erreur)
ALLOCATE(maskPy(ny),STAT=erreur)
ALLOCATE(tabMx(nx),STAT=erreur)
ALLOCATE(tabPx(nx),STAT=erreur)
ALLOCATE(tabMy(ny),STAT=erreur)
ALLOCATE(tabPy(ny),STAT=erreur)
ALLOCATE(Cp0(lsize),STAT=erreur)
ALLOCATE(Cix(lsize),STAT=erreur)
ALLOCATE(Cfx(lsize),STAT=erreur)
ALLOCATE(Ciy(lsize),STAT=erreur)
ALLOCATE(Cfy(lsize),STAT=erreur)
ALLOCATE(Cp00(lsize,lsize,nx,ny),STAT=erreur)
Cin=2
N0L( : , : , : ) =3
M0L( : , : , : ) =3
NmL2( : , : , : ) =5
NpL( : , : , : ) =10
MmL( : , : , : ) =50
MpL( : , : , : ) =100
ALLOCATE(Cout(nxnylsize),STAT=erreur)
DO ix=1,nx
tabMx(ix)=ix-1
tabPx(ix)=ix+1
ENDDO
DO ix=1,nx
maskMx(ix)= max(tabMx(2),tabMx(ix))
maskPx(ix)= min(tabPx(nx),tabPx(ix))
ENDDO
DO iy=1,ny
tabMy(iy)=iy-1
tabPy(iy)=iy+1
ENDDO
DO iy=1,ny
maskMy(iy)= max(tabMy(2),tabMy(iy))
maskPy(iy)= min(tabPy(ny),tabPy(iy))
ENDDO
DO iy=1,ny
DO ix=1,nx
Cp00(:,:,ix,iy)=M0L(:,:,iy)+N0L(:,:,ix)
ENDDO
ENDDO
CALL upwdRHS(Cin, Cp00, NpL, NmL2, MpL, MmL, Cout)
DEALLOCATE(Cin,Cout,N0L,M0L,NpL,NmL2,MpL,MmL)
DEALLOCATE(maskMx,maskPx,maskMy,maskPy,Cp00)
DEALLOCATE(Cp0,Cix,Cfx,Ciy,Cfy,tabMx,tabPx,tabMy,tabPy)
STOP
END PROGRAM progRHS |