pkg/grdchk/grdchk_get_mask.F

1052c30783 Jean*0001 #include "GRDCHK_OPTIONS.h"
                0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
                0005
                0006       SUBROUTINE GRDCHK_GET_MASK( myThid )
                0007
                0008 C     ==================================================================
                0009 C     SUBROUTINE grdchk_get_mask
                0010 C     ==================================================================
                0011 C
                0012 C     o Get the location of a given component of the control vector for
                0013 C       the current process.
                0014 C
                0015 C     started: Christian Eckert eckert@mit.edu 04-Apr-2000
                0016 C     continued: heimbach@mit.edu: 13-Jun-2001
                0017 C
                0018 C     ==================================================================
                0019 C     SUBROUTINE grdchk_get_mask
                0020 C     ==================================================================
                0021
                0022       IMPLICIT NONE
                0023
                0024 C     == global variables ==
                0025 #include "EEPARAMS.h"
                0026 #include "SIZE.h"
5cf4364659 Mart*0027 #include "CTRL_SIZE.h"
1052c30783 Jean*0028 #include "CTRL.h"
                0029 #ifdef ALLOW_OBCS_CONTROL
                0030 C     CTRL_OBCS.h must be included before GRDCHK.h
                0031 # include "CTRL_OBCS.h"
                0032 #endif
                0033 #include "GRDCHK.h"
                0034
                0035 C     == routine arguments ==
                0036       INTEGER myThid
                0037
                0038 #ifdef ALLOW_GRDCHK
                0039 C     == local variables ==
                0040       INTEGER bi, bj
                0041       INTEGER k, iobcs
                0042       INTEGER itlo, ithi
                0043       INTEGER jtlo, jthi
                0044       INTEGER nobcsmax
                0045 C     == end of interface ==
                0046
                0047       jtlo = 1
                0048       jthi = nSy
                0049       itlo = 1
                0050       ithi = nSx
                0051
                0052       _BEGIN_MASTER( myThid )
                0053
                0054 #ifdef ALLOW_OBCS_CONTROL
                0055       nobcsmax = nobcs
                0056 #else
                0057       nobcsmax = 1
                0058 #endif
                0059
                0060 C--   initialise
                0061       DO bj = jtlo,jthi
                0062        DO bi = itlo,ithi
                0063         DO k = 1,ncvarnrmax(grdchkvarindex)
                0064          DO iobcs = 1, nobcsmax
                0065            nwettile(bi,bj,k,iobcs) = 0
                0066          ENDDO
                0067         ENDDO
                0068        ENDDO
                0069       ENDDO
                0070
                0071 C--   Determine the number of components of the given
                0072 C--   control variable on the current tile.
                0073       IF ( ncvargrd(grdchkvarindex) .EQ. 'c' ) THEN
                0074         DO bj = jtlo,jthi
                0075          DO bi = itlo,ithi
                0076           DO k = 1,ncvarnrmax(grdchkvarindex)
                0077             nwettile(bi,bj,k,1) = nwetctile(bi,bj,k)
                0078           ENDDO
                0079          ENDDO
                0080         ENDDO
                0081       ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 's' ) THEN
                0082         DO bj = jtlo,jthi
                0083          DO bi = itlo,ithi
                0084           DO k = 1,ncvarnrmax(grdchkvarindex)
                0085             nwettile(bi,bj,k,1) = nwetstile(bi,bj,k)
                0086           ENDDO
                0087          ENDDO
                0088         ENDDO
                0089       ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 'w' ) THEN
                0090         DO bj = jtlo,jthi
                0091          DO bi = itlo,ithi
                0092           DO k = 1,ncvarnrmax(grdchkvarindex)
                0093             nwettile(bi,bj,k,1) = nwetwtile(bi,bj,k)
                0094           ENDDO
                0095          ENDDO
                0096         ENDDO
5cf4364659 Mart*0097 c     ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 'v' ) THEN
                0098 c       DO bj = jtlo,jthi
                0099 c        DO bi = itlo,ithi
                0100 c         DO k = 1,ncvarnrmax(grdchkvarindex)
                0101 c           nwettile(bi,bj,k,1) = nwetvtile(bi,bj,k)
                0102 c         ENDDO
                0103 c        ENDDO
                0104 c       ENDDO
