/[MITgcm]/MITgcm_contrib/mlosch/cg2d_sr_bench/code/ini_rhs.F
ViewVC logotype

Annotation of /MITgcm_contrib/mlosch/cg2d_sr_bench/code/ini_rhs.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Sun Nov 29 11:02:03 2009 UTC (15 years, 7 months ago) by mlosch
Branch: MAIN
CVS Tags: HEAD
add Christopher Wolfe's benchmark for his implemenation of the single reduction cg2d solver

1 mlosch 1.1 C $Header: $
2     C $Name: $
3     C $Id: ini_rhs.F,v 1.4 2009/11/17 02:41:49 cwolfe Exp $
4     #include "CPP_OPTIONS.h"
5     CStartOfInterface
6     SUBROUTINE INI_RHS(
7     I cg2d_b,
8     O cg2d_x1,
9     O cg2d_x2,
10     I myThid)
11     C /==========================================================\
12     C | SUBROUTINE INI_RHS |
13     C | o Initialise 2d conjugate gradient solver right-hand side|
14     C |==========================================================|
15     C | Set a source term b in Ax = b (1) |
16     C | We solve (1) with neumann bc's whic means that b must |
17     C | integrate out to zero over the whole domain. If b does |
18     C | not integrate out to zero then the solution will |
19     C | converge, but to a non-zero final residual. |
20     C \==========================================================/
21     IMPLICIT NONE
22    
23     C === Global variables ===
24     #include "SIZE.h"
25     #include "EEPARAMS.h"
26     #include "PARAMS.h"
27     #include "CG2D.h"
28    
29     C === Routine arguments ===
30     CEndOFInterface
31    
32     C === Local variables ===
33     C iG, jG - Global coordinate index
34     C faceArea - Temporary used to hold cell face areas.
35     C I,J,K - Loop counters
36     C iMid, jMid - Global coords of mid-point of model domain
37     INTEGER I, J
38     INTEGER bi, bj
39     INTEGER iG, jG
40     INTEGER iMid, jMid
41     INTEGER iQ, i3Q
42     INTEGER myThid
43     _RL cg2d_b(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
44     _RL cg2d_x1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
45     _RL cg2d_x2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
46     _RL bsum, bsumTile(nSx,nSy)
47     _RL port_rand
48     INTEGER numPoints
49    
50     C-- Get model global domain mid-point
51     iMid = Nx/2
52     iQ = Nx/4
53     i3Q = 3*Nx/4
54     jMid = Ny/2
55    
56     C-- Set dummy source term for elliptic equation
57     DO bj=myByLo(myThid),myByHi(myThid)
58     DO bi=myBxLo(myThid),myBxHi(myThid)
59     DO J=1-OLy,sNy+OLy
60     DO I=1-OLx,sNx+OLx
61     cg2d_b(I,J,bi,bj) = 0. _d 0
62     cg2d_x1(I,J,bi,bj) = 0. _d 0
63     cg2d_x2(I,J,bi,bj) = 0. _d 0
64     ENDDO
65     ENDDO
66     ENDDO
67     ENDDO
68    
69     C bsum = 0. _d 0
70     C numPoints = NX*NY
71     DO bj=myByLo(myThid),myByHi(myThid)
72     DO bi=myBxLo(myThid),myBxHi(myThid)
73     C bsumTile(bi,bj) = 0. _d 0
74     DO J=1,sNy
75     DO I=1,sNx
76     cg2d_b(I,J,bi,bj) = 0. _d 0
77     C-- Set +/-1 source function in middle of domain.
78     iG = myXGlobalLo + sNx*(bi-1) + I - 1
79     jG = myYGlobalLo + sNy*(bj-1) + J - 1
80     C write(*,'(i2,2i3,2i5,2x,a,2i5)')mythid,bi,bj,i,j,'iG, jG =',iG,jG
81     IF ( iG .EQ. Nx/2 .AND. jG .EQ. Ny/2 )
82     & cg2d_b(I,J,bi,bj) = 1._d 0
83     IF ( iG .EQ. Nx/2+1 .AND. jG .EQ. Ny/2 )
84     & cg2d_b(I,J,bi,bj) = -1. _d 0
85     C cg2d_b(I,J,bi,bj) = port_rand(-1.)
86     C bsumTile(bi,bj) = bsumTile(bi,bj) + cg2d_b(I,J,bi,bj)
87     ENDDO
88     ENDDO
89     ENDDO
90     ENDDO
91    
92     C CALL GLOBAL_SUM_TILE_RL(bsumTile,bsum,myThid)
93    
94     ! DO bj=myByLo(myThid),myByHi(myThid)
95     ! DO bi=myBxLo(myThid),myBxHi(myThid)
96     ! DO J=1,sNy
97     ! DO I=1,sNx
98     ! cg2d_b(I,J,bi,bj) = cg2d_b(I,J,bi,bj) - bsum/numPoints
99     ! ENDDO
100     ! ENDDO
101     ! ENDDO
102     ! ENDDO
103    
104     C-- Update overlap regions synchronously
105     CALL EXCH_XY_RL(cg2d_b,myThid)
106     CALL EXCH_XY_RL(cg2d_x1,myThid)
107     CALL EXCH_XY_RL(cg2d_x2,myThid)
108     C
109     RETURN
110     END
111    

  ViewVC Help
Powered by ViewVC 1.1.22