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

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

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

Revision 1.10 - (hide annotations) (download)
Thu Oct 9 00:50:54 2014 UTC (9 years, 8 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65f, checkpoint65g, HEAD
Changes since 1.9: +2 -1 lines 
- pkg/grdchk/grdchk_get_obcs_mask.F, grdchk_get_position.F,
  grdchk_getadxx.F, grdchk_getxx.F, grdchk_init.F, grdchk_loc.F,
  grdchk_setxx.F : add CTRL_OBCS.h
1 gforget 1.10 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_get_obcs_mask.F,v 1.9 2014/04/04 21:39:56 jmc Exp $
2 jmc 1.6 C $Name: $
3 heimbach 1.2
4 jmc 1.8 #include "GRDCHK_OPTIONS.h"
5 jmc 1.9 #ifdef ALLOW_CTRL
6     # include "CTRL_OPTIONS.h"
7     #endif
8 heimbach 1.2
9     subroutine grdchk_get_obcs_mask( mythid )
10    
11     c ==================================================================
12     c SUBROUTINE grdchk_get_obcs_mask
13     c ==================================================================
14     c
15     c o Get obcs masks from file
16     c
17     c started: heimbach@mit.edu: 22-Apr-2003
18     c
19     c ==================================================================
20     c SUBROUTINE grdchk_get_obcs_mask
21     c ==================================================================
22    
23     implicit none
24    
25     c == global variables ==
26    
27     #include "EEPARAMS.h"
28     #include "SIZE.h"
29     #include "GRID.h"
30     #include "ctrl.h"
31 gforget 1.10 #include "CTRL_OBCS.h"
32 heimbach 1.2 #include "grdchk.h"
33    
34     c == routine arguments ==
35    
36     integer mythid
37    
38 heimbach 1.4 #if (defined (ALLOW_GRDCHK) && defined (ALLOW_OBCS_CONTROL))
39 heimbach 1.2 c == local variables ==
40    
41     integer bi,bj
42     integer i,j,k
43     integer irec,iobcs
44     integer itlo,ithi
45     integer jtlo,jthi
46     integer jmin,jmax
47     integer imin,imax
48 jmc 1.6
49 heimbach 1.2 _RL dummy
50    
51 mlosch 1.7 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
52     _RL tmpfldxz (1-olx:snx+olx,nr,nsx,nsy)
53 jmc 1.8 #endif
54 mlosch 1.7 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
55     _RL tmpfldyz (1-oly:sny+oly,nr,nsx,nsy)
56     #endif
57    
58 heimbach 1.2 character*( 80) fname
59    
60     c == external ==
61    
62     integer ilnblnk
63     external ilnblnk
64    
65     c == end of interface ==
66    
67     jtlo = 1
68     jthi = nsy
69     itlo = 1
70     ithi = nsx
71     jmin = 1
72     jmax = sny
73     imin = 1
74     imax = snx
75    
76     _BEGIN_MASTER( mythid )
77    
78 heimbach 1.3 if ( grdchkvarindex .EQ. 11 ) then
79 heimbach 1.2 #ifdef ALLOW_OBCSN_CONTROL
80     write(fname(1:80),'(80a)') ' '
81     write(fname(1:80),'(a)') 'maskobcsn'
82     c
83     do iobcs = 1,nobcs
84 heimbach 1.5 call active_read_xz( fname, tmpfldxz, iobcs,
85 heimbach 1.2 & .false., .false., 0, mythid, dummy)
86     c
87     do bj = jtlo,jthi
88     do bi = itlo,ithi
89     do k = 1,nr
90     do i = imin,imax
91 jmc 1.6 grdchk_maskxz(i,k,bi,bj,iobcs) =
92 heimbach 1.2 & tmpfldxz(i,k,bi,bj)
93     enddo
94     enddo
95     enddo
96     enddo
97     c
98     enddo
99     #endif
100    
101 heimbach 1.3 else if ( grdchkvarindex .EQ. 12 ) then
102 heimbach 1.2 #ifdef ALLOW_OBCSS_CONTROL
103     write(fname(1:80),'(80a)') ' '
104     write(fname(1:80),'(a)') 'maskobcss'
105     c
106     do iobcs = 1,nobcs
107 heimbach 1.5 call active_read_xz( fname, tmpfldxz, iobcs,
108 heimbach 1.2 & .false., .false., 0, mythid, dummy)
109     c
110     do bj = jtlo,jthi
111     do bi = itlo,ithi
112     do k = 1,nr
113     do i = imin,imax
114 jmc 1.6 grdchk_maskxz(i,k,bi,bj,iobcs) =
115 heimbach 1.2 & tmpfldxz(i,k,bi,bj)
116     enddo
117     enddo
118     enddo
119     enddo
120     c
121     enddo
122     #endif
123    
124 heimbach 1.3 else if ( grdchkvarindex .EQ. 13 ) then
125 heimbach 1.2 #ifdef ALLOW_OBCSW_CONTROL
126     write(fname(1:80),'(80a)') ' '
127     write(fname(1:80),'(a)') 'maskobcsw'
128     c
129     do iobcs = 1,nobcs
130 heimbach 1.5 call active_read_yz( fname, tmpfldyz, iobcs,
131 heimbach 1.2 & .false., .false., 0, mythid, dummy)
132     c
133     do bj = jtlo,jthi
134     do bi = itlo,ithi
135     do k = 1,nr
136     do j = jmin,jmax
137 jmc 1.6 grdchk_maskyz(j,k,bi,bj,iobcs) =
138 heimbach 1.2 & tmpfldyz(j,k,bi,bj)
139     enddo
140     enddo
141     enddo
142     enddo
143     c
144     enddo
145     #endif
146    
147 heimbach 1.3 else if ( grdchkvarindex .EQ. 14 ) then
148 heimbach 1.2 #ifdef ALLOW_OBCSE_CONTROL
149     write(fname(1:80),'(80a)') ' '
150     write(fname(1:80),'(a)') 'maskobcse'
151     c
152     do iobcs = 1,nobcs
153 heimbach 1.5 call active_read_yz( fname, tmpfldyz, iobcs,
154 heimbach 1.2 & .false., .false., 0, mythid, dummy)
155     c
156     do bj = jtlo,jthi
157     do bi = itlo,ithi
158     do k = 1,nr
159     do j = jmin,jmax
160 jmc 1.6 grdchk_maskyz(j,k,bi,bj,iobcs) =
161 heimbach 1.2 & tmpfldyz(j,k,bi,bj)
162     enddo
163     enddo
164     enddo
165     enddo
166     c
167     enddo
168     #endif
169 heimbach 1.3 endif
170 heimbach 1.2
171     _END_MASTER( mythid )
172    
173     _BARRIER
174    
175 heimbach 1.4 #endif /* ALLOW_GRDCHK */
176 heimbach 1.2
177 jmc 1.8 return
178 heimbach 1.2 end
  ViewVC Help
Powered by ViewVC 1.1.22