/[MITgcm]/MITgcm/pkg/ctrl/ctrl_mask_set_xz.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_mask_set_xz.F

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

revision 1.1 by heimbach, Tue Feb 5 20:23:58 2002 UTC revision 1.2 by heimbach, Sat Jul 13 02:47:32 2002 UTC
# Line 0  Line 1 
1    
2    #include "CTRL_CPPOPTIONS.h"
3    
4    
5          subroutine ctrl_mask_set_xz(
6         &     jp1, OB_J, nwetobcs, ymaskobcs, mythid )
7    
8    c     ==================================================================
9    c     SUBROUTINE ctrl_mask_set_xz
10    c     ==================================================================
11    c
12    c     o count sliced (xz) wet points and set xz masks
13    c    
14    c     heimbach@mit.edu, 30-Aug-2001
15    c     gebbie@mit.edu, corrected array bounds
16    c
17    c     ==================================================================
18    
19          implicit none
20    
21    c     == global variables ==
22    
23    #include "EEPARAMS.h"
24    #include "SIZE.h"
25    #include "PARAMS.h"
26    #include "GRID.h"
27    
28    #include "ctrl.h"
29    #ifdef ALLOW_OBCS_CONTROL
30    # include "OBCS.h"
31    #endif
32    
33    c     == routine arguments ==
34    
35          integer jp1
36          integer OB_J     (1-olx:snx+olx,nsx,nsy)
37          integer nwetobcs (nsx,nsy,nr,nobcs)
38          character*(80)   ymaskobcs
39          integer mythid
40    
41    c     == local variables ==
42    
43          integer bi,bj
44          integer i,j,k
45          integer itlo,ithi
46          integer jtlo,jthi
47          integer jmin,jmax
48          integer imin,imax
49          integer ntmp
50          integer ivarindex
51    
52          integer iobcs
53          integer il
54          integer errio
55          integer startrec
56          integer endrec
57          integer difftime(4)
58          _RL     diffsecs
59          _RL     dummy
60          _RL     maskxz   (1-olx:snx+olx,nr,nsx,nsy,nobcs)
61          _RL     gg       (1-olx:snx+olx,nr,nsx,nsy)
62    
63          character*( 80)   fname
64    
65    c     == external ==
66    
67          integer  ilnblnk
68          external ilnblnk
69    
70    c     == end of interface ==
71    
72          jtlo = mybylo(mythid)
73          jthi = mybyhi(mythid)
74          itlo = mybxlo(mythid)
75          ithi = mybxhi(mythid)
76          jmin = 1
77          jmax = sny
78          imin = 1
79          imax = snx
80    
81          _BEGIN_MASTER( myThid )
82    
83    c--   Count wet points at Northern boundary.
84    c--   mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
85          do bj = jtlo,jthi
86            do bi = itlo,ithi
87              do k = 1,nr
88                do i = imin,imax
89                  do iobcs = 1,nobcs
90                    maskxz(i,k,bi,bj,iobcs) = 0. _d 0
91                  enddo
92                enddo
93              enddo
94            enddo
95          enddo
96    
97          do bj = jtlo,jthi
98            do bi = itlo,ithi
99              do k = 1,nr
100                do i = imin,imax
101                  j = OB_J(I,bi,bj)
102                    if ( j .NE. 0 ) then
103    c--               South mask for T, S
104                      if (maskS(i,j+jp1,k,bi,bj) .ne. 0.) then
105                        nwetobcs(bi,bj,k,1) = nwetobcs(bi,bj,k,1) + 1
106                        nwetobcs(bi,bj,k,2) = nwetobcs(bi,bj,k,2) + 1
107                        maskxz(i,k,bi,bj,1)  = 1
108                        maskxz(i,k,bi,bj,2)  = 1
109                      endif
110    c--               West mask for U
111                      if (maskW(i,j,k,bi,bj) .eq. 1.) then
112                        nwetobcs(bi,bj,k,3) = nwetobcs(bi,bj,k,3) + 1
113                        maskxz(i,k,bi,bj,3)  = 1
114                      endif
115    c--               South mask for V
116                      if (maskS(i,j+jp1,k,bi,bj) .eq. 1.) then
117                        nwetobcs(bi,bj,k,4) = nwetobcs(bi,bj,k,4) + 1
118                        maskxz(i,k,bi,bj,4)  = 1
119                      endif
120                    endif
121                enddo
122              enddo
123            enddo
124          enddo
125    
126          il=ilnblnk( ymaskobcs )
127          write(fname(1:80),'(80a)') ' '
128          write(fname(1:80),'(a)') ymaskobcs
129    
130          do iobcs = 1,nobcs
131            do bj = jtlo,jthi
132              do bi = itlo,ithi
133                do k = 1,nr
134                  do i = imin,imax
135                     gg(i,k,bi,bj) = maskxz(i,k,bi,bj,iobcs)
136                  enddo
137                enddo
138              enddo
139            enddo
140            call active_write_xz( fname, gg, iobcs, 0, mythid, dummy )
141    
142          enddo
143    
144          _END_MASTER( mythid )
145    
146          return
147          end
148    
149    
150    
151    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22