- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbcice_cice.F90 (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcice_cice.F90
r10425 r13463 12 12 USE oce ! ocean dynamics and tracers 13 13 USE dom_oce ! ocean space and time domain 14 # if ! defined key_qco 14 15 USE domvvl 15 USE phycst, only : rcp, rau0, r1_rau0, rhos, rhoi 16 # else 17 USE domqco 18 # endif 19 USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi 16 20 USE in_out_manager ! I/O manager 17 21 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit … … 88 92 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE :: png ! local array used in sbc_cice_ice 89 93 94 !! * Substitutions 95 # include "do_loop_substitute.h90" 90 96 !!---------------------------------------------------------------------- 91 97 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 132 138 IF ( ksbc == jp_flx ) THEN 133 139 CALL cice_sbc_force(kt) 134 ELSE IF 140 ELSE IF( ksbc == jp_purecpl ) THEN 135 141 CALL sbc_cpl_ice_flx( fr_i ) 136 142 ENDIF … … 140 146 CALL cice_sbc_out ( kt, ksbc ) 141 147 142 IF 148 IF( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1) 143 149 144 150 ENDIF ! End sea-ice time step only … … 147 153 148 154 149 SUBROUTINE cice_sbc_init( ksbc )155 SUBROUTINE cice_sbc_init( ksbc, Kbb, Kmm ) 150 156 !!--------------------------------------------------------------------- 151 157 !! *** ROUTINE cice_sbc_init *** … … 154 160 !!--------------------------------------------------------------------- 155 161 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 162 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 156 163 REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 157 164 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar … … 168 175 ! there is no restart file. 169 176 ! Values from a CICE restart file would overwrite this 170 IF 171 CALL nemo2cice( ts n(:,:,1,jp_tem) , sst , 'T' , 1.)177 IF( .NOT. ln_rstart ) THEN 178 CALL nemo2cice( ts(:,:,1,jp_tem,Kmm) , sst , 'T' , 1.) 172 179 ENDIF 173 180 #endif … … 177 184 178 185 ! Do some CICE consistency checks 179 IF 180 IF 186 IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 187 IF( calc_strair .OR. calc_Tsfc ) THEN 181 188 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 182 189 ENDIF 183 ELSEIF 184 IF 190 ELSEIF(ksbc == jp_blk) THEN 191 IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 185 192 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 186 193 ENDIF … … 194 201 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart 195 202 IF( .NOT. ln_rstart ) THEN 196 ts n(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz)197 ts b(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)203 ts(:,:,:,jp_tem,Kmm) = MAX (ts(:,:,:,jp_tem,Kmm),Tocnfrz) 204 ts(:,:,:,jp_tem,Kbb) = ts(:,:,:,jp_tem,Kmm) 198 205 ENDIF 199 206 … … 202 209 203 210 CALL cice2nemo(aice,fr_i, 'T', 1. ) 204 IF 211 IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 205 212 DO jl=1,ncat 206 213 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 210 217 ! T point to U point 211 218 ! T point to V point 212 DO jj=1,jpjm1 213 DO ji=1,jpim1 214 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 215 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 216 ENDDO 217 ENDDO 218 219 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. ) 219 DO_2D( 1, 0, 1, 0 ) 220 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 221 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 222 END_2D 223 224 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 220 225 221 226 ! set the snow+ice mass … … 227 232 IF( .NOT.ln_rstart ) THEN 228 233 IF( ln_ice_embd ) THEN ! embedded sea-ice: deplete the initial ssh below sea-ice area 229 ssh n(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0230 ssh b(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0234 ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rho0 235 ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 231 236 232 237 !!gm This should be put elsewhere.... (same remark for limsbc) 233 238 !!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 239 #if defined key_qco 240 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 241 #else 234 242 IF( .NOT.ln_linssh ) THEN 235 243 ! 236 244 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 237 e3t _n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )238 e3t _b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )245 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*r1_ht_0(:,:)*tmask(:,:,jk) ) 246 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*r1_ht_0(:,:)*tmask(:,:,jk) ) 239 247 ENDDO 240 e3t _a(:,:,:) = e3t_b(:,:,:)248 e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 241 249 ! Reconstruction of all vertical scale factors at now and before time-steps 242 250 ! ============================================================================= 243 251 ! Horizontal scale factor interpolations 244 252 ! -------------------------------------- 245 CALL dom_vvl_interpol( e3t _b(:,:,:), e3u_b(:,:,:), 'U' )246 CALL dom_vvl_interpol( e3t _b(:,:,:), e3v_b(:,:,:), 'V' )247 CALL dom_vvl_interpol( e3t _n(:,:,:), e3u_n(:,:,:), 'U' )248 CALL dom_vvl_interpol( e3t _n(:,:,:), e3v_n(:,:,:), 'V' )249 CALL dom_vvl_interpol( e3u _n(:,:,:), e3f_n(:,:,:), 'F' )253 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 254 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 255 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 256 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 257 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 250 258 ! Vertical scale factor interpolations 251 259 ! ------------------------------------ 252 CALL dom_vvl_interpol( e3t _n(:,:,:), e3w_n (:,:,:), 'W' )253 CALL dom_vvl_interpol( e3u _n(:,:,:), e3uw_n(:,:,:), 'UW' )254 CALL dom_vvl_interpol( e3v _n(:,:,:), e3vw_n(:,:,:), 'VW' )255 CALL dom_vvl_interpol( e3u _b(:,:,:), e3uw_b(:,:,:), 'UW' )256 CALL dom_vvl_interpol( e3v _b(:,:,:), e3vw_b(:,:,:), 'VW' )260 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 261 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 262 CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 263 CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 264 CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 257 265 ! t- and w- points depth 258 266 ! ---------------------- 259 gdept _n(:,:,1) = 0.5_wp * e3w_n(:,:,1)260 gdepw _n(:,:,1) = 0.0_wp261 gde3w _n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)267 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 268 gdepw(:,:,1,Kmm) = 0.0_wp 269 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 262 270 DO jk = 2, jpk 263 gdept _n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)264 gdepw _n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)265 gde3w _n(:,:,jk) = gdept_n(:,:,jk) - sshn (:,:)271 gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm) 272 gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 273 gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - sshn (:,:) 266 274 END DO 267 275 ENDIF 276 #endif 268 277 ENDIF 269 278 ENDIF … … 297 306 ! forced and coupled case 298 307 299 IF 308 IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 300 309 301 310 ztmpn(:,:,:)=0.0 … … 303 312 ! x comp of wind stress (CI_1) 304 313 ! U point to F point 305 DO jj=1,jpjm1 306 DO ji=1,jpi 307 ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) & 308 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1) 309 ENDDO 310 ENDDO 314 DO_2D( 1, 0, 1, 1 ) 315 ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) & 316 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1) 317 END_2D 311 318 CALL nemo2cice(ztmp,strax,'F', -1. ) 312 319 313 320 ! y comp of wind stress (CI_2) 314 321 ! V point to F point 315 DO jj=1,jpj 316 DO ji=1,jpim1 317 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 318 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) 319 ENDDO 320 ENDDO 322 DO_2D( 1, 1, 1, 0 ) 323 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 324 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) 325 END_2D 321 326 CALL nemo2cice(ztmp,stray,'F', -1. ) 322 327 323 328 ! Surface downward latent heat flux (CI_5) 324 IF 329 IF(ksbc == jp_flx) THEN 325 330 DO jl=1,ncat 326 331 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) … … 330 335 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub 331 336 ! End of temporary code 332 DO jj=1,jpj 333 DO ji=1,jpi 334 IF (fr_i(ji,jj).eq.0.0) THEN 335 DO jl=1,ncat 336 ztmpn(ji,jj,jl)=0.0 337 ENDDO 338 ! This will then be conserved in CICE 339 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 340 ELSE 341 DO jl=1,ncat 342 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 343 ENDDO 344 ENDIF 345 ENDDO 346 ENDDO 337 DO_2D( 1, 1, 1, 1 ) 338 IF(fr_i(ji,jj).eq.0.0) THEN 339 DO jl=1,ncat 340 ztmpn(ji,jj,jl)=0.0 341 ENDDO 342 ! This will then be conserved in CICE 343 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 344 ELSE 345 DO jl=1,ncat 346 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 347 ENDDO 348 ENDIF 349 END_2D 347 350 ENDIF 348 351 DO jl=1,ncat … … 351 354 ! GBM conductive flux through ice (CI_6) 352 355 ! Convert to GBM 353 IF 356 IF(ksbc == jp_flx) THEN 354 357 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 355 358 ELSE … … 360 363 ! GBM surface heat flux (CI_7) 361 364 ! Convert to GBM 362 IF 365 IF(ksbc == jp_flx) THEN 363 366 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 364 367 ELSE … … 368 371 ENDDO 369 372 370 ELSE IF 373 ELSE IF(ksbc == jp_blk) THEN 371 374 372 375 ! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself) … … 422 425 ! Freezing/melting potential 423 426 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 424 nfrzmlt(:,:) = r au0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )427 nfrzmlt(:,:) = rho0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 425 428 426 429 ztmp(:,:) = nfrzmlt(:,:) … … 434 437 ! x comp and y comp of surface ocean current 435 438 ! U point to F point 436 DO jj=1,jpjm1 437 DO ji=1,jpi 438 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 439 ENDDO 440 ENDDO 439 DO_2D( 1, 0, 1, 1 ) 440 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 441 END_2D 441 442 CALL nemo2cice(ztmp,uocn,'F', -1. ) 442 443 443 444 ! V point to F point 444 DO jj=1,jpj 445 DO ji=1,jpim1 446 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 447 ENDDO 448 ENDDO 445 DO_2D( 1, 1, 1, 0 ) 446 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 447 END_2D 449 448 CALL nemo2cice(ztmp,vocn,'F', -1. ) 450 449 … … 459 458 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 460 459 ! 461 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_r au0460 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rho0 462 461 ! 463 462 ! … … 468 467 ! x comp and y comp of sea surface slope (on F points) 469 468 ! T point to F point 470 DO jj = 1, jpjm1 471 DO ji = 1, jpim1 472 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 473 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 474 END DO 475 END DO 469 DO_2D( 1, 0, 1, 0 ) 470 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 471 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 472 END_2D 476 473 CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 477 474 478 475 ! T point to F point 479 DO jj = 1, jpjm1 480 DO ji = 1, jpim1 481 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 482 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 483 END DO 484 END DO 476 DO_2D( 1, 0, 1, 0 ) 477 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 478 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 479 END_2D 485 480 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 486 481 ! … … 508 503 ss_iou(:,:)=0.0 509 504 ! F point to U point 510 DO jj=2,jpjm1 511 DO ji=2,jpim1 512 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 513 ENDDO 514 ENDDO 515 CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. ) 505 DO_2D( 0, 0, 0, 0 ) 506 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 507 END_2D 508 CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1.0_wp ) 516 509 517 510 ! y comp of ocean-ice stress … … 520 513 ! F point to V point 521 514 522 DO jj=1,jpjm1 523 DO ji=2,jpim1 524 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 525 ENDDO 526 ENDDO 527 CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. ) 515 DO_2D( 1, 0, 0, 0 ) 516 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 517 END_2D 518 CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1.0_wp ) 528 519 529 520 ! x and y comps of surface stress … … 546 537 ! Freshwater fluxes 547 538 548 IF 539 IF(ksbc == jp_flx) THEN 549 540 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 550 541 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below … … 552 543 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 553 544 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 554 ELSE IF 545 ELSE IF(ksbc == jp_blk) THEN 555 546 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 556 ELSE IF 547 ELSE IF(ksbc == jp_purecpl) THEN 557 548 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 558 549 ! This is currently as required with the coupling fields from the UM atmosphere … … 578 569 fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 579 570 580 CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1. , sfx , 'T', 1.)571 CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1.0_wp, sfx , 'T', 1.0_wp ) 581 572 582 573 ! Solar penetrative radiation and non solar surface heat flux … … 584 575 ! Scale qsr and qns according to ice fraction (bulk formulae only) 585 576 586 IF 577 IF(ksbc == jp_blk) THEN 587 578 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 588 579 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 589 580 ENDIF 590 581 ! Take into account snow melting except for fully coupled when already in qns_tot 591 IF 582 IF(ksbc == jp_purecpl) THEN 592 583 qsr(:,:)= qsr_tot(:,:) 593 584 qns(:,:)= qns_tot(:,:) … … 604 595 #endif 605 596 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 606 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. ) 607 608 DO jj=1,jpj 609 DO ji=1,jpi 610 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 611 ENDDO 612 ENDDO 597 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1.0_wp ) 598 599 DO_2D( 1, 1, 1, 1 ) 600 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 601 END_2D 613 602 614 603 #if defined key_cice4 … … 619 608 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 620 609 621 CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1. )610 CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1.0_wp ) 622 611 623 612 ! Prepare for the following CICE time-step 624 613 625 614 CALL cice2nemo(aice,fr_i,'T', 1. ) 626 IF 615 IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 627 616 DO jl=1,ncat 628 617 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 632 621 ! T point to U point 633 622 ! T point to V point 634 DO jj=1,jpjm1 635 DO ji=1,jpim1 636 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 637 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 638 ENDDO 639 ENDDO 640 641 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. ) 623 DO_2D( 1, 0, 1, 0 ) 624 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 625 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 626 END_2D 627 628 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 642 629 643 630 ! set the snow+ice mass … … 762 749 sn_bot5 = FLD_N( 'botmeltn5_1m' , -1. , 'botmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' ) 763 750 764 REWIND( numnam_ref ) ! Namelist namsbc_cice in reference namelist :765 751 READ ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901) 766 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in reference namelist', lwp ) 767 768 REWIND( numnam_cfg ) ! Namelist namsbc_cice in configuration namelist : Parameters of the run 752 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in reference namelist' ) 753 769 754 READ ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 ) 770 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist' , lwp)755 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist' ) 771 756 IF(lwm) WRITE ( numond, namsbc_cice ) 772 757 … … 879 864 ! B. Gather pn into global array (png) 880 865 881 IF 866 IF( jpnij > 1) THEN 882 867 CALL mppsync 883 868 CALL mppgather (pn,0,png) … … 892 877 ! (may be OK but not 100% sure) 893 878 894 IF 879 IF(nproc==0) THEN 895 880 ! pcg(:,:)=0.0 896 881 DO jn=1,jpnij 897 DO jj=n ldjt(jn),nlejt(jn)898 DO ji=n ldit(jn),nleit(jn)882 DO jj=njs0all(jn),nje0all(jn) 883 DO ji=nis0all(jn),nie0all(jn) 899 884 png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 900 885 ENDDO … … 996 981 997 982 pn(:,:)=0.0 998 DO jj=1,jpjm1 999 DO ji=1,jpim1 1000 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 1001 ENDDO 1002 ENDDO 983 DO_2D( 1, 0, 1, 0 ) 984 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 985 END_2D 1003 986 1004 987 #else … … 1015 998 ! the lbclnk call on pn will replace these with sensible values 1016 999 1017 IF 1000 IF(nproc==0) THEN 1018 1001 png(:,:,:)=0.0 1019 1002 DO jn=1,jpnij 1020 DO jj=n ldjt(jn),nlejt(jn)1021 DO ji=n ldit(jn),nleit(jn)1003 DO jj=njs0all(jn),nje0all(jn) 1004 DO ji=nis0all(jn),nie0all(jn) 1022 1005 png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 1023 1006 ENDDO … … 1028 1011 ! C. Scatter png into NEMO field (pn) for each processor 1029 1012 1030 IF 1013 IF( jpnij > 1) THEN 1031 1014 CALL mppsync 1032 1015 CALL mppscatter (png,0,pn) … … 1056 1039 END SUBROUTINE sbc_ice_cice 1057 1040 1058 SUBROUTINE cice_sbc_init (ksbc ) ! Dummy routine1041 SUBROUTINE cice_sbc_init (ksbc, Kbb, Kmm) ! Dummy routine 1059 1042 IMPLICIT NONE 1060 1043 INTEGER, INTENT( in ) :: ksbc 1044 INTEGER, INTENT( in ) :: Kbb, Kmm 1061 1045 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?', ksbc 1062 1046 END SUBROUTINE cice_sbc_init
Note: See TracChangeset
for help on using the changeset viewer.
