pkg/grdchk/grdchk_init.F

C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_init.F,v 1.13 2014/04/04 21:39:56 jmc Exp $
C $Name:  $

#include "GRDCHK_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif

      subroutine grdchk_init( mythid )

c     ==================================================================
c     SUBROUTINE grdchk_init
c     ==================================================================
c
c     o Get the location of a given component of the control vector for
c       the current process.
c
c     started: Christian Eckert eckert@mit.edu 04-Apr-2000
c     continued: heimbach@mit.edu: 13-Jun-2001
c
c     ==================================================================
c     SUBROUTINE grdchk_init
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "ctrl.h"
#include "CTRL_OBCS.h"
#include "grdchk.h"

c     == routine arguments ==

      integer       mythid

#ifdef ALLOW_GRDCHK
c     == local variables ==

      integer bi,bj
      integer i,j,k
      integer irec
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax

      integer itest,iobcs
      integer icomptest

c     == end of interface ==

      jtlo = 1
      jthi = nsy
      itlo = 1
      ithi = nsx
      jmin = 1
      jmax = sny
      imin = 1
      imax = snx

      _BEGIN_MASTER( mythid )

c--   initialise
      do bj = jtlo,jthi
         do bi = itlo,ithi
            do k = 1,ncvarnrmax(grdchkvarindex)
               do iobcs = 1, nobcs
                  nwettile(bi,bj,k,iobcs) = 0
               enddo
            enddo
         enddo
      enddo

c--   Determine the number of components of the given
c--   control variable on the current tile.
      if ( ncvargrd(grdchkvarindex) .eq. 'c' ) then
         do bj = jtlo,jthi
            do bi = itlo,ithi
               do k = 1,ncvarnrmax(grdchkvarindex)
                  nwettile(bi,bj,k,1) = nwetctile(bi,bj,k)
               enddo
            enddo
         enddo
      else if ( ncvargrd(grdchkvarindex) .eq. 's' ) then
         do bj = jtlo,jthi
            do bi = itlo,ithi
               do k = 1,ncvarnrmax(grdchkvarindex)
                  nwettile(bi,bj,k,1) = nwetstile(bi,bj,k)
               enddo
            enddo
         enddo
      else if ( ncvargrd(grdchkvarindex) .eq. 'w' ) then
         do bj = jtlo,jthi
            do bi = itlo,ithi
               do k = 1,ncvarnrmax(grdchkvarindex)
                  nwettile(bi,bj,k,1) = nwetwtile(bi,bj,k)
               enddo
            enddo
         enddo
      else if ( ncvargrd(grdchkvarindex) .eq. 'v' ) then
         do bj = jtlo,jthi
            do bi = itlo,ithi
               do k = 1,ncvarnrmax(grdchkvarindex)
                  nwettile(bi,bj,k,1) = nwetvtile(bi,bj,k)
               enddo
            enddo
         enddo
#ifdef ALLOW_SHIFWFLX_CONTROL
      else if ( ncvargrd(grdchkvarindex) .eq. 'i' ) then
         do bj = jtlo,jthi
            do bi = itlo,ithi
               do k = 1,ncvarnrmax(grdchkvarindex)
                  nwettile(bi,bj,k,1) = nwetitile(bi,bj,k)
               enddo
            enddo
         enddo
#endif /* ALLOW_SHIFWFLX_CONTROL */
      else if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
         do bj = jtlo,jthi
            do bi = itlo,ithi
               do k = 1,ncvarnrmax(grdchkvarindex)
                  do iobcs = 1, nobcs
                     if ( grdchkvarindex .eq. 11 ) then
#ifdef ALLOW_OBCSN_CONTROL
                        nwettile(bi,bj,k,iobcs) =
     &                       nwetobcsn(bi,bj,k,iobcs)
#endif
                     else if ( grdchkvarindex .eq. 12 ) then
#ifdef ALLOW_OBCSS_CONTROL
                        nwettile(bi,bj,k,iobcs) =
     &                       nwetobcss(bi,bj,k,iobcs)
#endif
                     else if ( grdchkvarindex .eq. 13 ) then
#ifdef ALLOW_OBCSW_CONTROL
                        nwettile(bi,bj,k,iobcs) =
     &                       nwetobcsw(bi,bj,k,iobcs)
#endif
                     else if ( grdchkvarindex .eq. 14 ) then
#ifdef ALLOW_OBCSE_CONTROL
                        nwettile(bi,bj,k,iobcs) =
     &                       nwetobcse(bi,bj,k,iobcs)
#endif
                     endif
                  enddo
               enddo
            enddo
         enddo
      else
ce        --> wrong grid specification for the control variable.
      endif

