pkg/ctrl/ctrl_init_wet.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
4c6316f049 Patr*0002
de57a2ec4b Mart*0003       subroutine ctrl_init_wet( myThid )
4c6316f049 Patr*0004
                0005 c     ==================================================================
                0006 c     SUBROUTINE ctrl_init_wet
                0007 c     ==================================================================
                0008
5cf4364659 Mart*0009       IMPLICIT NONE
4c6316f049 Patr*0010
                0011 c     == global variables ==
                0012 #include "EEPARAMS.h"
                0013 #include "SIZE.h"
                0014 #include "PARAMS.h"
                0015 #include "GRID.h"
5cf4364659 Mart*0016 #include "CTRL_SIZE.h"
4d72283393 Mart*0017 #include "CTRL.h"
e612621177 Gael*0018 #include "CTRL_OBCS.h"
4c6316f049 Patr*0019
                0020 #ifdef ALLOW_OBCS_CONTROL
46c1d12550 Jean*0021 # include "OBCS_GRID.h"
4c6316f049 Patr*0022 #endif
6b47d550f4 Mart*0023 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0024 # include "SHELFICE.h"
6b47d550f4 Mart*0025 #endif /* ALLOW_SHELFICE */
46c1d12550 Jean*0026
4c6316f049 Patr*0027 c     == routine arguments ==
de57a2ec4b Mart*0028       integer myThid
4c6316f049 Patr*0029
                0030 c     == local variables ==
                0031       integer bi,bj
                0032       integer i,j,k
                0033       integer itlo,ithi
                0034       integer jtlo,jthi
                0035       integer jmin,jmax
                0036       integer imin,imax
5cf4364659 Mart*0037       integer ivar
6a4477f903 Patr*0038       integer ntmp2(4)
4c6316f049 Patr*0039       integer nwetc3d
7b8b86ab99 Timo*0040 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0041       integer ntmpshi
                0042 #endif
6a4477f903 Patr*0043 #ifdef ALLOW_OBCS_CONTROL
6b47d550f4 Mart*0044       integer iobcs
6a4477f903 Patr*0045       integer ntmpob(nobcs)
5cf4364659 Mart*0046       CHARACTER*(MAX_LEN_FNAM) ymaskobcs
6a4477f903 Patr*0047 #endif
5cf4364659 Mart*0048 c#ifdef REAL4_IS_SLOW
                0049 c     _RL dummy
                0050 c#endif
df2d73a28e Patr*0051       _RS dummyRS
5cf4364659 Mart*0052       CHARACTER*(MAX_LEN_MBUF) msgbuf
4c6316f049 Patr*0053
                0054 c--   Set loop ranges.
de57a2ec4b Mart*0055       jtlo = myByLo(myThid)
                0056       jthi = myByHi(myThid)
                0057       itlo = myBxLo(myThid)
                0058       ithi = myBxHi(myThid)
4c6316f049 Patr*0059       jmin = 1
de57a2ec4b Mart*0060       jmax = sNy
4c6316f049 Patr*0061       imin = 1
de57a2ec4b Mart*0062       imax = sNx
4c6316f049 Patr*0063
                0064 c--   Determine the number of wet points in each tile:
                0065 c--   maskc, masks, and maskw.
                0066
                0067 c--   Initialise the counters.
                0068       do bj = jtlo,jthi
                0069         do bi = itlo,ithi
de57a2ec4b Mart*0070           do k = 1,Nr
4c6316f049 Patr*0071             nwetctile(bi,bj,k) = 0
                0072             nwetstile(bi,bj,k) = 0
                0073             nwetwtile(bi,bj,k) = 0
                0074             nwetvtile(bi,bj,k) = 0
7b8b86ab99 Timo*0075 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0076             nwetitile(bi,bj,k) = 0
46c1d12550 Jean*0077 #endif
4c6316f049 Patr*0078           enddo
                0079         enddo
                0080       enddo
                0081
                0082 #ifdef ALLOW_OBCS_CONTROL
                0083 c--   Initialise obcs counters.
                0084       do bj = jtlo,jthi
                0085         do bi = itlo,ithi
