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

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

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

revision 1.1 by heimbach, Sat Jun 21 23:45:52 2003 UTC revision 1.2 by heimbach, Tue Jun 24 16:08:45 2003 UTC
# Line 0  Line 1 
1    C $Header$
2    
3    #include "CTRL_CPPOPTIONS.h"
4    
5    
6          subroutine grdchk_get_obcs_mask( mythid )
7    
8    c     ==================================================================
9    c     SUBROUTINE grdchk_get_obcs_mask
10    c     ==================================================================
11    c
12    c     o Get obcs masks from file
13    c
14    c     started: heimbach@mit.edu: 22-Apr-2003
15    c
16    c     ==================================================================
17    c     SUBROUTINE grdchk_get_obcs_mask
18    c     ==================================================================
19    
20          implicit none
21    
22    c     == global variables ==
23    
24    #include "EEPARAMS.h"
25    #include "SIZE.h"
26    #include "GRID.h"
27    #include "ctrl.h"
28    #include "grdchk.h"
29    
30    c     == routine arguments ==
31    
32          integer mythid
33    
34    #if (defined (ALLOW_GRADIENT_CHECK) && defined (ALLOW_OBCS_CONTROL))
35    c     == local variables ==
36    
37          integer bi,bj
38          integer i,j,k
39          integer irec,iobcs
40          integer itlo,ithi
41          integer jtlo,jthi
42          integer jmin,jmax
43          integer imin,imax
44          
45          _RL dummy
46    
47          character*( 80) fname
48    
49    c     == external ==
50    
51          integer  ilnblnk
52          external ilnblnk
53    
54    c     == end of interface ==
55    
56          jtlo = 1
57          jthi = nsy
58          itlo = 1
59          ithi = nsx
60          jmin = 1
61          jmax = sny
62          imin = 1
63          imax = snx
64    
65          _BEGIN_MASTER( mythid )
66    
67    #ifdef ALLOW_OBCSN_CONTROL
68          write(fname(1:80),'(80a)') ' '
69          write(fname(1:80),'(a)') 'maskobcsn'
70    c
71          do iobcs = 1,nobcs
72             call active_read_xz(  fname, tmpfldxz, iobcs,
73         &        .false., .false., 0, mythid, dummy)
74    c
75             do bj = jtlo,jthi
76                do bi = itlo,ithi
77                   do k = 1,nr
78                      do i = imin,imax
79                         grdchk_maskxz(i,k,bi,bj,iobcs) =
80         &                    tmpfldxz(i,k,bi,bj)
81                      enddo
82                   enddo
83                enddo
84             enddo
85    c
86          enddo
87    #endif
88    
89    #ifdef ALLOW_OBCSS_CONTROL
90          write(fname(1:80),'(80a)') ' '
91          write(fname(1:80),'(a)') 'maskobcss'
92    c
93          do iobcs = 1,nobcs
94             call active_read_xz(  fname, tmpfldxz, iobcs,
95         &        .false., .false., 0, mythid, dummy)
96    c
97             do bj = jtlo,jthi
98                do bi = itlo,ithi
99                   do k = 1,nr
100                      do i = imin,imax
101                         grdchk_maskxz(i,k,bi,bj,iobcs) =
102         &                    tmpfldxz(i,k,bi,bj)
103                      enddo
104                   enddo
105                enddo
106             enddo
107    c
108          enddo
109    #endif
110    
111    #ifdef ALLOW_OBCSW_CONTROL
112          write(fname(1:80),'(80a)') ' '
113          write(fname(1:80),'(a)') 'maskobcsw'
114    c
115          do iobcs = 1,nobcs
116             call active_read_yz(  fname, tmpfldyz, iobcs,
117         &        .false., .false., 0, mythid, dummy)
118    c
119             do bj = jtlo,jthi
120                do bi = itlo,ithi
121                   do k = 1,nr
122                      do j = jmin,jmax
123                         grdchk_maskyz(j,k,bi,bj,iobcs) =
124         &                    tmpfldyz(j,k,bi,bj)
125                      enddo
126                   enddo
127                enddo
128             enddo
129    c
130          enddo
131    #endif
132    
133    #ifdef ALLOW_OBCSE_CONTROL
134          write(fname(1:80),'(80a)') ' '
135          write(fname(1:80),'(a)') 'maskobcse'
136    c
137          do iobcs = 1,nobcs
138             call active_read_yz(  fname, tmpfldyz, iobcs,
139         &        .false., .false., 0, mythid, dummy)
140    c
141             do bj = jtlo,jthi
142                do bi = itlo,ithi
143                   do k = 1,nr
144                      do j = jmin,jmax
145                         grdchk_maskyz(j,k,bi,bj,iobcs) =
146         &                    tmpfldyz(j,k,bi,bj)
147                      enddo
148                   enddo
149                enddo
150             enddo
151    c
152          enddo
153    #endif
154    
155          _END_MASTER( mythid )
156    
157          _BARRIER
158    
159    #endif /* ALLOW_GRADIENT_CHECK */
160    
161          end
162    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22