c--   get mask file for obcs
#ifdef ALLOW_OBCS_CONTROL
      call grdchk_get_obcs_mask ( mythid )
#endif

c     ----------------------------------------------------------------

c--   Determine the actual and the maximum possible number of
c--   components of the given control variable.
      ncvarcomp     = 0
      maxncvarcomps = 0
      do bj = jtlo,jthi
         do bi = itlo,ithi
            do k = 1,ncvarnrmax(grdchkvarindex)
               do iobcs = 1, nobcs
                  ncvarcomp     = ncvarcomp + nwettile(bi,bj,k,iobcs)
                  maxncvarcomps = maxncvarcomps +
     &                 ncvarxmax(grdchkvarindex)*
     &                 ncvarymax(grdchkvarindex)
               enddo
            enddo
         enddo
      enddo
      ncvarcomp     = ncvarcomp*ncvarrecs(grdchkvarindex)
      maxncvarcomps = maxncvarcomps*ncvarrecs(grdchkvarindex)

      do bj = jtlo,jthi
         do bi = itlo,ithi
            iwetsum(bi,bj,0)    = 0
            do k = 1,ncvarnrmax(grdchkvarindex)
               iwetsum(bi,bj,k) = iwetsum(bi,bj,k-1) +
     &              nwettile(bi,bj,k,1)
            enddo
         enddo
      enddo

      _END_MASTER( mythid )

      _BARRIER

#endif /* ALLOW_GRDCHK */

      return
      end