de57a2ec4b Mart*0086           do k = 1,Nr
4c6316f049 Patr*0087             do iobcs = 1,nobcs
                0088 #ifdef ALLOW_OBCSN_CONTROL
                0089               nwetobcsn(bi,bj,k,iobcs) = 0
                0090 #endif
                0091 #ifdef ALLOW_OBCSS_CONTROL
                0092               nwetobcss(bi,bj,k,iobcs) = 0
                0093 #endif
                0094 #ifdef ALLOW_OBCSW_CONTROL
                0095               nwetobcsw(bi,bj,k,iobcs) = 0
                0096 #endif
                0097 #ifdef ALLOW_OBCSE_CONTROL
                0098               nwetobcse(bi,bj,k,iobcs) = 0
                0099 #endif
                0100             enddo
                0101           enddo
                0102         enddo
                0103       enddo
                0104 #endif
                0105
                0106 c--   Count wet points on each tile.
                0107       do bj = jtlo,jthi
                0108         do bi = itlo,ithi
de57a2ec4b Mart*0109           do k = 1,Nr
4c6316f049 Patr*0110             do j = jmin,jmax
                0111               do i = imin,imax
                0112 c--             Center mask.
549fffadc4 Oliv*0113                 if (maskC(i,j,k,bi,bj) .ne. 0.) then
4c6316f049 Patr*0114                   nwetctile(bi,bj,k) = nwetctile(bi,bj,k) + 1
                0115                 endif
                0116 c--             South mask.
                0117                 if (maskS(i,j,k,bi,bj) .eq. 1.) then
                0118                   nwetstile(bi,bj,k) = nwetstile(bi,bj,k) + 1
                0119                 endif
                0120 c--             West mask.
                0121                 if (maskW(i,j,k,bi,bj) .eq. 1.) then
                0122                   nwetwtile(bi,bj,k) = nwetwtile(bi,bj,k) + 1
                0123                 endif
6b47d550f4 Mart*0124 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0125 c--             Ice shelf mask.
                0126                 if (maskSHI(i,j,k,bi,bj) .eq. 1.) then
                0127                  nwetitile(bi,bj,k) = nwetitile(bi,bj,k) + 1
                0128                 endif
6b47d550f4 Mart*0129 #endif /* ALLOW_SHELFICE */
4c6316f049 Patr*0130               enddo
                0131             enddo
                0132           enddo
                0133         enddo
                0134       enddo
                0135
                0136 #ifdef ALLOW_OBCSN_CONTROL
                0137 c--   Count wet points at Northern boundary.
                0138 c--   mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
                0139       ymaskobcs = 'maskobcsn'
9fdf964eb3 Jean*0140       call ctrl_mask_set_xz( 0, OB_indexNone, OB_Jn,
de57a2ec4b Mart*0141      &                       nwetobcsn, ymaskobcs, myThid )
4c6316f049 Patr*0142 #endif
                0143
                0144 #ifdef ALLOW_OBCSS_CONTROL
                0145 c--   Count wet points at Southern boundary.
                0146 c--   mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
                0147       ymaskobcs = 'maskobcss'
9fdf964eb3 Jean*0148       call ctrl_mask_set_xz( 1, OB_indexNone, OB_Js,
de57a2ec4b Mart*0149      &                       nwetobcss, ymaskobcs, myThid )
4c6316f049 Patr*0150 #endif
                0151
                0152 #ifdef ALLOW_OBCSW_CONTROL
                0153 c--   Count wet points at Western boundary.
                0154 c--   mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
                0155       ymaskobcs = 'maskobcsw'
9fdf964eb3 Jean*0156       call ctrl_mask_set_yz( 1, OB_indexNone, OB_Iw,
de57a2ec4b Mart*0157      &                       nwetobcsw, ymaskobcs, myThid )
4c6316f049 Patr*0158 #endif
                0159
                0160 #ifdef ALLOW_OBCSE_CONTROL
                0161 c--   Count wet points at Eastern boundary.
                0162 c--   mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
                0163       ymaskobcs = 'maskobcse'
9fdf964eb3 Jean*0164       call ctrl_mask_set_yz( 0, OB_indexNone, OB_Ie,
de57a2ec4b Mart*0165      &                       nwetobcse, ymaskobcs, myThid )
4c6316f049 Patr*0166 #endif
                0167
de57a2ec4b Mart*0168       _BEGIN_MASTER( myThid )
4c6316f049 Patr*0169 c--   Determine the total number of control variables.
                0170       nvartype   = 0
                0171       nvarlength = 0
5cf4364659 Mart*0172       do ivar = 1, maxcvars
4c6316f049 Patr*0173 c
5cf4364659 Mart*0174        if ( ncvarindex(ivar) .ge. 0 ) then
6b47d550f4 Mart*0175         nvartype = nvartype + 1
                0176         do bj = jtlo,jthi
                0177          do bi = itlo,ithi
