1 |
edhill |
1.1 |
C -*-fortran-*- |
2 |
|
|
C $Header: /u/gcmpack/MITgcm_contrib/eh3/regrid/regrid/regrid_scalar_out.template,v 1.5 2006/08/12 03:20:05 edhill Exp $ |
3 |
|
|
C $Name: $ |
4 |
|
|
|
5 |
|
|
#include "REGRID_OPTIONS.h" |
6 |
|
|
|
7 |
|
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
8 |
|
|
CBOP 0 |
9 |
|
|
C !ROUTINE: REGRID_SCALAR_RX_OUT |
10 |
|
|
|
11 |
|
|
C !INTERFACE: |
12 |
|
|
SUBROUTINE REGRID_SCALAR_RX_OUT( |
13 |
|
|
I mnc_bname, igout, var, vname, nz, izlev, |
14 |
|
|
I myThid ) |
15 |
|
|
|
16 |
|
|
C !DESCRIPTION: |
17 |
|
|
C Perform simple 2D scalar regrid and write the result to the |
18 |
|
|
C specified file |
19 |
|
|
|
20 |
|
|
C !USES: |
21 |
|
|
IMPLICIT NONE |
22 |
|
|
#include "SIZE.h" |
23 |
|
|
#include "EEPARAMS.h" |
24 |
|
|
#include "PARAMS.h" |
25 |
|
|
#include "REGRID_SIZE.h" |
26 |
|
|
#include "REGRID.h" |
27 |
|
|
|
28 |
|
|
C !INPUT PARAMETERS: |
29 |
|
|
C igout :: index of output grid to use |
30 |
|
|
C var :: variable on "standard" model grid |
31 |
|
|
C vname :: variable name |
32 |
|
|
C nz :: number of z levels |
33 |
|
|
C izlev :: index vector of z levels |
34 |
|
|
C myThid :: my thread Id number |
35 |
|
|
INTEGER nz |
36 |
|
|
__V var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nz,nSx,nSy) |
37 |
|
|
CHARACTER*(*) mnc_bname |
38 |
|
|
CHARACTER*(*) vname |
39 |
|
|
INTEGER izlev(nz) |
40 |
|
|
INTEGER igout, myThid |
41 |
|
|
CEOP |
42 |
|
|
|
43 |
|
|
C !LOCAL VARIABLES: |
44 |
|
|
C msgBuf - Informational/error meesage buffer |
45 |
|
|
INTEGER ILNBLNK |
46 |
|
|
EXTERNAL ILNBLNK |
47 |
|
|
C CHARACTER*(MAX_LEN_MBUF) msgBuf |
48 |
|
|
INTEGER iz, bi,bj, ii,ind, nval, nnb |
49 |
|
|
#ifdef RX_IS_REAL4 |
50 |
|
|
REAL*4 ptsums(REGRID_NELEM_MAX,nSx,nSy) |
51 |
|
|
#endif |
52 |
|
|
#ifdef RX_IS_REAL8 |
53 |
|
|
REAL*8 ptsums(REGRID_NELEM_MAX,nSx,nSy) |
54 |
|
|
#endif |
55 |
|
|
#ifdef ALLOW_MNC |
56 |
|
|
INTEGER CW_DIMS, NLEN |
57 |
|
|
PARAMETER ( CW_DIMS = 10 ) |
58 |
|
|
PARAMETER ( NLEN = 80 ) |
59 |
|
|
INTEGER offsets(CW_DIMS) |
60 |
|
|
INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS) |
61 |
|
|
CHARACTER*(NLEN) dn(CW_DIMS) |
62 |
|
|
CHARACTER*(NLEN) regrid_vname |
63 |
|
|
CHARACTER*(NLEN) d_cw_name |
64 |
|
|
CHARACTER*(NLEN) dn_blnk |
65 |
|
|
#endif /* ALLOW_MNC */ |
66 |
|
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
67 |
|
|
|
68 |
|
|
DO ii = 1,CW_DIMS |
69 |
|
|
offsets(ii) = 0 |
70 |
|
|
ENDDO |
71 |
|
|
|
72 |
|
|
C ============================================= |
73 |
|
|
C Create the MNC definition for the variable |
74 |
|
|
#ifdef ALLOW_MNC |
75 |
|
|
_BEGIN_MASTER( myThid ) |
76 |
|
|
#ifdef ALLOW_USE_MPI |
77 |
|
|
IF ( mpiMyId .EQ. 0 ) THEN |
78 |
|
|
#endif /* ALLOW_USE_MPI */ |
79 |
|
|
|
80 |
|
|
bi = myBxLo(myThid) |
81 |
|
|
bj = myByLo(myThid) |
82 |
|
|
|
83 |
|
|
IF (useMNC .AND. regrid_mnc) THEN |
84 |
|
|
|
85 |
|
|
DO ii = 1,NLEN |
86 |
|
|
dn_blnk(ii:ii) = ' ' |
87 |
|
|
ENDDO |
88 |
|
|
|
89 |
|
|
dn(1)(1:NLEN) = dn_blnk(1:NLEN) |
90 |
|
|
WRITE(dn(1),'(a,i6.6)') 'Zrgl_', nz |
91 |
|
|
dim(1) = nz |
92 |
|
|
ib(1) = 1 |
93 |
|
|
ie(1) = nz |
94 |
|
|
|
95 |
|
|
CALL MNC_CW_ADD_GNAME('regrid_levels', 1, |
96 |
|
|
& dim, dn, ib, ie, myThid) |
97 |
|
|
CALL MNC_CW_ADD_VNAME('regrid_levels', 'regrid_levels', |
98 |
|
|
& 0,0, myThid) |
99 |
|
|
CALL MNC_CW_ADD_VATTR_TEXT('regrid_levels','description', |
100 |
|
|
& 'Idicies of vertical levels within the source arrays', |
101 |
|
|
& myThid) |
102 |
|
|
|
103 |
|
|
CALL MNC_CW_I_W('I',mnc_bname,bi,bj, |
104 |
|
|
& 'regrid_levels', izlev, myThid) |
105 |
|
|
|
106 |
|
|
CALL MNC_CW_DEL_VNAME('regrid_levels', myThid) |
107 |
|
|
CALL MNC_CW_DEL_GNAME('regrid_levels', myThid) |
108 |
|
|
|
109 |
|
|
d_cw_name(1:NLEN) = dn_blnk(1:NLEN) |
110 |
|
|
DO ii = 1,CW_DIMS |
111 |
|
|
dn(ii)(1:NLEN) = dn_blnk(1:NLEN) |
112 |
|
|
ENDDO |
113 |
|
|
|
114 |
|
|
C All the horizontal dimensions of the output grid are flattened |
115 |
|
|
C into a single total-DoF vector. |
116 |
|
|
WRITE(dn(1),'(a,i10.10)') 'regrid_', regrid_nout(igout) |
117 |
|
|
dim(1) = regrid_nout(igout) |
118 |
|
|
ib(1) = 1 |
119 |
|
|
ie(1) = regrid_nout(igout) |
120 |
|
|
|
121 |
|
|
C Vertical dimension |
122 |
|
|
dn(2)(1:NLEN) = dn_blnk(1:NLEN) |
123 |
|
|
WRITE(dn(2),'(a,i6.6)') 'Zrgl_', nz |
124 |
|
|
dim(2) = nz |
125 |
|
|
ib(2) = 1 |
126 |
|
|
ie(2) = nz |
127 |
|
|
|
128 |
|
|
C Time dimension |
129 |
|
|
dn(3)(1:1) = 'T' |
130 |
|
|
dim(3) = -1 |
131 |
|
|
ib(3) = 1 |
132 |
|
|
ie(3) = 1 |
133 |
|
|
|
134 |
|
|
C Generate unique grid names |
135 |
|
|
WRITE(d_cw_name,'(a3,i3.3,a1,i3.3)') 'rg_',igout,'_',nz |
136 |
|
|
|
137 |
|
|
CALL MNC_CW_ADD_GNAME(d_cw_name, 3, |
138 |
|
|
& dim, dn, ib, ie, myThid) |
139 |
|
|
regrid_vname(1:NLEN) = dn_blnk(1:NLEN) |
140 |
|
|
write(regrid_vname,'(a,a)') 'regrid_', vname |
141 |
|
|
CALL MNC_CW_ADD_VNAME(regrid_vname, d_cw_name, |
142 |
|
|
& 0,0, myThid) |
143 |
|
|
C CALL MNC_CW_ADD_VATTR_TEXT(vname,'units','-',myThid) |
144 |
|
|
|
145 |
|
|
ENDIF |
146 |
|
|
|
147 |
|
|
#ifdef ALLOW_USE_MPI |
148 |
|
|
ENDIF |
149 |
|
|
#endif /* ALLOW_USE_MPI */ |
150 |
|
|
_END_MASTER( myThid ) |
151 |
|
|
_BARRIER |
152 |
|
|
#endif /* ALLOW_MNC */ |
153 |
|
|
|
154 |
|
|
C ============================================= |
155 |
|
|
C Empty the per-thread vectors for all possible threads |
156 |
|
|
_BEGIN_MASTER( myThid ) |
157 |
|
|
DO bj = 1,nSy |
158 |
|
|
DO bi = 1,nSx |
159 |
|
|
DO ind = 1,regrid_nout(igout) |
160 |
|
|
ptsums( ind, bi,bj ) = 0. _d 0 |
161 |
|
|
ENDDO |
162 |
|
|
ENDDO |
163 |
|
|
ENDDO |
164 |
|
|
_END_MASTER( myThid ) |
165 |
|
|
_BARRIER |
166 |
|
|
|
167 |
|
|
C ============================================= |
168 |
|
|
C Compute the distributed sparse matrix multiply |
169 |
|
|
DO iz = 1,nz |
170 |
|
|
|
171 |
|
|
DO bj = myByLo(myThid), myByHi(myThid) |
172 |
|
|
DO bi = myBxLo(myThid), myBxHi(myThid) |
173 |
|
|
|
174 |
|
|
DO ind = 1,regrid_nout(igout) |
175 |
|
|
ptsums( ind, bi,bj ) = 0. _d 0 |
176 |
|
|
ENDDO |
177 |
|
|
|
178 |
|
|
C Compute the per-thread partial sums |
179 |
|
|
DO ind = regrid_ibeg(igout,bi,bj),regrid_iend(igout,bi,bj) |
180 |
|
|
ptsums( regrid_i_out(ind,bi,bj), bi,bj ) = |
181 |
|
|
& ptsums( regrid_i_out(ind,bi,bj), bi,bj ) |
182 |
|
|
& + regrid_amat(ind,bi,bj) |
183 |
|
|
& * var( regrid_i_loc(ind,bi,bj), |
184 |
|
|
& regrid_j_loc(ind,bi,bj), izlev(iz), bi,bj) |
185 |
|
|
ENDDO |
186 |
|
|
|
187 |
|
|
C Sum over all threads and MPI processes |
188 |
|
|
nval = regrid_nout(igout) |
189 |
|
|
|
190 |
|
|
ENDDO |
191 |
|
|
ENDDO |
192 |
|
|
|
193 |
|
|
_BARRIER |
194 |
|
|
|
195 |
|
|
#ifdef RX_IS_REAL4 |
196 |
|
|
CALL GLOBAL_VEC_SUM_R4( REGRID_NELEM_MAX,nval,ptsums,myThid ) |
197 |
|
|
#endif |
198 |
|
|
#ifdef RX_IS_REAL8 |
199 |
|
|
CALL GLOBAL_VEC_SUM_R8( REGRID_NELEM_MAX,nval,ptsums,myThid ) |
200 |
|
|
#endif |
201 |
|
|
|
202 |
|
|
C At this point, we have the global sum. The master thread of the |
203 |
|
|
C lead MPI process should now write the output. |
204 |
|
|
_BEGIN_MASTER( myThid ) |
205 |
|
|
#ifdef ALLOW_USE_MPI |
206 |
|
|
IF ( mpiMyId .EQ. 0 ) THEN |
207 |
|
|
#endif /* ALLOW_USE_MPI */ |
208 |
|
|
|
209 |
|
|
bi = myBxLo(myThid) |
210 |
|
|
bj = myByLo(myThid) |
211 |
|
|
offsets(2) = iz |
212 |
|
|
CALL MNC_CW_RL_W_OFFSET('D',mnc_bname,1,1, |
213 |
|
|
& regrid_vname, ptsums(1,bi,bj), offsets, myThid) |
214 |
|
|
|
215 |
|
|
#ifdef ALLOW_USE_MPI |
216 |
|
|
ENDIF |
217 |
|
|
#endif /* ALLOW_USE_MPI */ |
218 |
|
|
_END_MASTER( myThid ) |
219 |
|
|
_BARRIER |
220 |
|
|
|
221 |
|
|
ENDDO /* iz */ |
222 |
|
|
|
223 |
|
|
CALL MNC_CW_DEL_VNAME(regrid_vname, myThid) |
224 |
|
|
CALL MNC_CW_DEL_GNAME(d_cw_name, myThid) |
225 |
|
|
|
226 |
|
|
RETURN |
227 |
|
|
END |
228 |
|
|
|
229 |
|
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |