Check for consistency between the duplicated points of a 2-D C-grid vector.
136 character(len=*),
intent(in) :: mesg
137 type(ocean_grid_type),
intent(inout) :: G
138 real,
dimension(G%IsdB:,G%jsd:),
intent(in) :: u_comp
140 real,
dimension(G%isd:,G%JsdB:),
intent(in) :: v_comp
142 integer,
optional,
intent(in) :: is
143 integer,
optional,
intent(in) :: ie
144 integer,
optional,
intent(in) :: js
145 integer,
optional,
intent(in) :: je
146 integer,
optional,
intent(in) :: direction
149 real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed)
150 real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed)
151 real :: u_resym(G%IsdB:G%IedB,G%jsd:G%jed)
152 real :: v_resym(G%isd:G%ied,G%JsdB:G%JedB)
153 character(len=128) :: mesg2
154 integer :: i, j, is_ch, ie_ch, js_ch, je_ch
155 integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
157 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
158 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
159 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
161 if (.not.(
present(is) .or.
present(ie) .or.
present(js) .or.
present(je)))
then
163 if ((isd == isdb) .and. (jsd == jsdb))
return
166 do i=isd,ied ;
do j=jsd,jed
167 u_nonsym(i,j) = u_comp(i,j) ; v_nonsym(i,j) = v_comp(i,j)
170 if (.not.
associated(g%Domain_aux))
call mom_error(fatal,
" check_redundant"//&
171 " called with a non-associated auxiliary domain the grid type.")
172 call pass_vector(u_nonsym, v_nonsym, g%Domain_aux, direction)
174 do i=isdb,iedb ;
do j=jsd,jed ; u_resym(i,j) = u_comp(i,j) ;
enddo ;
enddo
175 do i=isd,ied ;
do j=jsdb,jedb ; v_resym(i,j) = v_comp(i,j) ;
enddo ;
enddo
176 do i=isd,ied ;
do j=jsd,jed
177 u_resym(i,j) = u_nonsym(i,j) ; v_resym(i,j) = v_nonsym(i,j)
179 call pass_vector(u_resym, v_resym, g%Domain, direction)
181 is_ch = isq ; ie_ch = ieq ; js_ch = jsq ; je_ch = jeq
182 if (
present(is)) is_ch = is ;
if (
present(ie)) ie_ch = ie
183 if (
present(js)) js_ch = js ;
if (
present(js)) je_ch = je
185 do i=is_ch,ie_ch ;
do j=js_ch+1,je_ch
186 if (u_resym(i,j) /= u_comp(i,j) .and. &
187 redundant_prints(3) < max_redundant_prints)
then
188 write(mesg2,
'(" redundant u-components",2(1pe12.4)," differ by ", &
189 & 1pe12.4," at i,j = ",2i4," on pe ",i4)') &
190 u_comp(i,j), u_resym(i,j),u_comp(i,j)-u_resym(i,j),i,j,pe_here()
191 write(0,
'(A130)') trim(mesg)//trim(mesg2)
192 redundant_prints(3) = redundant_prints(3) + 1
195 do i=is_ch+1,ie_ch ;
do j=js_ch,je_ch
196 if (v_resym(i,j) /= v_comp(i,j) .and. &
197 redundant_prints(3) < max_redundant_prints)
then
198 write(mesg2,
'(" redundant v-comps",2(1pe12.4)," differ by ", &
199 & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)" on pe ",i4)') &
200 v_comp(i,j), v_resym(i,j),v_comp(i,j)-v_resym(i,j),i,j, &
201 g%geoLonBu(i,j), g%geoLatBu(i,j), pe_here()
202 write(0,
'(A155)') trim(mesg)//trim(mesg2)
203 redundant_prints(3) = redundant_prints(3) + 1