5cf4364659 Mart*0178           do k = 1,ncvarnrmax(ivar)
                0179            if ( ncvargrd(ivar) .eq. 'c' ) then
                0180             nvarlength = nvarlength + ncvarrecs(ivar)*nwetctile(bi,bj,k)
                0181            else if ( ncvargrd(ivar) .eq. 's' ) then
                0182             nvarlength = nvarlength + ncvarrecs(ivar)*nwetstile(bi,bj,k)
                0183            else if ( ncvargrd(ivar) .eq. 'w' ) then
                0184             nvarlength = nvarlength + ncvarrecs(ivar)*nwetwtile(bi,bj,k)
                0185 c          else if ( ncvargrd(ivar) .eq. 'v' ) then
                0186 c           nvarlength = nvarlength + ncvarrecs(ivar)*nwetvtile(bi,bj,k)
6b47d550f4 Mart*0187 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0188 c--             Ice shelf mask.
5cf4364659 Mart*0189            else if ( ncvargrd(ivar) .eq. 'i') then
                0190             nvarlength = nvarlength + ncvarrecs(ivar)*nwetitile(bi,bj,k)
6b47d550f4 Mart*0191 #endif /* ALLOW_SHELFICE */
5cf4364659 Mart*0192            else if ( ncvargrd(ivar) .eq. 'm' ) then
4c6316f049 Patr*0193 #ifdef ALLOW_OBCS_CONTROL
6b47d550f4 Mart*0194             do iobcs = 1, nobcs
4c6316f049 Patr*0195 cgg   This overcounts the number of o.b. control points by a factor of "nobcs".
2146dab1aa Jean*0196 cgg   As an ad-hoc solution I have divided by nobcs everywhere.
4c6316f049 Patr*0197 #ifdef ALLOW_OBCSN_CONTROL
5cf4364659 Mart*0198              if ( ncvarindex(ivar) .eq. 1 ) nvarlength = nvarlength
                0199      &            + nwetobcsn(bi,bj,k,iobcs)*(ncvarrecs(ivar)/nobcs)
4c6316f049 Patr*0200 #endif
                0201 #ifdef ALLOW_OBCSS_CONTROL
5cf4364659 Mart*0202              if ( ncvarindex(ivar) .eq. 2 ) nvarlength = nvarlength
                0203      &            + nwetobcss(bi,bj,k,iobcs)*(ncvarrecs(ivar)/nobcs)
4c6316f049 Patr*0204 #endif
                0205 #ifdef ALLOW_OBCSE_CONTROL
5cf4364659 Mart*0206              if ( ncvarindex(ivar) .eq. 3 ) nvarlength = nvarlength
                0207      &            + nwetobcse(bi,bj,k,iobcs)*(ncvarrecs(ivar)/nobcs)
                0208 #endif
                0209 #ifdef ALLOW_OBCSW_CONTROL
                0210              if ( ncvarindex(ivar) .eq. 4 ) nvarlength = nvarlength
                0211      &            + nwetobcsw(bi,bj,k,iobcs)*(ncvarrecs(ivar)/nobcs)
6b47d550f4 Mart*0212 #endif
4c6316f049 Patr*0213             enddo
6b47d550f4 Mart*0214 #endif
                0215            else
                0216             print*,'ctrl_init_wet: invalid grid location'
5cf4364659 Mart*0217             print*,'     control variable = ',ncvarindex(ivar)
                0218             print*,'     grid location    = ',ncvargrd(ivar)
6b47d550f4 Mart*0219             stop   ' ... stopped in ctrl_init_wet'
                0220            endif
                0221           enddo
                0222          enddo
                0223         enddo
                0224        endif
