Changeset 3193 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM
- Timestamp:
- 2011-12-05T17:31:39+01:00 (12 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
-
LBC/lib_mpp.F90 (modified) (1 diff)
-
SBC/sbcice_cice.F90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3186 r3193 64 64 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 65 65 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 66 PUBLIC mppscatter, mppgather 66 67 PUBLIC mppobc, mpp_ini_ice, mpp_ini_znl 67 68 PUBLIC mppsize -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r3189 r3193 19 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 20 USE wrk_nemo ! work arrays 21 USE timing ! Timing 21 22 USE daymod ! calendar 22 23 USE fldread ! read input fields … … 110 111 INTEGER, INTENT(in) :: nsbc ! surface forcing type 111 112 !!---------------------------------------------------------------------- 112 113 ! 114 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_cice') 115 ! 113 116 ! !----------------------! 114 117 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only ! … … 129 132 130 133 ENDIF ! End sea-ice time step only 134 ! 135 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_cice') 131 136 132 137 END SUBROUTINE sbc_ice_cice … … 142 147 INTEGER :: ji, jj, jpl ! dummy loop indices 143 148 149 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_init') 150 ! 144 151 IF(lwp) WRITE(numout,*)'cice_sbc_init' 145 152 … … 148 155 149 156 ! Do some CICE consistency checks 150 IF ( (nsbc == 2) .OR. (nsbc == 5) ) THEN151 IF ( calc_strair .OR. calc_Tsfc ) THEN152 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )153 ENDIF154 ELSEIF (nsbc == 4) THEN155 IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN156 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' )157 ENDIF158 ENDIF157 IF ( (nsbc == 2) .OR. (nsbc == 5) ) THEN 158 IF ( calc_strair .OR. calc_Tsfc ) THEN 159 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 160 ENDIF 161 ELSEIF (nsbc == 4) THEN 162 IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 163 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 164 ENDIF 165 ENDIF 159 166 160 167 … … 169 176 ENDIF 170 177 171 fr_iu(:,:)=0.0172 fr_iv(:,:)=0.0173 174 CALL cice2nemo(aice,fr_i, 'T', 1. )175 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN176 DO jpl=1,ncat177 CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. )178 ENDDO179 ENDIF178 fr_iu(:,:)=0.0 179 fr_iv(:,:)=0.0 180 181 CALL cice2nemo(aice,fr_i, 'T', 1. ) 182 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 183 DO jpl=1,ncat 184 CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 185 ENDDO 186 ENDIF 180 187 181 188 ! T point to U point 182 189 ! T point to V point 183 DO jj=1,jpjm1 184 DO ji=1,jpim1 185 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 186 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 187 ENDDO 188 ENDDO 189 190 CALL lbc_lnk ( fr_iu , 'U', 1. ) 191 CALL lbc_lnk ( fr_iv , 'V', 1. ) 192 190 DO jj=1,jpjm1 191 DO ji=1,jpim1 192 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 193 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 194 ENDDO 195 ENDDO 196 197 CALL lbc_lnk ( fr_iu , 'U', 1. ) 198 CALL lbc_lnk ( fr_iv , 'V', 1. ) 199 ! 200 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_init') 201 ! 193 202 END SUBROUTINE cice_sbc_init 194 203 … … 207 216 !!--------------------------------------------------------------------- 208 217 218 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_in') 219 ! 209 220 CALL wrk_alloc( jpi,jpj, ztmp ) 210 221 CALL wrk_alloc( jpi,jpj,ncat, ztmpn ) 211 222 212 IF( kt == nit000 ) THEN223 IF( kt == nit000 ) THEN 213 224 IF(lwp) WRITE(numout,*)'cice_sbc_in' 214 ENDIF215 216 ztmp(:,:)=0.0225 ENDIF 226 227 ztmp(:,:)=0.0 217 228 218 229 ! Aggregate ice concentration already set in cice_sbc_out (or cice_sbc_init on … … 221 232 ! forced and coupled case 222 233 223 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN224 225 ztmpn(:,:,:)=0.0234 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 235 236 ztmpn(:,:,:)=0.0 226 237 227 238 ! x comp of wind stress (CI_1) 228 239 ! U point to F point 229 DO jj=1,jpjm1230 DO ji=1,jpi231 ztmp(ji,jj)=0.5*(fr_iu(ji,jj)*utau(ji,jj) &232 +fr_iu(ji,jj+1)*utau(ji,jj+1))*fmask(ji,jj,1)233 ENDDO234 ENDDO235 CALL nemo2cice(ztmp,strax,'F', -1. )240 DO jj=1,jpjm1 241 DO ji=1,jpi 242 ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) & 243 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1) 244 ENDDO 245 ENDDO 246 CALL nemo2cice(ztmp,strax,'F', -1. ) 236 247 237 248 ! y comp of wind stress (CI_2) 238 249 ! V point to F point 239 DO jj=1,jpj240 DO ji=1,jpim1241 ztmp(ji,jj)=0.5*(fr_iv(ji,jj)*vtau(ji,jj) &242 +fr_iv(ji+1,jj)*vtau(ji+1,jj))*fmask(ji,jj,1)243 ENDDO244 ENDDO245 CALL nemo2cice(ztmp,stray,'F', -1. )250 DO jj=1,jpj 251 DO ji=1,jpim1 252 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 253 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) 254 ENDDO 255 ENDDO 256 CALL nemo2cice(ztmp,stray,'F', -1. ) 246 257 247 258 ! Surface downward latent heat flux (CI_5) 248 IF (nsbc == 2) THEN249 DO jpl=1,ncat250 ztmpn(:,:,jpl)=qla_ice(:,:,1)*a_i(:,:,jpl)251 ENDDO252 ELSE259 IF (nsbc == 2) THEN 260 DO jpl=1,ncat 261 ztmpn(:,:,jpl)=qla_ice(:,:,1)*a_i(:,:,jpl) 262 ENDDO 263 ELSE 253 264 ! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow 254 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub265 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub 255 266 ! End of temporary code 256 DO jj=1,jpj257 DO ji=1,jpi258 IF (fr_i(ji,jj).eq.0.0) THEN259 DO jpl=1,ncat260 ztmpn(ji,jj,jpl)=0.0261 ENDDO262 ! This will then be conserved in CICE263 ztmpn(ji,jj,1)=qla_ice(ji,jj,1)264 ELSE265 DO jpl=1,ncat266 ztmpn(ji,jj,jpl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj)267 ENDDO268 ENDIF269 ENDDO270 ENDDO271 ENDIF272 DO jpl=1,ncat273 CALL nemo2cice(ztmpn(:,:,jpl),flatn_f(:,:,jpl,:),'T', 1. )267 DO jj=1,jpj 268 DO ji=1,jpi 269 IF (fr_i(ji,jj).eq.0.0) THEN 270 DO jpl=1,ncat 271 ztmpn(ji,jj,jpl)=0.0 272 ENDDO 273 ! This will then be conserved in CICE 274 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 275 ELSE 276 DO jpl=1,ncat 277 ztmpn(ji,jj,jpl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj) 278 ENDDO 279 ENDIF 280 ENDDO 281 ENDDO 282 ENDIF 283 DO jpl=1,ncat 284 CALL nemo2cice(ztmpn(:,:,jpl),flatn_f(:,:,jpl,:),'T', 1. ) 274 285 275 286 ! GBM conductive flux through ice (CI_6) 276 287 ! Convert to GBM 277 IF (nsbc == 2) THEN278 ztmp(:,:) = botmelt(:,:,jpl)*a_i(:,:,jpl)279 ELSE280 ztmp(:,:) = botmelt(:,:,jpl)281 ENDIF282 CALL nemo2cice(ztmp,fcondtopn_f(:,:,jpl,:),'T', 1. )288 IF (nsbc == 2) THEN 289 ztmp(:,:) = botmelt(:,:,jpl)*a_i(:,:,jpl) 290 ELSE 291 ztmp(:,:) = botmelt(:,:,jpl) 292 ENDIF 293 CALL nemo2cice(ztmp,fcondtopn_f(:,:,jpl,:),'T', 1. ) 283 294 284 295 ! GBM surface heat flux (CI_7) 285 296 ! Convert to GBM 286 IF (nsbc == 2) THEN287 ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))*a_i(:,:,jpl)288 ELSE289 ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))290 ENDIF291 CALL nemo2cice(ztmp,fsurfn_f(:,:,jpl,:),'T', 1. )292 ENDDO293 294 ELSE IF (nsbc == 4) THEN297 IF (nsbc == 2) THEN 298 ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))*a_i(:,:,jpl) 299 ELSE 300 ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl)) 301 ENDIF 302 CALL nemo2cice(ztmp,fsurfn_f(:,:,jpl,:),'T', 1. ) 303 ENDDO 304 305 ELSE IF (nsbc == 4) THEN 295 306 296 307 ! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) 297 308 ! x comp and y comp of atmosphere surface wind (CICE expects on T points) 298 ztmp(:,:) = wndi_ice(:,:)299 CALL nemo2cice(ztmp,uatm,'T', -1. )300 ztmp(:,:) = wndj_ice(:,:)301 CALL nemo2cice(ztmp,vatm,'T', -1. )302 ztmp(:,:) = SQRT ( wndi_ice(:,:)**2 + wndj_ice(:,:)**2 )303 CALL nemo2cice(ztmp,wind,'T', 1. )! Wind speed (m/s)304 ztmp(:,:) = qsr_ice(:,:,1)305 CALL nemo2cice(ztmp,fsw,'T', 1. )! Incoming short-wave (W/m^2)306 ztmp(:,:) = qlw_ice(:,:,1)307 CALL nemo2cice(ztmp,flw,'T', 1. )! Incoming long-wave (W/m^2)308 ztmp(:,:) = tatm_ice(:,:)309 CALL nemo2cice(ztmp,Tair,'T', 1. ) ! Air temperature (K)310 CALL nemo2cice(ztmp,potT,'T', 1. ) ! Potential temp (K)309 ztmp(:,:) = wndi_ice(:,:) 310 CALL nemo2cice(ztmp,uatm,'T', -1. ) 311 ztmp(:,:) = wndj_ice(:,:) 312 CALL nemo2cice(ztmp,vatm,'T', -1. ) 313 ztmp(:,:) = SQRT ( wndi_ice(:,:)**2 + wndj_ice(:,:)**2 ) 314 CALL nemo2cice(ztmp,wind,'T', 1. ) ! Wind speed (m/s) 315 ztmp(:,:) = qsr_ice(:,:,1) 316 CALL nemo2cice(ztmp,fsw,'T', 1. ) ! Incoming short-wave (W/m^2) 317 ztmp(:,:) = qlw_ice(:,:,1) 318 CALL nemo2cice(ztmp,flw,'T', 1. ) ! Incoming long-wave (W/m^2) 319 ztmp(:,:) = tatm_ice(:,:) 320 CALL nemo2cice(ztmp,Tair,'T', 1. ) ! Air temperature (K) 321 CALL nemo2cice(ztmp,potT,'T', 1. ) ! Potential temp (K) 311 322 ! Following line uses MAX(....) to avoid problems if tatm_ice has unset halo rows 312 ztmp(:,:) = 101000. / ( 287.04 * MAX(1.0,tatm_ice(:,:)) )313 314 CALL nemo2cice(ztmp,rhoa,'T', 1. )! Air density (kg/m^3)315 ztmp(:,:) = qatm_ice(:,:)316 CALL nemo2cice(ztmp,Qa,'T', 1. ) ! Specific humidity (kg/kg)317 ztmp(:,:)=10.0318 CALL nemo2cice(ztmp,zlvl,'T', 1. )! Atmos level height (m)323 ztmp(:,:) = 101000. / ( 287.04 * MAX(1.0,tatm_ice(:,:)) ) 324 ! Constant (101000.) atm pressure assumed 325 CALL nemo2cice(ztmp,rhoa,'T', 1. ) ! Air density (kg/m^3) 326 ztmp(:,:) = qatm_ice(:,:) 327 CALL nemo2cice(ztmp,Qa,'T', 1. ) ! Specific humidity (kg/kg) 328 ztmp(:,:)=10.0 329 CALL nemo2cice(ztmp,zlvl,'T', 1. ) ! Atmos level height (m) 319 330 320 331 ! May want to check all values are physically realistic (as in CICE routine … … 322 333 323 334 ! Divide shortwave into spectral bands (as in prepare_forcing) 324 ztmp(:,:)=qsr_ice(:,:,1)*frcvdr 335 ztmp(:,:)=qsr_ice(:,:,1)*frcvdr ! visible direct 325 336 CALL nemo2cice(ztmp,swvdr,'T', 1. ) 326 ztmp(:,:)=qsr_ice(:,:,1)*frcvdf 337 ztmp(:,:)=qsr_ice(:,:,1)*frcvdf ! visible diffuse 327 338 CALL nemo2cice(ztmp,swvdf,'T', 1. ) 328 ztmp(:,:)=qsr_ice(:,:,1)*frcidr 339 ztmp(:,:)=qsr_ice(:,:,1)*frcidr ! near IR direct 329 340 CALL nemo2cice(ztmp,swidr,'T', 1. ) 330 ztmp(:,:)=qsr_ice(:,:,1)*frcidf 341 ztmp(:,:)=qsr_ice(:,:,1)*frcidf ! near IR diffuse 331 342 CALL nemo2cice(ztmp,swidf,'T', 1. ) 332 343 … … 335 346 ! Snowfall 336 347 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) 337 ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0)338 CALL nemo2cice(ztmp,fsnow,'T', 1. )348 ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0) 349 CALL nemo2cice(ztmp,fsnow,'T', 1. ) 339 350 340 351 ! Rainfall 341 ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))342 CALL nemo2cice(ztmp,frain,'T', 1. )352 ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 353 CALL nemo2cice(ztmp,frain,'T', 1. ) 343 354 344 355 ! Freezing/melting potential … … 347 358 ! May be better using sst_m if not coupling to CICE every time-step 348 359 349 ! nfrzmlt(:,:)=rau0*rcp*fse3t(:,:,1)*(Tocnfrz-sst_m(:,:))/(2.0*dt)350 nfrzmlt(:,:)=rau0*rcp*fse3t(:,:,1)*(Tocnfrz-tsb(:,:,1,jp_tem))/(2.0*dt)351 352 ztmp(:,:) = nfrzmlt(:,:)353 CALL nemo2cice(ztmp,frzmlt,'T', 1. )360 ! nfrzmlt(:,:)=rau0*rcp*fse3t(:,:,1)*(Tocnfrz-sst_m(:,:))/(2.0*dt) 361 nfrzmlt(:,:)=rau0*rcp*fse3t(:,:,1)*(Tocnfrz-tsb(:,:,1,jp_tem))/(2.0*dt) 362 363 ztmp(:,:) = nfrzmlt(:,:) 364 CALL nemo2cice(ztmp,frzmlt,'T', 1. ) 354 365 355 366 ! SST and SSS 356 367 357 CALL nemo2cice(sst_m,sst,'T', 1. )358 CALL nemo2cice(sss_m,sss,'T', 1. )368 CALL nemo2cice(sst_m,sst,'T', 1. ) 369 CALL nemo2cice(sss_m,sss,'T', 1. ) 359 370 360 371 ! x comp and y comp of surface ocean current 361 372 ! U point to F point 362 DO jj=1,jpjm1363 DO ji=1,jpi364 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1)365 ENDDO366 ENDDO367 CALL nemo2cice(ztmp,uocn,'F', -1. )373 DO jj=1,jpjm1 374 DO ji=1,jpi 375 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 376 ENDDO 377 ENDDO 378 CALL nemo2cice(ztmp,uocn,'F', -1. ) 368 379 369 380 ! V point to F point 370 DO jj=1,jpj371 DO ji=1,jpim1372 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1)373 ENDDO374 ENDDO375 CALL nemo2cice(ztmp,vocn,'F', -1. )381 DO jj=1,jpj 382 DO ji=1,jpim1 383 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 384 ENDDO 385 ENDDO 386 CALL nemo2cice(ztmp,vocn,'F', -1. ) 376 387 377 388 ! x comp and y comp of sea surface slope (on F points) 378 389 ! T point to F point 379 DO jj=1,jpjm1380 DO ji=1,jpim1381 ztmp(ji,jj)=0.5 * ( (ssh_m(ji+1,jj )-ssh_m(ji,jj ))/e1u(ji,jj ) &382 + (ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) &383 * fmask(ji,jj,1)384 ENDDO385 ENDDO386 CALL nemo2cice(ztmp,ss_tltx,'F', -1. )390 DO jj=1,jpjm1 391 DO ji=1,jpim1 392 ztmp(ji,jj)=0.5 * ( (ssh_m(ji+1,jj )-ssh_m(ji,jj ))/e1u(ji,jj ) & 393 + (ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) & 394 * fmask(ji,jj,1) 395 ENDDO 396 ENDDO 397 CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 387 398 388 399 ! T point to F point 389 DO jj=1,jpjm1390 DO ji=1,jpim1391 ztmp(ji,jj)=0.5 * ( (ssh_m(ji ,jj+1)-ssh_m(ji ,jj))/e2v(ji ,jj) &392 + (ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) &393 * fmask(ji,jj,1)394 ENDDO395 ENDDO396 CALL nemo2cice(ztmp,ss_tlty,'F', -1. )400 DO jj=1,jpjm1 401 DO ji=1,jpim1 402 ztmp(ji,jj)=0.5 * ( (ssh_m(ji ,jj+1)-ssh_m(ji ,jj))/e2v(ji ,jj) & 403 + (ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) & 404 * fmask(ji,jj,1) 405 ENDDO 406 ENDDO 407 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 397 408 398 409 CALL wrk_dealloc( jpi,jpj, ztmp ) 399 410 CALL wrk_dealloc( jpi,jpj,ncat, ztmpn ) 400 ! 411 ! 412 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_in') 413 ! 401 414 END SUBROUTINE cice_sbc_in 402 415 … … 414 427 !!--------------------------------------------------------------------- 415 428 429 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_out') 430 ! 416 431 CALL wrk_alloc( jpi,jpj, ztmp ) 417 432 … … 421 436 422 437 ! x comp of ocean-ice stress 423 CALL cice2nemo(strocnx,ztmp,'F', -1. )424 ss_iou(:,:)=0.0438 CALL cice2nemo(strocnx,ztmp,'F', -1. ) 439 ss_iou(:,:)=0.0 425 440 ! F point to U point 426 DO jj=2,jpjm1427 DO ji=2,jpim1428 ss_iou(ji,jj)=0.5*( ztmp(ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1)429 ENDDO430 ENDDO431 CALL lbc_lnk( ss_iou , 'U', -1. )441 DO jj=2,jpjm1 442 DO ji=2,jpim1 443 ss_iou(ji,jj) = 0.5 * ( ztmp(ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1) 444 ENDDO 445 ENDDO 446 CALL lbc_lnk( ss_iou , 'U', -1. ) 432 447 433 448 ! y comp of ocean-ice stress 434 CALL cice2nemo(strocny,ztmp,'F', -1. )435 ss_iov(:,:)=0.0449 CALL cice2nemo(strocny,ztmp,'F', -1. ) 450 ss_iov(:,:)=0.0 436 451 ! F point to V point 437 452 438 DO jj=1,jpjm1439 DO ji=2,jpim1440 ss_iov(ji,jj)=0.5*( ztmp(ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1)441 ENDDO442 ENDDO443 CALL lbc_lnk( ss_iov , 'V', -1. )453 DO jj=1,jpjm1 454 DO ji=2,jpim1 455 ss_iov(ji,jj) = 0.5 * ( ztmp(ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1) 456 ENDDO 457 ENDDO 458 CALL lbc_lnk( ss_iov , 'V', -1. ) 444 459 445 460 ! x and y comps of surface stress … … 447 462 ! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep] 448 463 449 utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)450 vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)464 utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:) 465 vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:) 451 466 452 467 ! Freshwater fluxes 453 468 454 IF (nsbc == 2) THEN469 IF (nsbc == 2) THEN 455 470 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 456 471 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below 457 472 ! Not ideal since aice won't be the same as in the atmosphere. 458 473 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 459 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))460 ELSE IF (nsbc == 4) THEN461 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:)462 ELSE IF (nsbc ==5) THEN474 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 475 ELSE IF (nsbc == 4) THEN 476 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 477 ELSE IF (nsbc ==5) THEN 463 478 ! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above) 464 emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:)465 ENDIF479 emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:) 480 ENDIF 466 481 467 482 ! Subtract fluxes from CICE to get freshwater equivalent flux used in 468 483 ! salinity calculation 469 CALL cice2nemo(fresh_gbm,ztmp,'T', 1. )470 emps(:,:)=emp(:,:)-ztmp(:,:)484 CALL cice2nemo(fresh_gbm,ztmp,'T', 1. ) 485 emps(:,:)=emp(:,:)-ztmp(:,:) 471 486 ! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU) 472 CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. )473 DO jj=1,jpj474 DO ji=1,jpi475 IF (sss_m(ji,jj).gt.0.0) THEN476 emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj)477 ENDIF478 ENDDO479 ENDDO487 CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. ) 488 DO jj=1,jpj 489 DO ji=1,jpi 490 IF (sss_m(ji,jj).gt.0.0) THEN 491 emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj) 492 ENDIF 493 ENDDO 494 ENDDO 480 495 481 496 ! No longer remove precip over ice from free surface calculation on basis that the … … 487 502 ! ocean rather than floating on top 488 503 489 emp(:,:) = emp(:,:) - tprecip(:,:)*fr_i(:,:)504 emp(:,:) = emp(:,:) - tprecip(:,:)*fr_i(:,:) 490 505 491 506 ! Take sublimation into account 492 IF (nsbc == 5 ) THEN493 emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) )494 ELSE IF (nsbc == 2 ) THEN495 emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub496 ENDIF497 498 CALL lbc_lnk( emp , 'T', 1. )499 CALL lbc_lnk( emps , 'T', 1. )507 IF (nsbc == 5 ) THEN 508 emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) ) 509 ELSE IF (nsbc == 2 ) THEN 510 emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub 511 ENDIF 512 513 CALL lbc_lnk( emp , 'T', 1. ) 514 CALL lbc_lnk( emps , 'T', 1. ) 500 515 501 516 ! Solar penetrative radiation and non solar surface heat flux … … 503 518 ! Scale qsr and qns according to ice fraction (bulk formulae only) 504 519 505 IF (nsbc == 4) THEN506 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:))507 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:))508 ENDIF520 IF (nsbc == 4) THEN 521 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 522 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 523 ENDIF 509 524 ! Take into account snow melting except for fully coupled when already in qns_tot 510 IF (nsbc == 5) THEN511 qsr(:,:)= qsr_tot(:,:)512 qns(:,:)= qns_tot(:,:)513 ELSE514 qns(:,:)= qns(:,:)-sprecip(:,:)*Lfresh*(1.0-fr_i(:,:))515 ENDIF525 IF (nsbc == 5) THEN 526 qsr(:,:)= qsr_tot(:,:) 527 qns(:,:)= qns_tot(:,:) 528 ELSE 529 qns(:,:)= qns(:,:)-sprecip(:,:)*Lfresh*(1.0-fr_i(:,:)) 530 ENDIF 516 531 517 532 ! Now add in ice / snow related terms 518 533 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 519 CALL cice2nemo(fswthru_gbm,ztmp,'T', 1. )520 qsr(:,:)=qsr(:,:)+ztmp(:,:)521 CALL lbc_lnk( qsr , 'T', 1. )522 523 DO jj=1,jpj524 DO ji=1,jpi534 CALL cice2nemo(fswthru_gbm,ztmp,'T', 1. ) 535 qsr(:,:)=qsr(:,:)+ztmp(:,:) 536 CALL lbc_lnk( qsr , 'T', 1. ) 537 538 DO jj=1,jpj 539 DO ji=1,jpi 525 540 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 526 ENDDO527 ENDDO528 529 CALL cice2nemo(fhocn_gbm,ztmp,'T', 1. )530 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp(:,:)531 532 CALL lbc_lnk( qns , 'T', 1. )541 ENDDO 542 ENDDO 543 544 CALL cice2nemo(fhocn_gbm,ztmp,'T', 1. ) 545 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp(:,:) 546 547 CALL lbc_lnk( qns , 'T', 1. ) 533 548 534 549 ! Prepare for the following CICE time-step 535 550 536 CALL cice2nemo(aice,fr_i,'T', 1. )537 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN538 DO jpl=1,ncat539 CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. )540 ENDDO541 ENDIF551 CALL cice2nemo(aice,fr_i,'T', 1. ) 552 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 553 DO jpl=1,ncat 554 CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 555 ENDDO 556 ENDIF 542 557 543 558 ! T point to U point 544 559 ! T point to V point 545 DO jj=1,jpjm1546 DO ji=1,jpim1547 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)548 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)549 ENDDO550 ENDDO551 552 CALL lbc_lnk ( fr_iu , 'U', 1. )553 CALL lbc_lnk ( fr_iv , 'V', 1. )560 DO jj=1,jpjm1 561 DO ji=1,jpim1 562 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 563 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 564 ENDDO 565 ENDDO 566 567 CALL lbc_lnk ( fr_iu , 'U', 1. ) 568 CALL lbc_lnk ( fr_iv , 'V', 1. ) 554 569 555 570 ! Release work space 556 571 557 572 CALL wrk_dealloc( jpi,jpj, ztmp ) 558 ! 573 ! 574 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_out') 575 ! 559 576 END SUBROUTINE cice_sbc_out 560 577 … … 570 587 !!--------------------------------------------------------------------- 571 588 572 INTEGER :: jpl ! dummy loop index 573 INTEGER :: ierror 574 575 IF( kt == nit000 ) THEN 589 INTEGER :: jpl ! dummy loop index 590 INTEGER :: ierror 591 592 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_hadgam') 593 ! 594 IF( kt == nit000 ) THEN 576 595 IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 577 596 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 578 ENDIF597 ENDIF 579 598 580 599 ! ! =========================== ! … … 584 603 ! x and y comp of ice velocity 585 604 586 587 605 CALL cice2nemo(uvel,u_ice,'F', -1. ) 606 CALL cice2nemo(vvel,v_ice,'F', -1. ) 588 607 589 608 ! Ice concentration (CO_1) = a_i calculated at end of cice_sbc_out … … 591 610 ! Snow and ice thicknesses (CO_2 and CO_3) 592 611 593 DO jpl = 1,ncat 594 CALL cice2nemo(vsnon(:,:,jpl,:),ht_s(:,:,jpl),'T', 1. ) 595 CALL cice2nemo(vicen(:,:,jpl,:),ht_i(:,:,jpl),'T', 1. ) 596 ENDDO 597 612 DO jpl = 1,ncat 613 CALL cice2nemo(vsnon(:,:,jpl,:),ht_s(:,:,jpl),'T', 1. ) 614 CALL cice2nemo(vicen(:,:,jpl,:),ht_i(:,:,jpl),'T', 1. ) 615 ENDDO 616 ! 617 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_hadgam') 618 ! 598 619 END SUBROUTINE cice_sbc_hadgam 599 620 … … 613 634 IF(lwp) WRITE(numout,*)'cice_sbc_final' 614 635 615 callCICE_Finalize636 CALL CICE_Finalize 616 637 617 638 END SUBROUTINE cice_sbc_final … … 750 771 !!--------------------------------------------------------------------- 751 772 752 CHARACTER(len=1), INTENT( in ) :: &753 cd_type ! nature of pn grid-point754 ! ! = T or F gridpoints755 REAL(wp), INTENT( in ) :: &756 psgn ! control of the sign change757 ! ! =-1 , the sign is modified following the type of b.c. used758 ! ! = 1 , no sign change759 REAL(wp), DIMENSION(jpi,jpj) :: pn773 CHARACTER(len=1), INTENT( in ) :: & 774 cd_type ! nature of pn grid-point 775 ! ! = T or F gridpoints 776 REAL(wp), INTENT( in ) :: & 777 psgn ! control of the sign change 778 ! ! =-1 , the sign is modified following the type of b.c. used 779 ! ! = 1 , no sign change 780 REAL(wp), DIMENSION(jpi,jpj) :: pn 760 781 #if !defined key_nemocice_decomp 761 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg782 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 762 783 #endif 763 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc764 INTEGER (int_kind) :: &765 field_type, &! id for type of field (scalar, vector, angle)766 grid_loc ! id for location on horizontal grid784 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 785 INTEGER (int_kind) :: & 786 field_type, &! id for type of field (scalar, vector, angle) 787 grid_loc ! id for location on horizontal grid 767 788 ! (center, NEcorner, Nface, Eface) 768 789 769 INTEGER :: ji, jj, jn ! dummy loop indices770 771 ! A. Ensure all haloes are filled in NEMO field (pn)772 773 CALL lbc_lnk( pn , cd_type, psgn )790 INTEGER :: ji, jj, jn ! dummy loop indices 791 792 ! A. Ensure all haloes are filled in NEMO field (pn) 793 794 CALL lbc_lnk( pn , cd_type, psgn ) 774 795 775 796 #if defined key_nemocice_decomp 776 797 777 ! Copy local domain data from NEMO to CICE field778 pc(:,:,1)=0.0779 DO jj=2,ny_block780 DO ji=2,nx_block781 pc(ji,jj,1)=pn(ji,jj-1)782 ENDDO783 ENDDO798 ! Copy local domain data from NEMO to CICE field 799 pc(:,:,1)=0.0 800 DO jj=2,ny_block 801 DO ji=2,nx_block 802 pc(ji,jj,1)=pn(ji,jj-1) 803 ENDDO 804 ENDDO 784 805 785 806 #else 786 807 787 ! B. Gather pn into global array (png)788 789 IF ( jpnij > 1) THEN790 CALL mppsync791 CALL mppgather (pn,0,png)792 CALL mppsync793 ELSE794 png(:,:,1)=pn(:,:)795 ENDIF796 797 ! C. Map png into CICE global array (pcg)808 ! B. Gather pn into global array (png) 809 810 IF ( jpnij > 1) THEN 811 CALL mppsync 812 CALL mppgather (pn,0,png) 813 CALL mppsync 814 ELSE 815 png(:,:,1)=pn(:,:) 816 ENDIF 817 818 ! C. Map png into CICE global array (pcg) 798 819 799 820 ! Need to make sure this is robust to changes in NEMO halo rows.... 800 821 ! (may be OK but not 100% sure) 801 822 802 IF (nproc==0) THEN823 IF (nproc==0) THEN 803 824 ! pcg(:,:)=0.0 804 DO jn=1,jpnij805 DO jj=1,nlcjt(jn)-1806 DO ji=2,nlcit(jn)-1807 pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)808 ENDDO809 ENDDO810 ENDDO811 ENDIF825 DO jn=1,jpnij 826 DO jj=1,nlcjt(jn)-1 827 DO ji=2,nlcit(jn)-1 828 pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn) 829 ENDDO 830 ENDDO 831 ENDDO 832 ENDIF 812 833 813 834 #endif 814 835 815 SELECT CASE ( cd_type )816 CASE ( 'T' )817 grid_loc=field_loc_center818 CASE ( 'F' )819 grid_loc=field_loc_NEcorner820 END SELECT821 822 SELECT CASE ( NINT(psgn) )823 CASE ( -1 )824 field_type=field_type_vector825 CASE ( 1 )826 field_type=field_type_scalar827 END SELECT836 SELECT CASE ( cd_type ) 837 CASE ( 'T' ) 838 grid_loc=field_loc_center 839 CASE ( 'F' ) 840 grid_loc=field_loc_NEcorner 841 END SELECT 842 843 SELECT CASE ( NINT(psgn) ) 844 CASE ( -1 ) 845 field_type=field_type_vector 846 CASE ( 1 ) 847 field_type=field_type_scalar 848 END SELECT 828 849 829 850 #if defined key_nemocice_decomp 830 ! Ensure CICE halos are up to date831 callice_HaloUpdate (pc, halo_info, grid_loc, field_type)851 ! Ensure CICE halos are up to date 852 CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type) 832 853 #else 833 ! D. Scatter pcg to CICE blocks (pc) + update halos834 callscatter_global(pc, pcg, 0, distrb_info, grid_loc, field_type)854 ! D. Scatter pcg to CICE blocks (pc) + update halos 855 CALL scatter_global(pc, pcg, 0, distrb_info, grid_loc, field_type) 835 856 #endif 836 857 … … 856 877 !!--------------------------------------------------------------------- 857 878 858 CHARACTER(len=1), INTENT( in ) :: &859 cd_type ! nature of pn grid-point860 ! ! = T or F gridpoints861 REAL(wp), INTENT( in ) :: &862 psgn ! control of the sign change863 ! ! =-1 , the sign is modified following the type of b.c. used864 ! ! = 1 , no sign change865 REAL(wp), DIMENSION(jpi,jpj) :: pn879 CHARACTER(len=1), INTENT( in ) :: & 880 cd_type ! nature of pn grid-point 881 ! ! = T or F gridpoints 882 REAL(wp), INTENT( in ) :: & 883 psgn ! control of the sign change 884 ! ! =-1 , the sign is modified following the type of b.c. used 885 ! ! = 1 , no sign change 886 REAL(wp), DIMENSION(jpi,jpj) :: pn 866 887 867 888 #if defined key_nemocice_decomp 868 INTEGER (int_kind) :: &869 field_type, & ! id for type of field (scalar, vector, angle)870 grid_loc ! id for location on horizontal grid871 ! (center, NEcorner, Nface, Eface)889 INTEGER (int_kind) :: & 890 field_type, & ! id for type of field (scalar, vector, angle) 891 grid_loc ! id for location on horizontal grid 892 ! (center, NEcorner, Nface, Eface) 872 893 #else 873 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg894 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 874 895 #endif 875 896 876 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc877 878 INTEGER :: ji, jj, jn ! dummy loop indices897 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 898 899 INTEGER :: ji, jj, jn ! dummy loop indices 879 900 880 901 881 902 #if defined key_nemocice_decomp 882 903 883 SELECT CASE ( cd_type )884 CASE ( 'T' )885 grid_loc=field_loc_center886 CASE ( 'F' )887 grid_loc=field_loc_NEcorner888 END SELECT889 890 SELECT CASE ( NINT(psgn) )891 CASE ( -1 )892 field_type=field_type_vector893 CASE ( 1 )894 field_type=field_type_scalar895 END SELECT896 897 callice_HaloUpdate (pc, halo_info, grid_loc, field_type)898 899 900 pn(:,:)=0.0901 DO jj=1,jpjm1902 DO ji=1,jpim1903 pn(ji,jj)=pc(ji,jj+1,1)904 ENDDO905 ENDDO904 SELECT CASE ( cd_type ) 905 CASE ( 'T' ) 906 grid_loc=field_loc_center 907 CASE ( 'F' ) 908 grid_loc=field_loc_NEcorner 909 END SELECT 910 911 SELECT CASE ( NINT(psgn) ) 912 CASE ( -1 ) 913 field_type=field_type_vector 914 CASE ( 1 ) 915 field_type=field_type_scalar 916 END SELECT 917 918 CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type) 919 920 921 pn(:,:)=0.0 922 DO jj=1,jpjm1 923 DO ji=1,jpim1 924 pn(ji,jj)=pc(ji,jj+1,1) 925 ENDDO 926 ENDDO 906 927 907 928 #else 908 929 909 ! A. Gather CICE blocks (pc) into global array (pcg)910 911 callgather_global(pcg, pc, 0, distrb_info)930 ! A. Gather CICE blocks (pc) into global array (pcg) 931 932 CALL gather_global(pcg, pc, 0, distrb_info) 912 933 913 934 ! B. Map pcg into NEMO global array (png) … … 916 937 ! (may be OK but not spent much time thinking about it) 917 938 918 IF (nproc==0) THEN919 png(:,:,:)=0.0920 DO jn=1,jpnij921 DO jj=1,nlcjt(jn)-1922 DO ji=2,nlcit(jn)-1923 png(ji,jj,jn)=pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)924 ENDDO925 ENDDO926 ENDDO927 ENDIF928 929 ! C. Scatter png into NEMO field (pn) for each processor930 931 IF ( jpnij > 1) THEN932 CALL mppsync933 CALL mppscatter (png,0,pn)934 CALL mppsync935 ELSE936 pn(:,:)=png(:,:,1)937 ENDIF939 IF (nproc==0) THEN 940 png(:,:,:)=0.0 941 DO jn=1,jpnij 942 DO jj=1,nlcjt(jn)-1 943 DO ji=2,nlcit(jn)-1 944 png(ji,jj,jn)=pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1) 945 ENDDO 946 ENDDO 947 ENDDO 948 ENDIF 949 950 ! C. Scatter png into NEMO field (pn) for each processor 951 952 IF ( jpnij > 1) THEN 953 CALL mppsync 954 CALL mppscatter (png,0,pn) 955 CALL mppsync 956 ELSE 957 pn(:,:)=png(:,:,1) 958 ENDIF 938 959 939 960 #endif 940 961 941 ! D. Ensure all haloes are filled in pn942 943 CALL lbc_lnk( pn , cd_type, psgn )962 ! D. Ensure all haloes are filled in pn 963 964 CALL lbc_lnk( pn , cd_type, psgn ) 944 965 945 966 END SUBROUTINE cice2nemo
Note: See TracChangeset
for help on using the changeset viewer.