1	gforget	1.14	C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_init.F,v 1.13 2014/04/04 21:39:56 jmc Exp $
2	jmc	1.10	C $Name: $
3	heimbach	1.2
4	jmc	1.12	#include "GRDCHK_OPTIONS.h"
5	jmc	1.13	#ifdef ALLOW_CTRL
6			# include "CTRL_OPTIONS.h"
7			#endif
8	heimbach	1.2
9	heimbach	1.5	subroutine grdchk_init( mythid )
10	heimbach	1.2
11			c ==================================================================
12			c SUBROUTINE grdchk_init
13			c ==================================================================
14			c
15			c o Get the location of a given component of the control vector for
16			c the current process.
17			c
18			c started: Christian Eckert eckert@mit.edu 04-Apr-2000
19			c continued: heimbach@mit.edu: 13-Jun-2001
20			c
21			c ==================================================================
22			c SUBROUTINE grdchk_init
23			c ==================================================================
24
25			implicit none
26
27			c == global variables ==
28
29			#include "EEPARAMS.h"
30			#include "SIZE.h"
31			#include "GRID.h"
32			#include "ctrl.h"
33	gforget	1.14	#include "CTRL_OBCS.h"
34	heimbach	1.2	#include "grdchk.h"
35
36			c == routine arguments ==
37
38			integer mythid
39
40	heimbach	1.7	#ifdef ALLOW_GRDCHK
41	heimbach	1.2	c == local variables ==
42
43			integer bi,bj
44			integer i,j,k
45			integer irec
46			integer itlo,ithi
47			integer jtlo,jthi
48			integer jmin,jmax
49			integer imin,imax
50
51	heimbach	1.6	integer itest,iobcs
52	heimbach	1.2	integer icomptest
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	heimbach	1.6	c-- initialise
68			do bj = jtlo,jthi
69			do bi = itlo,ithi
70			do k = 1,ncvarnrmax(grdchkvarindex)
71			do iobcs = 1, nobcs
72			nwettile(bi,bj,k,iobcs) = 0
73			enddo
74			enddo
75			enddo
76			enddo
77
78	heimbach	1.2	c-- Determine the number of components of the given
79			c-- control variable on the current tile.
80			if ( ncvargrd(grdchkvarindex) .eq. 'c' ) then
81			do bj = jtlo,jthi
82			do bi = itlo,ithi
83			do k = 1,ncvarnrmax(grdchkvarindex)
84	heimbach	1.6	nwettile(bi,bj,k,1) = nwetctile(bi,bj,k)
85	heimbach	1.2	enddo
86			enddo
87			enddo
88			else if ( ncvargrd(grdchkvarindex) .eq. 's' ) then
89			do bj = jtlo,jthi
90			do bi = itlo,ithi
91			do k = 1,ncvarnrmax(grdchkvarindex)
92	heimbach	1.6	nwettile(bi,bj,k,1) = nwetstile(bi,bj,k)
93	heimbach	1.2	enddo
94			enddo
95			enddo
96			else if ( ncvargrd(grdchkvarindex) .eq. 'w' ) then
97			do bj = jtlo,jthi
98			do bi = itlo,ithi
99			do k = 1,ncvarnrmax(grdchkvarindex)
100	heimbach	1.6	nwettile(bi,bj,k,1) = nwetwtile(bi,bj,k)
101	heimbach	1.4	enddo
102			enddo
103			enddo
104			else if ( ncvargrd(grdchkvarindex) .eq. 'v' ) then
105			do bj = jtlo,jthi
106			do bi = itlo,ithi
107			do k = 1,ncvarnrmax(grdchkvarindex)
108	heimbach	1.6	nwettile(bi,bj,k,1) = nwetvtile(bi,bj,k)
109			enddo
110			enddo
111			enddo
112	mlosch	1.11	#ifdef ALLOW_SHIFWFLX_CONTROL
113			else if ( ncvargrd(grdchkvarindex) .eq. 'i' ) then
114			do bj = jtlo,jthi
115			do bi = itlo,ithi
116			do k = 1,ncvarnrmax(grdchkvarindex)
117			nwettile(bi,bj,k,1) = nwetitile(bi,bj,k)
118			enddo
119			enddo
120			enddo
121			#endif /* ALLOW_SHIFWFLX_CONTROL */
122	heimbach	1.6	else if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
123			do bj = jtlo,jthi
124			do bi = itlo,ithi
125			do k = 1,ncvarnrmax(grdchkvarindex)
126			do iobcs = 1, nobcs
127			if ( grdchkvarindex .eq. 11 ) then
128			#ifdef ALLOW_OBCSN_CONTROL
129	jmc	1.10	nwettile(bi,bj,k,iobcs) =
130	heimbach	1.6	& nwetobcsn(bi,bj,k,iobcs)
131			#endif
132			else if ( grdchkvarindex .eq. 12 ) then
133			#ifdef ALLOW_OBCSS_CONTROL
134	jmc	1.10	nwettile(bi,bj,k,iobcs) =
135	heimbach	1.6	& nwetobcss(bi,bj,k,iobcs)
136			#endif
137			else if ( grdchkvarindex .eq. 13 ) then
138			#ifdef ALLOW_OBCSW_CONTROL
139	jmc	1.10	nwettile(bi,bj,k,iobcs) =
140	heimbach	1.6	& nwetobcsw(bi,bj,k,iobcs)
141			#endif
142			else if ( grdchkvarindex .eq. 14 ) then
143			#ifdef ALLOW_OBCSE_CONTROL
144	jmc	1.10	nwettile(bi,bj,k,iobcs) =
145	heimbach	1.6	& nwetobcse(bi,bj,k,iobcs)
146			#endif
147			endif
148			enddo
149	heimbach	1.2	enddo
150			enddo
151			enddo
152			else
153			ce --> wrong grid specification for the control variable.
154			endif
155
156	heimbach	1.6	c-- get mask file for obcs
157			#ifdef ALLOW_OBCS_CONTROL
158			call grdchk_get_obcs_mask ( mythid )
159			#endif
160
161	heimbach	1.2	c ----------------------------------------------------------------
162
163			c-- Determine the actual and the maximum possible number of
164			c-- components of the given control variable.
165			ncvarcomp = 0
166			maxncvarcomps = 0
167			do bj = jtlo,jthi
168			do bi = itlo,ithi
169			do k = 1,ncvarnrmax(grdchkvarindex)
170	heimbach	1.6	do iobcs = 1, nobcs
171			ncvarcomp = ncvarcomp + nwettile(bi,bj,k,iobcs)
172	jmc	1.10	maxncvarcomps = maxncvarcomps +
173	heimbach	1.6	& ncvarxmax(grdchkvarindex)*
174			& ncvarymax(grdchkvarindex)
175			enddo
176	heimbach	1.2	enddo
177			enddo
178			enddo
179			ncvarcomp = ncvarcomp*ncvarrecs(grdchkvarindex)
180			maxncvarcomps = maxncvarcomps*ncvarrecs(grdchkvarindex)
181
182	heimbach	1.8	do bj = jtlo,jthi
183			do bi = itlo,ithi
184	heimbach	1.9	iwetsum(bi,bj,0) = 0
185	heimbach	1.8	do k = 1,ncvarnrmax(grdchkvarindex)
186	jmc	1.10	iwetsum(bi,bj,k) = iwetsum(bi,bj,k-1) +
187	heimbach	1.9	& nwettile(bi,bj,k,1)
188	heimbach	1.8	enddo
189			enddo
190			enddo
191
192	heimbach	1.2	_END_MASTER( mythid )
193
194			_BARRIER
195
196	heimbach	1.7	#endif /* ALLOW_GRDCHK */
197	heimbach	1.2
198	jmc	1.12	return
199	heimbach	1.2	end