/[MITgcm]/MITgcm/pkg/grdchk/grdchk_loc.F
ViewVC logotype

Diff of /MITgcm/pkg/grdchk/grdchk_loc.F

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

revision 1.5 by heimbach, Fri Feb 28 02:34:56 2003 UTC revision 1.6 by heimbach, Tue Jun 24 16:08:45 2003 UTC
# Line 10  C $Header$ Line 10  C $Header$
10       O                     itile,       O                     itile,
11       O                     jtile,       O                     jtile,
12       O                     layer,       O                     layer,
13         O                     obcspos,
14       O                     itilepos,       O                     itilepos,
15       O                     jtilepos,       O                     jtilepos,
16       O                     itest,       O                     itest,
# Line 49  c     == routine arguments == Line 50  c     == routine arguments ==
50        integer       jtile        integer       jtile
51        integer       itile        integer       itile
52        integer       layer        integer       layer
53          integer       obcspos
54        integer       itilepos        integer       itilepos
55        integer       jtilepos        integer       jtilepos
56        integer       itest        integer       itest
# Line 60  c     == local variables == Line 62  c     == local variables ==
62    
63        integer bi,bj        integer bi,bj
64        integer i,j,k        integer i,j,k
65          integer iobcs
66        integer biwrk,bjwrk        integer biwrk,bjwrk
67        integer iwrk, jwrk, kwrk        integer iwrk, jwrk, kwrk
68          integer iobcswrk
69        integer irec, irecwrk        integer irec, irecwrk
70        integer itlo,ithi        integer itlo,ithi
71        integer jtlo,jthi        integer jtlo,jthi
72        integer jmin,jmax        integer jmin,jmax
73        integer imin,imax        integer imin,imax
74        integer icomptest        integer icomptest
75          integer nobcsmax
76    
77  c     == end of interface ==  c     == end of interface ==
78    
# Line 89  c     initialise parameters Line 94  c     initialise parameters
94         if ( icomp .le. ncvarcomp ) then         if ( icomp .le. ncvarcomp ) then
95  c--     A valid component of the control variable has been selected.  c--     A valid component of the control variable has been selected.
96           if ( ichknum .EQ. 1 ) then           if ( ichknum .EQ. 1 ) then
97            itest     = 0              itest     = 0
98            icomptest = 0              icomptest = 0
99            irecwrk   = 1              irecwrk   = 1
100            bjwrk     = 1              bjwrk     = 1
101            biwrk     = 1              biwrk     = 1
102            kwrk      = 1              kwrk      = 1
103            jwrk      = 1              iobcswrk  = 1
104            iwrk      = 1              jwrk      = 1
105                iwrk      = 1
106           else           else
107            itest     = itestmem(ichknum-1)              itest     = itestmem (ichknum-1)
108            icomptest = icompmem(ichknum-1)              icomptest = icompmem (ichknum-1)
109            irecwrk   = irecmem(ichknum-1)              irecwrk   = irecmem  (ichknum-1)
110            bjwrk     = bjmem  (ichknum-1)              bjwrk     = bjmem    (ichknum-1)
111            biwrk     = bimem  (ichknum-1)              biwrk     = bimem    (ichknum-1)
112            kwrk      = klocmem(ichknum-1)              kwrk      = klocmem  (ichknum-1)
113            jwrk      = jlocmem(ichknum-1)              iobcswrk  = iobcsmem (ichknum-1)
114            iwrk      = ilocmem(ichknum-1)              jwrk      = jlocmem  (ichknum-1)
115            iwrk      = iwrk + 1              iwrk      = ilocmem  (ichknum-1)
116                iwrk      = iwrk + 1
117           end if           end if
118    
119    c--   set max loop index for obcs multiplicities
120            if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
121               nobcsmax = nobcs
122            else
123               nobcsmax = 1
124            endif
125    
126  c--   Start to loop over records.  c--   Start to loop over records.
127          do irec = irecwrk, ncvarrecs(grdchkvarindex)          do irec = irecwrk, ncvarrecs(grdchkvarindex)
128           do bj = bjwrk, jthi           do bj = bjwrk, jthi
129            do bi = biwrk, ithi            do bi = biwrk, ithi
130             do k = kwrk, ncvarnrmax(grdchkvarindex)             do k = kwrk, ncvarnrmax(grdchkvarindex)
131                do iobcs = iobcswrk, nobcsmax
132    
133              if ( (ierr .ne. 0) .and.               if ( (ierr .ne. 0) .and.
134       &           (icomp .gt. itest) .and.       &              (icomp .gt. itest) .and.
135       &           (icomp .le. itest + nwettile(bi,bj,k))) then       &              (icomp .le. itest + nwettile(bi,bj,k,iobcs))) then
136                 icvrec = irec                 icvrec = iobcs + (irec-1)*nobcsmax
137                 itile  = bi                 itile  = bi
138                 jtile  = bj                 jtile  = bj
139    
140                 do j = jwrk, sny                 do j = jwrk, ncvarymax(grdchkvarindex)
141                  do i = iwrk, snx                  do i = iwrk, ncvarxmax(grdchkvarindex)
142                   if (ierr .ne. 0) then                   if (ierr .ne. 0) then
143                    if ( ncvargrd(grdchkvarindex) .eq. 'c' ) then                    if ( ncvargrd(grdchkvarindex) .eq. 'c' ) then
144                       if ( maskC(i,j,k,bi,bj) .gt. 0.) then                       if ( maskC(i,j,k,bi,bj) .gt. 0.) then
# Line 137  c--   Start to loop over records. Line 152  c--   Start to loop over records.
152                       if ( _maskW(i,j,k,bi,bj) .gt. 0.) then                       if ( _maskW(i,j,k,bi,bj) .gt. 0.) then
153                          icomptest = icomptest + 1                          icomptest = icomptest + 1
154                       endif                       endif
155                      else if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
156                         if ( grdchkvarindex .EQ. 11 ) then
157    #ifdef ALLOW_OBCSN_CONTROL
158                            if (grdchk_maskxz(i,k,bi,bj,iobcs) .gt. 0.) then
159                               icomptest = icomptest + 1
160                            endif
161    #endif
162                         else if ( grdchkvarindex .EQ. 12 ) then
163    #ifdef ALLOW_OBCSS_CONTROL
164                            if (grdchk_maskxz(i,k,bi,bj,iobcs) .gt. 0.) then
165                               icomptest = icomptest + 1
166                            endif
167    #endif
168                         else if ( grdchkvarindex .EQ. 13 ) then
169    #ifdef ALLOW_OBCSW_CONTROL
170                            if (grdchk_maskyz(j,k,bi,bj,iobcs) .gt. 0.) then
171                               icomptest = icomptest + 1
172                            endif
173    #endif
174                         else if ( grdchkvarindex .EQ. 14 ) then
175    #ifdef ALLOW_OBCSE_CONTROL
176                            if (grdchk_maskyz(j,k,bi,bj,iobcs) .gt. 0.) then
177                               icomptest = icomptest + 1
178                            endif
179    #endif
180                         endif
181                    endif                    endif
182                    if ( icomp .eq. icomptest ) then                    if ( icomp .eq. icomptest ) then
183                       itilepos = i                       itilepos = i
184                       jtilepos = j                       jtilepos = j
185                       layer    = k                       layer    = k
186                         obcspos  = iobcs
187                       ierr     = 0                       ierr     = 0
188                    endif                    endif
189                   endif                   endif
# Line 149  c--   Start to loop over records. Line 191  c--   Start to loop over records.
191                  iwrk = 1                  iwrk = 1
192                 enddo                 enddo
193                 jwrk = 1                 jwrk = 1
194                else if (ierr .NE. 0) then               else if (ierr .NE. 0) then
195                   itest     = itest + nwettile(bi,bj,k)                  itest     = itest + nwettile(bi,bj,k,iobcs)
196                   iwrk      = 1                  iwrk      = 1
197                   jwrk      = 1                  jwrk      = 1
198                else               else
199  c  c
200                endif               endif
201  c--   End of loop over k  c--   End of loop over iobcs
202               enddo               enddo
203               kwrk = 1               iobcswrk = 1
204  c--   End of loop over bi  c--   End of loop over k
205              enddo              enddo
206              biwrk = 1              kwrk = 1
207  c--   End of loop over bj  c--   End of loop over bi
208             enddo             enddo
209             bjwrk = 1             biwrk = 1
210  c--   End of loop over records.  c--   End of loop over bj
211            enddo            enddo
212            else            bjwrk = 1
213    c--   End of loop over records.
214             enddo
215            else
216              if ( icomp .gt. maxncvarcomps ) then              if ( icomp .gt. maxncvarcomps ) then
217  c--           Such a component does not exist.  c--           Such a component does not exist.
218                ierr     = -4                ierr     = -4
# Line 175  c--           Such a component does not Line 220  c--           Such a component does not
220                jtile    = -1                jtile    = -1
221                itile    = -1                itile    = -1
222                layer    = -1                layer    = -1
223                  obcspos  = -1
224                jtilepos = -1                jtilepos = -1
225                itilepos = -1                itilepos = -1
226              else              else
# Line 184  c--           The component is a land po Line 230  c--           The component is a land po
230                jtile    = -1                jtile    = -1
231                itile    = -1                itile    = -1
232                layer    = -1                layer    = -1
233                  obcspos  = -1
234                jtilepos = -1                jtilepos = -1
235                itilepos = -1                itilepos = -1
236              endif              endif
237            endif          endif
238          else         else
239            if ( icomp .lt. 0 ) then            if ( icomp .lt. 0 ) then
240  c--         Such a component does not exist.  c--         Such a component does not exist.
241              ierr     = -2              ierr     = -2
# Line 196  c--         Such a component does not ex Line 243  c--         Such a component does not ex
243              jtile    = -1              jtile    = -1
244              itile    = -1              itile    = -1
245              layer    = -1              layer    = -1
246                obcspos  = -1
247              jtilepos = -1              jtilepos = -1
248              itilepos = -1              itilepos = -1
249            else            else
# Line 205  c--         Component zero. Line 253  c--         Component zero.
253              jtile    = -1              jtile    = -1
254              itile    = -1              itile    = -1
255              layer    = -1              layer    = -1
256                obcspos  = -1
257              jtilepos = -1              jtilepos = -1
258              itilepos = -1              itilepos = -1
259            endif            endif
260          endif         endif
261    
262        _END_MASTER( mythid )        _END_MASTER( mythid )
263    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22