File indexing completed on 2024-03-02 06:10:19 UTC
view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
4c6316f049 Patr*0002
de57a2ec4b Mart*0003 subroutine ctrl_init_wet( myThid )
4c6316f049 Patr*0004
0005
0006
0007
0008
5cf4364659 Mart*0009 IMPLICIT NONE
4c6316f049 Patr*0010
0011
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
de57a2ec4b Mart*0028 integer myThid
4c6316f049 Patr*0029
0030
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
0049
0050
df2d73a28e Patr*0051 _RS dummyRS
5cf4364659 Mart*0052 CHARACTER*(MAX_LEN_MBUF) msgbuf
4c6316f049 Patr*0053
0054
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
0065
0066
0067
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
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
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
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
0117 if (maskS(i,j,k,bi,bj) .eq. 1.) then
0118 nwetstile(bi,bj,k) = nwetstile(bi,bj,k) + 1
0119 endif
0120
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
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
0138
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
0146
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
0154
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
0162
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
0170 nvartype = 0
0171 nvarlength = 0
5cf4364659 Mart*0172 do ivar = 1, maxcvars
4c6316f049 Patr*0173
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
0186
6b47d550f4 Mart*0187 #ifdef ALLOW_SHELFICE
1d82288286 Mart*0188
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
2146dab1aa Jean*0196
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
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
0245
0246
0247
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
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
46c1d12550 Jean*0317
4c6316f049 Patr*0318
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
0350
0351
0352
0353
0354
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
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
0554
335c43b7c9 Jean*0555
0556
de57a2ec4b Mart*0557
0558
0559
335c43b7c9 Jean*0560
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
7b8b86ab99 Timo*0568 #ifdef ALLOW_SHELFICE
335c43b7c9 Jean*0569
de57a2ec4b Mart*0570
335c43b7c9 Jean*0571
0572 CALL ACTIVE_WRITE_GEN_RS( 'maskCtrlI', maskSHI, 'XY', Nr,
de57a2ec4b Mart*0573 I 1, .FALSE., 0, myThid, dummyRS )
335c43b7c9 Jean*0574
1d82288286 Mart*0575 #endif
7b8b86ab99 Timo*0576
1c8d09be4c Gael*0577 #endif /* ALLOW_AUTODIFF */
4c6316f049 Patr*0578
335c43b7c9 Jean*0579 RETURN
0580 END