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

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

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


Revision 1.8 - (show annotations) (download)
Tue May 24 22:41:57 2011 UTC (12 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint63, checkpoint62z, checkpoint62y
Changes since 1.7: +4 -5 lines
include "GRDCHK_OPTIONS.h" instead of "CTRL_CPPOPTIONS.h"

1 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_get_obcs_mask.F,v 1.7 2011/03/07 09:24:28 mlosch Exp $
2 C $Name: $
3
4 #include "GRDCHK_OPTIONS.h"
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_GRDCHK) && 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 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
48 _RL tmpfldxz (1-olx:snx+olx,nr,nsx,nsy)
49 #endif
50 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
51 _RL tmpfldyz (1-oly:sny+oly,nr,nsx,nsy)
52 #endif
53
54 character*( 80) fname
55
56 c == external ==
57
58 integer ilnblnk
59 external ilnblnk
60
61 c == end of interface ==
62
63 jtlo = 1
64 jthi = nsy
65 itlo = 1
66 ithi = nsx
67 jmin = 1
68 jmax = sny
69 imin = 1
70 imax = snx
71
72 _BEGIN_MASTER( mythid )
73
74 if ( grdchkvarindex .EQ. 11 ) then
75 #ifdef ALLOW_OBCSN_CONTROL
76 write(fname(1:80),'(80a)') ' '
77 write(fname(1:80),'(a)') 'maskobcsn'
78 c
79 do iobcs = 1,nobcs
80 call active_read_xz( fname, tmpfldxz, iobcs,
81 & .false., .false., 0, mythid, dummy)
82 c
83 do bj = jtlo,jthi
84 do bi = itlo,ithi
85 do k = 1,nr
86 do i = imin,imax
87 grdchk_maskxz(i,k,bi,bj,iobcs) =
88 & tmpfldxz(i,k,bi,bj)
89 enddo
90 enddo
91 enddo
92 enddo
93 c
94 enddo
95 #endif
96
97 else if ( grdchkvarindex .EQ. 12 ) then
98 #ifdef ALLOW_OBCSS_CONTROL
99 write(fname(1:80),'(80a)') ' '
100 write(fname(1:80),'(a)') 'maskobcss'
101 c
102 do iobcs = 1,nobcs
103 call active_read_xz( fname, tmpfldxz, iobcs,
104 & .false., .false., 0, mythid, dummy)
105 c
106 do bj = jtlo,jthi
107 do bi = itlo,ithi
108 do k = 1,nr
109 do i = imin,imax
110 grdchk_maskxz(i,k,bi,bj,iobcs) =
111 & tmpfldxz(i,k,bi,bj)
112 enddo
113 enddo
114 enddo
115 enddo
116 c
117 enddo
118 #endif
119
120 else if ( grdchkvarindex .EQ. 13 ) then
121 #ifdef ALLOW_OBCSW_CONTROL
122 write(fname(1:80),'(80a)') ' '
123 write(fname(1:80),'(a)') 'maskobcsw'
124 c
125 do iobcs = 1,nobcs
126 call active_read_yz( fname, tmpfldyz, iobcs,
127 & .false., .false., 0, mythid, dummy)
128 c
129 do bj = jtlo,jthi
130 do bi = itlo,ithi
131 do k = 1,nr
132 do j = jmin,jmax
133 grdchk_maskyz(j,k,bi,bj,iobcs) =
134 & tmpfldyz(j,k,bi,bj)
135 enddo
136 enddo
137 enddo
138 enddo
139 c
140 enddo
141 #endif
142
143 else if ( grdchkvarindex .EQ. 14 ) then
144 #ifdef ALLOW_OBCSE_CONTROL
145 write(fname(1:80),'(80a)') ' '
146 write(fname(1:80),'(a)') 'maskobcse'
147 c
148 do iobcs = 1,nobcs
149 call active_read_yz( fname, tmpfldyz, iobcs,
150 & .false., .false., 0, mythid, dummy)
151 c
152 do bj = jtlo,jthi
153 do bi = itlo,ithi
154 do k = 1,nr
155 do j = jmin,jmax
156 grdchk_maskyz(j,k,bi,bj,iobcs) =
157 & tmpfldyz(j,k,bi,bj)
158 enddo
159 enddo
160 enddo
161 enddo
162 c
163 enddo
164 #endif
165 endif
166
167 _END_MASTER( mythid )
168
169 _BARRIER
170
171 #endif /* ALLOW_GRDCHK */
172
173 return
174 end

  ViewVC Help
Powered by ViewVC 1.1.22