4c6316f049 Patr*0225       enddo
                0226
                0227 cph(
c70eba42f3 Patr*0228       write(msgbuf,'(a,2x,I10)')
                0229      &     'ctrl-wet 1:    nvarlength = ', nvarlength
4d72283393 Mart*0230       call print_message( msgbuf, standardMessageUnit,
                0231      &     SQUEEZE_RIGHT, myThid )
c70eba42f3 Patr*0232       write(msgbuf,'(a,2x,I10)')
                0233      &     'ctrl-wet 2: surface wet C = ', nwetctile(1,1,1)
4d72283393 Mart*0234       call print_message( msgbuf, standardMessageUnit,
                0235      &     SQUEEZE_RIGHT, myThid )
c70eba42f3 Patr*0236       write(msgbuf,'(a,2x,I10)')
                0237      &     'ctrl-wet 3: surface wet W = ', nwetwtile(1,1,1)
4d72283393 Mart*0238       call print_message( msgbuf, standardMessageUnit,
                0239      &     SQUEEZE_RIGHT, myThid )
c70eba42f3 Patr*0240       write(msgbuf,'(a,2x,I10)')
                0241      &     'ctrl-wet 4: surface wet S = ', nwetstile(1,1,1)
4d72283393 Mart*0242       call print_message( msgbuf, standardMessageUnit,
                0243      &     SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0244 c     write(msgbuf,'(a,2x,I10)')
                0245 c    &     'ctrl-wet 4a:surface wet V = ', nwetvtile(1,1,1)
                0246 c     call print_message( msgbuf, standardMessageUnit,
                0247 c    &     SQUEEZE_RIGHT, myThid )
c70eba42f3 Patr*0248
4c6316f049 Patr*0249       nwetc3d = 0
                0250       do k = 1, Nr
                0251          nwetc3d = nwetc3d + nwetctile(1,1,k)
                0252       end do
c70eba42f3 Patr*0253       write(msgbuf,'(a,2x,I10)')
                0254      &     'ctrl-wet 5: 3D wet points = ', nwetc3d
4d72283393 Mart*0255       call print_message( msgbuf, standardMessageUnit,
                0256      &     SQUEEZE_RIGHT, myThid )
c70eba42f3 Patr*0257
5cf4364659 Mart*0258       do ivar = 1, maxcvars
c70eba42f3 Patr*0259          write(msgbuf,'(a,2x,I3,2x,I10)')
5cf4364659 Mart*0260      &     'ctrl-wet 6: no recs for ivar = ', ivar, ncvarrecs(ivar)
4d72283393 Mart*0261         call print_message( msgbuf, standardMessageUnit,
                0262      &       SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0263       end do
c70eba42f3 Patr*0264
4c6316f049 Patr*0265 #ifdef ALLOW_OBCSN_CONTROL
c70eba42f3 Patr*0266       write(msgbuf,'(a,2x,4I10)')
                0267      &     'ctrl-wet 9: surface wet obcsn = '
4c6316f049 Patr*0268      &     , nwetobcsn(1,1,1,1), nwetobcsn(1,1,1,2)
                0269      &     , nwetobcsn(1,1,1,3), nwetobcsn(1,1,1,4)
4d72283393 Mart*0270       call print_message( msgbuf, standardMessageUnit,
                0271      &     SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0272 #endif
                0273 #ifdef ALLOW_OBCSS_CONTROL
c70eba42f3 Patr*0274       write(msgbuf,'(a,2x,4I10)')
                0275      &     'ctrl-wet 10: surface wet obcss = '
4c6316f049 Patr*0276      &     , nwetobcss(1,1,1,1), nwetobcss(1,1,1,2)
                0277      &     , nwetobcss(1,1,1,3), nwetobcss(1,1,1,4)
4d72283393 Mart*0278       call print_message( msgbuf, standardMessageUnit,
                0279      &     SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0280 #endif
                0281 #ifdef ALLOW_OBCSW_CONTROL
c70eba42f3 Patr*0282       write(msgbuf,'(a,2x,4I10)')
                0283      &     'ctrl-wet 11: surface wet obcsw = '
4c6316f049 Patr*0284      &     , nwetobcsw(1,1,1,1), nwetobcsw(1,1,1,2)
                0285      &     , nwetobcsw(1,1,1,3), nwetobcsw(1,1,1,4)
4d72283393 Mart*0286       call print_message( msgbuf, standardMessageUnit,
                0287      &     SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0288 #endif
                0289 #ifdef ALLOW_OBCSE_CONTROL
c70eba42f3 Patr*0290       write(msgbuf,'(a,2x,4I10)')
                0291      &     'ctrl-wet 12: surface wet obcse = '
4c6316f049 Patr*0292      &     , nwetobcse(1,1,1,1), nwetobcse(1,1,1,2)
                0293      &     , nwetobcse(1,1,1,3), nwetobcse(1,1,1,4)
4d72283393 Mart*0294       call print_message( msgbuf, standardMessageUnit,
                0295      &     SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0296 #endif
                0297 cph)
46c1d12550 Jean*0298
6a4477f903 Patr*0299       write(msgbuf,'(a)')
                0300      &    'ctrl-wet -------------------------------------------------'
4d72283393 Mart*0301       call print_message( msgbuf, standardMessageUnit,
                0302      &    SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0303
4c6316f049 Patr*0304       CALL GLOBAL_SUM_INT( nvarlength,  myThid )
                0305
c70eba42f3 Patr*0306       write(msgbuf,'(a,2x,I3,2x,I10)')
de57a2ec4b Mart*0307      &     'ctrl-wet 13: global nvarlength for Nr =', Nr, nvarlength
4d72283393 Mart*0308       call print_message( msgbuf, standardMessageUnit,
                0309      &     SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0310
6a4477f903 Patr*0311       write(msgbuf,'(a)')
                0312      &    'ctrl-wet -------------------------------------------------'
4d72283393 Mart*0313       call print_message( msgbuf, standardMessageUnit,
                0314      &    SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0315
4c6316f049 Patr*0316 c
46c1d12550 Jean*0317 c     Summation of wet point counters
4c6316f049 Patr*0318 c
de57a2ec4b Mart*0319       do k = 1, Nr
4c6316f049 Patr*0320
6a4477f903 Patr*0321          ntmp2(1)=0
4c6316f049 Patr*0322          do bj=1,nSy
                0323             do bi=1,nSx
6a4477f903 Patr*0324                ntmp2(1)=ntmp2(1)+nWetcTile(bi,bj,k)
4c6316f049 Patr*0325             enddo
                0326          enddo
6a4477f903 Patr*0327          CALL GLOBAL_SUM_INT( ntmp2(1),  myThid )
                0328          nWetcGlobal(k)=ntmp2(1)
4c6316f049 Patr*0329
6a4477f903 Patr*0330          ntmp2(2)=0
4c6316f049 Patr*0331          do bj=1,nSy
                0332             do bi=1,nSx
6a4477f903 Patr*0333                ntmp2(2)=ntmp2(2)+nWetsTile(bi,bj,k)
4c6316f049 Patr*0334             enddo
                0335          enddo
6a4477f903 Patr*0336          CALL GLOBAL_SUM_INT( ntmp2(2),  myThid )
                0337          nWetsGlobal(k)=ntmp2(2)
4c6316f049 Patr*0338
6a4477f903 Patr*0339          ntmp2(3)=0
4c6316f049 Patr*0340          do bj=1,nSy
                0341             do bi=1,nSx
6a4477f903 Patr*0342                ntmp2(3)=ntmp2(3)+nWetwTile(bi,bj,k)
4c6316f049 Patr*0343             enddo
                0344          enddo
6a4477f903 Patr*0345          CALL GLOBAL_SUM_INT( ntmp2(3),  myThid )
                0346          nWetwGlobal(k)=ntmp2(3)
4c6316f049 Patr*0347
6a4477f903 Patr*0348          ntmp2(4)=0
5cf4364659 Mart*0349 c        do bj=1,nSy
                0350 c           do bi=1,nSx
                0351 c              ntmp2(4)=ntmp2(4)+nWetvTile(bi,bj,k)
                0352 c           enddo
                0353 c        enddo
                0354 c        CALL GLOBAL_SUM_INT( ntmp2(4),  myThid )
6a4477f903 Patr*0355          nWetvGlobal(k)=ntmp2(4)
                0356
                0357          write(msgbuf,'(a,2x,I3,4(2x,I10))')
5cf4364659 Mart*0358      &        'ctrl-wet 14: global nWet C/S/W k=', k, (ntmp2(i),i=1,3)
                0359 c    &        'ctrl-wet 14: global nWet C/S/W/V k=', k, ntmp2
4d72283393 Mart*0360          call print_message( msgbuf, standardMessageUnit,
                0361      &       SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0362
                0363       enddo
                0364
                0365       write(msgbuf,'(a)')
                0366      &    'ctrl-wet -------------------------------------------------'
4d72283393 Mart*0367       call print_message( msgbuf, standardMessageUnit,
                0368      &    SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0369
de57a2ec4b Mart*0370       do k = 1, Nr
4c6316f049 Patr*0371
                0372 #ifdef ALLOW_OBCSN_CONTROL
                0373          do iobcs = 1, nobcs
6a4477f903 Patr*0374             ntmpob(iobcs)=0
4c6316f049 Patr*0375             do bj=1,nSy
                0376                do bi=1,nSx
6a4477f903 Patr*0377                   ntmpob(iobcs)=ntmpob(iobcs)+nwetobcsn(bi,bj,k,iobcs)
4c6316f049 Patr*0378                enddo
                0379             enddo
6a4477f903 Patr*0380             CALL GLOBAL_SUM_INT( ntmpob(iobcs),  myThid )
                0381             nwetobcsnglo(k,iobcs)=ntmpob(iobcs)
4c6316f049 Patr*0382          enddo
6a4477f903 Patr*0383          write(msgbuf,'(a,2x,I3,4(2x,I10))')
                0384      &       'ctrl-wet 15a: global obcsN T,S,U,V k=', k, ntmpob
4d72283393 Mart*0385          call print_message( msgbuf, standardMessageUnit,
                0386      &       SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0387 #endif
                0388 #ifdef ALLOW_OBCSS_CONTROL
                0389          do iobcs = 1, nobcs
6a4477f903 Patr*0390             ntmpob(iobcs)=0
4c6316f049 Patr*0391             do bj=1,nSy
                0392                do bi=1,nSx
6a4477f903 Patr*0393                   ntmpob(iobcs)=ntmpob(iobcs)+nwetobcss(bi,bj,k,iobcs)
4c6316f049 Patr*0394                enddo
                0395             enddo
6a4477f903 Patr*0396             CALL GLOBAL_SUM_INT( ntmpob(iobcs),  myThid )
                0397             nwetobcssglo(k,iobcs)=ntmpob(iobcs)
4c6316f049 Patr*0398          enddo
6a4477f903 Patr*0399          write(msgbuf,'(a,2x,I3,4(2x,I10))')
                0400      &       'ctrl-wet 15b: global obcsS T,S,U,V k=', k, ntmpob
4d72283393 Mart*0401          call print_message( msgbuf, standardMessageUnit,
                0402      &       SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0403 #endif
                0404 #ifdef ALLOW_OBCSW_CONTROL
                0405          do iobcs = 1, nobcs
6a4477f903 Patr*0406             ntmpob(iobcs)=0
4c6316f049 Patr*0407             do bj=1,nSy
                0408                do bi=1,nSx
6a4477f903 Patr*0409                   ntmpob(iobcs)=ntmpob(iobcs)+nwetobcsw(bi,bj,k,iobcs)
4c6316f049 Patr*0410                enddo
                0411             enddo
6a4477f903 Patr*0412             CALL GLOBAL_SUM_INT( ntmpob(iobcs),  myThid )
                0413             nwetobcswglo(k,iobcs)=ntmpob(iobcs)
4c6316f049 Patr*0414          enddo
6a4477f903 Patr*0415          write(msgbuf,'(a,2x,I3,4(2x,I10))')
                0416      &       'ctrl-wet 15c: global obcsW T,S,U,V k=', k, ntmpob
4d72283393 Mart*0417          call print_message( msgbuf, standardMessageUnit,
                0418      &       SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0419 #endif
                0420 #ifdef ALLOW_OBCSE_CONTROL
                0421          do iobcs = 1, nobcs
6a4477f903 Patr*0422             ntmpob(iobcs)=0
4c6316f049 Patr*0423             do bj=1,nSy
                0424                do bi=1,nSx
6a4477f903 Patr*0425                   ntmpob(iobcs)=ntmpob(iobcs)+nwetobcse(bi,bj,k,iobcs)
4c6316f049 Patr*0426                enddo
                0427             enddo
6a4477f903 Patr*0428             CALL GLOBAL_SUM_INT( ntmpob(iobcs),  myThid )
                0429             nwetobcseglo(k,iobcs)=ntmpob(iobcs)
4c6316f049 Patr*0430          enddo
6a4477f903 Patr*0431          write(msgbuf,'(a,2x,I3,4(2x,I10))')
                0432      &       'ctrl-wet 15d: global obcsE T,S,U,V k=', k, ntmpob
4d72283393 Mart*0433          call print_message( msgbuf, standardMessageUnit,
                0434      &       SQUEEZE_RIGHT, myThid )
4c6316f049 Patr*0435 #endif
                0436
                0437       enddo
                0438
5cf4364659 Mart*0439 #ifdef ALLOW_OBCS_CONTROL
6a4477f903 Patr*0440       write(msgbuf,'(a)')
                0441      &    'ctrl-wet -------------------------------------------------'
4d72283393 Mart*0442       call print_message( msgbuf, standardMessageUnit,
                0443      &    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0444 #endif
6a4477f903 Patr*0445
                0446 #ifdef ALLOW_OBCSN_CONTROL
                0447       do iobcs = 1, nobcs
                0448         ntmpob(iobcs)=0
de57a2ec4b Mart*0449         do k = 1, Nr
6a4477f903 Patr*0450           ntmpob(iobcs)=ntmpob(iobcs)+nwetobcsnglo(k,iobcs)
                0451         enddo
                0452       enddo
                0453       write(msgbuf,'(a,4(2x,I10))')
                0454      &    'ctrl-wet 16a: global SUM(K) obcsN T,S,U,V ', ntmpob
4d72283393 Mart*0455       call print_message( msgbuf, standardMessageUnit,
                0456      &    SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0457 #endif
                0458 #ifdef ALLOW_OBCSS_CONTROL
                0459       do iobcs = 1, nobcs
                0460         ntmpob(iobcs)=0
de57a2ec4b Mart*0461         do k = 1, Nr
6a4477f903 Patr*0462           ntmpob(iobcs)=ntmpob(iobcs)+nwetobcssglo(k,iobcs)
                0463         enddo
                0464       enddo
                0465       write(msgbuf,'(a,4(2x,I10))')
                0466      &    'ctrl-wet 16b: global SUM(K) obcsS T,S,U,V ', ntmpob
4d72283393 Mart*0467       call print_message( msgbuf, standardMessageUnit,
                0468      &    SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0469 #endif
                0470 #ifdef ALLOW_OBCSW_CONTROL
                0471       do iobcs = 1, nobcs
                0472         ntmpob(iobcs)=0
de57a2ec4b Mart*0473         do k = 1, Nr
6a4477f903 Patr*0474           ntmpob(iobcs)=ntmpob(iobcs)+nwetobcswglo(k,iobcs)
                0475         enddo
                0476       enddo
                0477       write(msgbuf,'(a,4(2x,I10))')
                0478      &    'ctrl-wet 16c: global SUM(K) obcsW T,S,U,V ', ntmpob
4d72283393 Mart*0479       call print_message( msgbuf, standardMessageUnit,
                0480      &    SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0481 #endif
                0482 #ifdef ALLOW_OBCSE_CONTROL
                0483       do iobcs = 1, nobcs
                0484         ntmpob(iobcs)=0
de57a2ec4b Mart*0485         do k = 1, Nr
6a4477f903 Patr*0486           ntmpob(iobcs)=ntmpob(iobcs)+nwetobcseglo(k,iobcs)
                0487         enddo
                0488       enddo
                0489       write(msgbuf,'(a,4(2x,I10))')
                0490      &    'ctrl-wet 16d: global SUM(K) obcsE T,S,U,V ', ntmpob
4d72283393 Mart*0491       call print_message( msgbuf, standardMessageUnit,
                0492      &    SQUEEZE_RIGHT, myThid )
6a4477f903 Patr*0493 #endif
5cf4364659 Mart*0494 #ifdef ALLOW_OBCS_CONTROL
6a4477f903 Patr*0495       write(msgbuf,'(a)')
                0496      &    'ctrl-wet -------------------------------------------------'
4d72283393 Mart*0497       call print_message( msgbuf, standardMessageUnit,
                0498      &    SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0499 #endif
6a4477f903 Patr*0500
7b8b86ab99 Timo*0501 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0502       write(msgbuf,'(a,2x,I10)')
                0503      &     'ctrl-wet 17a:surface wet I = ', nwetitile(1,1,1)
4d72283393 Mart*0504       call print_message( msgbuf, standardMessageUnit,
                0505      &     SQUEEZE_RIGHT, myThid )
1d82288286 Mart*0506
de57a2ec4b Mart*0507       do k = 1, Nr
1d82288286 Mart*0508        ntmpshi=0
                0509        do bj=1,nSy
                0510         do bi=1,nSx
                0511          ntmpshi=ntmpshi+nWetiTile(bi,bj,k)
                0512         enddo
                0513        enddo
                0514        CALL GLOBAL_SUM_INT( ntmpshi,  myThid )
46c1d12550 Jean*0515        if (k.eq.1) then
1d82288286 Mart*0516         nWetiGlobal(k)=ntmpshi
                0517        else
                0518         nWetiGlobal(k)=0
                0519        endif
                0520        write(msgbuf,'(a,2x,I3,2x,I10)')
                0521      &      'ctrl-wet 17b: global nWet I k=', k, ntmpshi
4d72283393 Mart*0522        call print_message( msgbuf, standardMessageUnit,
                0523      &      SQUEEZE_RIGHT, myThid )
1d82288286 Mart*0524       enddo
                0525
                0526       ntmpshi=0
de57a2ec4b Mart*0527       do k = 1, Nr
1d82288286 Mart*0528        ntmpshi=ntmpshi+nWetiGlobal(k)
                0529       enddo
                0530       write(msgbuf,'(a,2x,I10)')
7b8b86ab99 Timo*0531      &    'ctrl-wet 17c: global SUM(K) shelfice ', ntmpshi
4d72283393 Mart*0532       call print_message( msgbuf, standardMessageUnit,
                0533      &    SQUEEZE_RIGHT, myThid )
1d82288286 Mart*0534
                0535       write(msgbuf,'(a)')
                0536      &    'ctrl-wet -------------------------------------------------'
4d72283393 Mart*0537       call print_message( msgbuf, standardMessageUnit,
                0538      &    SQUEEZE_RIGHT, myThid )
1d82288286 Mart*0539 #endif
                0540
c70eba42f3 Patr*0541       write(msgbuf,'(a,2x,I10)')
6b47d550f4 Mart*0542      &     'ctrl_init_wet: no. of control variables: ', nvartype
4d72283393 Mart*0543       call print_message( msgbuf, standardMessageUnit,
                0544      &     SQUEEZE_RIGHT, myThid )
c70eba42f3 Patr*0545       write(msgbuf,'(a,2x,I10)')
6b47d550f4 Mart*0546      &     'ctrl_init_wet: control vector length:    ', nvarlength
4d72283393 Mart*0547       call print_message( msgbuf, standardMessageUnit,
                0548      &     SQUEEZE_RIGHT, myThid )
c70eba42f3 Patr*0549
de57a2ec4b Mart*0550       _END_MASTER( myThid )
4c6316f049 Patr*0551
1c8d09be4c Gael*0552 #ifdef ALLOW_AUTODIFF
4c6316f049 Patr*0553 c     write masks and weights to files to be read by a master process
                0554 c
335c43b7c9 Jean*0555 c#ifdef REAL4_IS_SLOW
                0556 C     leave this commented out (in case of problems with ACTIVE_WRITE_GEN_RS)
de57a2ec4b Mart*0557 c     call active_write_xyz( 'maskCtrlC', maskC, 1, 0, myThid, dummy)
                0558 c     call active_write_xyz( 'maskCtrlW', maskW, 1, 0, myThid, dummy)
                0559 c     call active_write_xyz( 'maskCtrlS', maskS, 1, 0, myThid, dummy)
335c43b7c9 Jean*0560 c#else
                0561       CALL ACTIVE_WRITE_GEN_RS( 'maskCtrlC', maskC, 'XY', Nr,
de57a2ec4b Mart*0562      I                          1, .FALSE., 0, myThid, dummyRS )
335c43b7c9 Jean*0563       CALL ACTIVE_WRITE_GEN_RS( 'maskCtrlW', maskW, 'XY', Nr,
de57a2ec4b Mart*0564      I                          1, .FALSE., 0, myThid, dummyRS )
335c43b7c9 Jean*0565       CALL ACTIVE_WRITE_GEN_RS( 'maskCtrlS', maskS, 'XY', Nr,
de57a2ec4b Mart*0566      I                          1, .FALSE., 0, myThid, dummyRS )
335c43b7c9 Jean*0567 c#endif
7b8b86ab99 Timo*0568 #ifdef ALLOW_SHELFICE
335c43b7c9 Jean*0569 c#ifdef REAL4_IS_SLOW
de57a2ec4b Mart*0570 c     call active_write_xyz( 'maskCtrlI', maskSHI, 1, 0, myThid, dummy)
335c43b7c9 Jean*0571 c#else
                0572       CALL ACTIVE_WRITE_GEN_RS( 'maskCtrlI', maskSHI, 'XY', Nr,
de57a2ec4b Mart*0573      I                          1, .FALSE., 0, myThid, dummyRS )
335c43b7c9 Jean*0574 c#endif
1d82288286 Mart*0575 #endif
7b8b86ab99 Timo*0576
1c8d09be4c Gael*0577 #endif /* ALLOW_AUTODIFF */
4c6316f049 Patr*0578
335c43b7c9 Jean*0579       RETURN
                0580       END