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

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

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

Revision 1.10 - (hide annotations) (download)
Tue Oct 9 00:05:45 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62x, checkpoint60, checkpoint61, checkpoint62, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59k, checkpoint62b, checkpoint61f, checkpoint61n, checkpoint59j, checkpoint61q, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.9: +8 -7 lines 
add missing cvs $Header:$ or $Name:$
1 jmc 1.10 C $Header: $
2     C $Name: $
3 heimbach 1.2
4     #include "CTRL_CPPOPTIONS.h"
5    
6    
7 heimbach 1.5 subroutine grdchk_init( mythid )
8 heimbach 1.2
9     c ==================================================================
10     c SUBROUTINE grdchk_init
11     c ==================================================================
12     c
13     c o Get the location of a given component of the control vector for
14     c the current process.
15     c
16     c started: Christian Eckert eckert@mit.edu 04-Apr-2000
17     c continued: heimbach@mit.edu: 13-Jun-2001
18     c
19     c ==================================================================
20     c SUBROUTINE grdchk_init
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     #include "grdchk.h"
32    
33     c == routine arguments ==
34    
35     integer mythid
36    
37 heimbach 1.7 #ifdef ALLOW_GRDCHK
38 heimbach 1.2 c == local variables ==
39    
40     integer bi,bj
41     integer i,j,k
42     integer irec
43     integer itlo,ithi
44     integer jtlo,jthi
45     integer jmin,jmax
46     integer imin,imax
47    
48 heimbach 1.6 integer itest,iobcs
49 heimbach 1.2 integer icomptest
50    
51     c == end of interface ==
52    
53     jtlo = 1
54     jthi = nsy
55     itlo = 1
56     ithi = nsx
57     jmin = 1
58     jmax = sny
59     imin = 1
60     imax = snx
61    
62     _BEGIN_MASTER( mythid )
63    
64 heimbach 1.6 c-- initialise
65     do bj = jtlo,jthi
66     do bi = itlo,ithi
67     do k = 1,ncvarnrmax(grdchkvarindex)
68     do iobcs = 1, nobcs
69     nwettile(bi,bj,k,iobcs) = 0
70     enddo
71     enddo
72     enddo
73     enddo
74    
75 heimbach 1.2 c-- Determine the number of components of the given
76     c-- control variable on the current tile.
77     if ( ncvargrd(grdchkvarindex) .eq. 'c' ) then
78     do bj = jtlo,jthi
79     do bi = itlo,ithi
80     do k = 1,ncvarnrmax(grdchkvarindex)
81 heimbach 1.6 nwettile(bi,bj,k,1) = nwetctile(bi,bj,k)
82 heimbach 1.2 enddo
83     enddo
84     enddo
85     else if ( ncvargrd(grdchkvarindex) .eq. 's' ) then
86     do bj = jtlo,jthi
87     do bi = itlo,ithi
88     do k = 1,ncvarnrmax(grdchkvarindex)
89 heimbach 1.6 nwettile(bi,bj,k,1) = nwetstile(bi,bj,k)
90 heimbach 1.2 enddo
91     enddo
92     enddo
93     else if ( ncvargrd(grdchkvarindex) .eq. 'w' ) then
94     do bj = jtlo,jthi
95     do bi = itlo,ithi
96     do k = 1,ncvarnrmax(grdchkvarindex)
97 heimbach 1.6 nwettile(bi,bj,k,1) = nwetwtile(bi,bj,k)
98 heimbach 1.4 enddo
99     enddo
100     enddo
101     else if ( ncvargrd(grdchkvarindex) .eq. 'v' ) then
102     do bj = jtlo,jthi
103     do bi = itlo,ithi
104     do k = 1,ncvarnrmax(grdchkvarindex)
105 heimbach 1.6 nwettile(bi,bj,k,1) = nwetvtile(bi,bj,k)
106     enddo
107     enddo
108     enddo
109     else if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
110     do bj = jtlo,jthi
111     do bi = itlo,ithi
112     do k = 1,ncvarnrmax(grdchkvarindex)
113     do iobcs = 1, nobcs
114     if ( grdchkvarindex .eq. 11 ) then
115     #ifdef ALLOW_OBCSN_CONTROL
116 jmc 1.10 nwettile(bi,bj,k,iobcs) =
117 heimbach 1.6 & nwetobcsn(bi,bj,k,iobcs)
118     #endif
119     else if ( grdchkvarindex .eq. 12 ) then
120     #ifdef ALLOW_OBCSS_CONTROL
121 jmc 1.10 nwettile(bi,bj,k,iobcs) =
122 heimbach 1.6 & nwetobcss(bi,bj,k,iobcs)
123     #endif
124     else if ( grdchkvarindex .eq. 13 ) then
125     #ifdef ALLOW_OBCSW_CONTROL
126 jmc 1.10 nwettile(bi,bj,k,iobcs) =
127 heimbach 1.6 & nwetobcsw(bi,bj,k,iobcs)
128     #endif
129     else if ( grdchkvarindex .eq. 14 ) then
130     #ifdef ALLOW_OBCSE_CONTROL
131 jmc 1.10 nwettile(bi,bj,k,iobcs) =
132 heimbach 1.6 & nwetobcse(bi,bj,k,iobcs)
133     #endif
134     endif
135     enddo
136 heimbach 1.2 enddo
137     enddo
138     enddo
139     else
140     ce --> wrong grid specification for the control variable.
141     endif
142    
143 heimbach 1.6 c-- get mask file for obcs
144     #ifdef ALLOW_OBCS_CONTROL
145     call grdchk_get_obcs_mask ( mythid )
146     #endif
147    
148 heimbach 1.2 c ----------------------------------------------------------------
149    
150     c-- Determine the actual and the maximum possible number of
151     c-- components of the given control variable.
152     ncvarcomp = 0
153     maxncvarcomps = 0
154     do bj = jtlo,jthi
155     do bi = itlo,ithi
156     do k = 1,ncvarnrmax(grdchkvarindex)
157 heimbach 1.6 do iobcs = 1, nobcs
158     ncvarcomp = ncvarcomp + nwettile(bi,bj,k,iobcs)
159 jmc 1.10 maxncvarcomps = maxncvarcomps +
160 heimbach 1.6 & ncvarxmax(grdchkvarindex)*
161     & ncvarymax(grdchkvarindex)
162     enddo
163 heimbach 1.2 enddo
164     enddo
165     enddo
166     ncvarcomp = ncvarcomp*ncvarrecs(grdchkvarindex)
167     maxncvarcomps = maxncvarcomps*ncvarrecs(grdchkvarindex)
168    
169 heimbach 1.8 do bj = jtlo,jthi
170     do bi = itlo,ithi
171 heimbach 1.9 iwetsum(bi,bj,0) = 0
172 heimbach 1.8 do k = 1,ncvarnrmax(grdchkvarindex)
173 jmc 1.10 iwetsum(bi,bj,k) = iwetsum(bi,bj,k-1) +
174 heimbach 1.9 & nwettile(bi,bj,k,1)
175 heimbach 1.8 enddo
176     enddo
177     enddo
178    
179 heimbach 1.2 _END_MASTER( mythid )
180    
181     _BARRIER
182    
183 heimbach 1.7 #endif /* ALLOW_GRDCHK */
184 heimbach 1.2
185     end
186    
  ViewVC Help
Powered by ViewVC 1.1.22