1052c30783 Jean*0105 #ifdef ALLOW_SHELFICE
                0106       ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 'i' ) THEN
                0107         DO bj = jtlo,jthi
                0108          DO bi = itlo,ithi
                0109           DO k = 1,ncvarnrmax(grdchkvarindex)
                0110             nwettile(bi,bj,k,1) = nwetitile(bi,bj,k)
                0111           ENDDO
                0112          ENDDO
                0113         ENDDO
                0114 #endif /* ALLOW_SHELFICE */
5cf4364659 Mart*0115 #ifdef ALLOW_OBCS_CONTROL
1052c30783 Jean*0116       ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 'm' ) THEN
5cf4364659 Mart*0117        DO bj = jtlo,jthi
1052c30783 Jean*0118          DO bi = itlo,ithi
                0119           DO k = 1,ncvarnrmax(grdchkvarindex)
                0120            DO iobcs = 1, nobcsmax
5cf4364659 Mart*0121              IF ( ncvarindex(grdchkvarindex).EQ.1 ) THEN
1052c30783 Jean*0122 #ifdef ALLOW_OBCSN_CONTROL
                0123                nwettile(bi,bj,k,iobcs) = nwetobcsn(bi,bj,k,iobcs)
                0124 #endif
5cf4364659 Mart*0125              ELSEIF ( ncvarindex(grdchkvarindex).EQ.2 ) THEN
1052c30783 Jean*0126 #ifdef ALLOW_OBCSS_CONTROL
                0127                nwettile(bi,bj,k,iobcs) = nwetobcss(bi,bj,k,iobcs)
                0128 #endif
5cf4364659 Mart*0129              ELSEIF ( ncvarindex(grdchkvarindex).EQ.3 ) THEN
1052c30783 Jean*0130 #ifdef ALLOW_OBCSE_CONTROL
                0131                nwettile(bi,bj,k,iobcs) = nwetobcse(bi,bj,k,iobcs)
                0132 #endif
5cf4364659 Mart*0133              ELSEIF ( ncvarindex(grdchkvarindex).EQ.4 ) THEN
                0134 #ifdef ALLOW_OBCSW_CONTROL
                0135                nwettile(bi,bj,k,iobcs) = nwetobcsw(bi,bj,k,iobcs)
                0136 #endif
1052c30783 Jean*0137              ENDIF
                0138            ENDDO
                0139           ENDDO
                0140          ENDDO
                0141         ENDDO
5cf4364659 Mart*0142 #endif /* ALLOW_OBCS_CONTROL */
1052c30783 Jean*0143       ELSE
                0144 Ce        --> wrong grid specification for the control variable.
                0145       ENDIF
                0146
                0147 C--   get mask file for obcs
                0148 #ifdef ALLOW_OBCS_CONTROL
                0149       CALL GRDCHK_GET_OBCS_MASK( myThid )
                0150 #endif
                0151
                0152 C     ----------------------------------------------------------------
                0153
                0154 C--   Determine the actual and the maximum possible number of
                0155 C--   components of the given control variable.
                0156       ncvarcomp     = 0
                0157       maxncvarcomps = 0
                0158       DO bj = jtlo,jthi
                0159        DO bi = itlo,ithi
                0160         DO k = 1,ncvarnrmax(grdchkvarindex)
                0161          DO iobcs = 1, nobcsmax
                0162            ncvarcomp     = ncvarcomp + nwettile(bi,bj,k,iobcs)
                0163            maxncvarcomps = maxncvarcomps
                0164      &      + ncvarxmax(grdchkvarindex)*ncvarymax(grdchkvarindex)
                0165          ENDDO
                0166         ENDDO
                0167        ENDDO
                0168       ENDDO
                0169       ncvarcomp     = ncvarcomp*ncvarrecs(grdchkvarindex)
                0170       maxncvarcomps = maxncvarcomps*ncvarrecs(grdchkvarindex)
                0171
                0172       DO bj = jtlo,jthi
                0173        DO bi = itlo,ithi
                0174          iwetsum(bi,bj,0)    = 0
                0175          DO k = 1,ncvarnrmax(grdchkvarindex)
                0176            iwetsum(bi,bj,k) = iwetsum(bi,bj,k-1) + nwettile(bi,bj,k,1)
                0177          ENDDO
                0178        ENDDO
                0179       ENDDO
                0180
                0181       _END_MASTER( myThid )
                0182
                0183       _BARRIER
                0184
                0185 #endif /* ALLOW_GRDCHK */
                0186
                0187       RETURN
                0188       END