Changeset 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_cice.F90
- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbcice_cice.F90 (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcice_cice.F90
r12178 r12928 13 13 USE dom_oce ! ocean space and time domain 14 14 USE domvvl 15 USE phycst, only : rcp, r au0, r1_rau0, rhos, rhoi15 USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi 16 16 USE in_out_manager ! I/O manager 17 17 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit … … 88 88 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE :: png ! local array used in sbc_cice_ice 89 89 90 !! * Substitutions 91 # include "do_loop_substitute.h90" 90 92 !!---------------------------------------------------------------------- 91 93 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 132 134 IF ( ksbc == jp_flx ) THEN 133 135 CALL cice_sbc_force(kt) 134 ELSE IF 136 ELSE IF( ksbc == jp_purecpl ) THEN 135 137 CALL sbc_cpl_ice_flx( fr_i ) 136 138 ENDIF … … 140 142 CALL cice_sbc_out ( kt, ksbc ) 141 143 142 IF 144 IF( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1) 143 145 144 146 ENDIF ! End sea-ice time step only … … 147 149 148 150 149 SUBROUTINE cice_sbc_init( ksbc )151 SUBROUTINE cice_sbc_init( ksbc, Kbb, Kmm ) 150 152 !!--------------------------------------------------------------------- 151 153 !! *** ROUTINE cice_sbc_init *** … … 154 156 !!--------------------------------------------------------------------- 155 157 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 158 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 156 159 REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 157 160 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar … … 168 171 ! there is no restart file. 169 172 ! Values from a CICE restart file would overwrite this 170 IF 171 CALL nemo2cice( ts n(:,:,1,jp_tem) , sst , 'T' , 1.)173 IF( .NOT. ln_rstart ) THEN 174 CALL nemo2cice( ts(:,:,1,jp_tem,Kmm) , sst , 'T' , 1.) 172 175 ENDIF 173 176 #endif … … 177 180 178 181 ! Do some CICE consistency checks 179 IF 180 IF 182 IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 183 IF( calc_strair .OR. calc_Tsfc ) THEN 181 184 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 182 185 ENDIF 183 ELSEIF 184 IF 186 ELSEIF(ksbc == jp_blk) THEN 187 IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 185 188 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 186 189 ENDIF … … 194 197 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart 195 198 IF( .NOT. ln_rstart ) THEN 196 ts n(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz)197 ts b(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)199 ts(:,:,:,jp_tem,Kmm) = MAX (ts(:,:,:,jp_tem,Kmm),Tocnfrz) 200 ts(:,:,:,jp_tem,Kbb) = ts(:,:,:,jp_tem,Kmm) 198 201 ENDIF 199 202 … … 202 205 203 206 CALL cice2nemo(aice,fr_i, 'T', 1. ) 204 IF 207 IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 205 208 DO jl=1,ncat 206 209 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 210 213 ! T point to U point 211 214 ! 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 215 DO_2D_10_10 216 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 217 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 218 END_2D 218 219 219 220 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. ) … … 227 228 IF( .NOT.ln_rstart ) THEN 228 229 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_rau0230 ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rho0 231 ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 231 232 232 233 !!gm This should be put elsewhere.... (same remark for limsbc) … … 235 236 ! 236 237 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)) )238 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 239 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 239 240 ENDDO 240 e3t _a(:,:,:) = e3t_b(:,:,:)241 e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 241 242 ! Reconstruction of all vertical scale factors at now and before time-steps 242 243 ! ============================================================================= 243 244 ! Horizontal scale factor interpolations 244 245 ! -------------------------------------- 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' )246 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 247 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 248 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 249 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 250 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 250 251 ! Vertical scale factor interpolations 251 252 ! ------------------------------------ 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' )253 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 254 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 255 CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 256 CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 257 CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 257 258 ! t- and w- points depth 258 259 ! ---------------------- 259 gdept _n(:,:,1) = 0.5_wp * e3w_n(:,:,1)260 gdepw _n(:,:,1) = 0.0_wp261 gde3w _n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)260 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 261 gdepw(:,:,1,Kmm) = 0.0_wp 262 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 262 263 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 (:,:)264 gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm) 265 gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 266 gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - sshn (:,:) 266 267 END DO 267 268 ENDIF … … 297 298 ! forced and coupled case 298 299 299 IF 300 IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 300 301 301 302 ztmpn(:,:,:)=0.0 … … 303 304 ! x comp of wind stress (CI_1) 304 305 ! 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 306 DO_2D_10_11 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 END_2D 311 310 CALL nemo2cice(ztmp,strax,'F', -1. ) 312 311 313 312 ! y comp of wind stress (CI_2) 314 313 ! 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 314 DO_2D_11_10 315 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 316 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) 317 END_2D 321 318 CALL nemo2cice(ztmp,stray,'F', -1. ) 322 319 323 320 ! Surface downward latent heat flux (CI_5) 324 IF 321 IF(ksbc == jp_flx) THEN 325 322 DO jl=1,ncat 326 323 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) … … 330 327 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub 331 328 ! 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 329 DO_2D_11_11 330 IF(fr_i(ji,jj).eq.0.0) THEN 331 DO jl=1,ncat 332 ztmpn(ji,jj,jl)=0.0 333 ENDDO 334 ! This will then be conserved in CICE 335 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 336 ELSE 337 DO jl=1,ncat 338 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 339 ENDDO 340 ENDIF 341 END_2D 347 342 ENDIF 348 343 DO jl=1,ncat … … 351 346 ! GBM conductive flux through ice (CI_6) 352 347 ! Convert to GBM 353 IF 348 IF(ksbc == jp_flx) THEN 354 349 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 355 350 ELSE … … 360 355 ! GBM surface heat flux (CI_7) 361 356 ! Convert to GBM 362 IF 357 IF(ksbc == jp_flx) THEN 363 358 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 364 359 ELSE … … 368 363 ENDDO 369 364 370 ELSE IF 365 ELSE IF(ksbc == jp_blk) THEN 371 366 372 367 ! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself) … … 422 417 ! Freezing/melting potential 423 418 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 424 nfrzmlt(:,:) = r au0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )419 nfrzmlt(:,:) = rho0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 425 420 426 421 ztmp(:,:) = nfrzmlt(:,:) … … 434 429 ! x comp and y comp of surface ocean current 435 430 ! 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 431 DO_2D_10_11 432 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 433 END_2D 441 434 CALL nemo2cice(ztmp,uocn,'F', -1. ) 442 435 443 436 ! 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 437 DO_2D_11_10 438 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 439 END_2D 449 440 CALL nemo2cice(ztmp,vocn,'F', -1. ) 450 441 … … 459 450 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 460 451 ! 461 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_r au0452 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rho0 462 453 ! 463 454 ! … … 468 459 ! x comp and y comp of sea surface slope (on F points) 469 460 ! 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 461 DO_2D_10_10 462 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 463 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 464 END_2D 476 465 CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 477 466 478 467 ! 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 468 DO_2D_10_10 469 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 470 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 471 END_2D 485 472 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 486 473 ! … … 508 495 ss_iou(:,:)=0.0 509 496 ! 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 497 DO_2D_00_00 498 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 499 END_2D 515 500 CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. ) 516 501 … … 520 505 ! F point to V point 521 506 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 507 DO_2D_10_00 508 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 509 END_2D 527 510 CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. ) 528 511 … … 546 529 ! Freshwater fluxes 547 530 548 IF 531 IF(ksbc == jp_flx) THEN 549 532 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 550 533 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below … … 552 535 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 553 536 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 554 ELSE IF 537 ELSE IF(ksbc == jp_blk) THEN 555 538 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 556 ELSE IF 539 ELSE IF(ksbc == jp_purecpl) THEN 557 540 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 558 541 ! This is currently as required with the coupling fields from the UM atmosphere … … 584 567 ! Scale qsr and qns according to ice fraction (bulk formulae only) 585 568 586 IF 569 IF(ksbc == jp_blk) THEN 587 570 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 588 571 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 589 572 ENDIF 590 573 ! Take into account snow melting except for fully coupled when already in qns_tot 591 IF 574 IF(ksbc == jp_purecpl) THEN 592 575 qsr(:,:)= qsr_tot(:,:) 593 576 qns(:,:)= qns_tot(:,:) … … 606 589 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. ) 607 590 608 DO jj=1,jpj 609 DO ji=1,jpi 610 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 611 ENDDO 612 ENDDO 591 DO_2D_11_11 592 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 593 END_2D 613 594 614 595 #if defined key_cice4 … … 624 605 625 606 CALL cice2nemo(aice,fr_i,'T', 1. ) 626 IF 607 IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 627 608 DO jl=1,ncat 628 609 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 632 613 ! T point to U point 633 614 ! 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 615 DO_2D_10_10 616 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 617 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) 618 END_2D 640 619 641 620 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. ) … … 762 741 sn_bot5 = FLD_N( 'botmeltn5_1m' , -1. , 'botmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' ) 763 742 764 REWIND( numnam_ref ) ! Namelist namsbc_cice in reference namelist :765 743 READ ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901) 766 744 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in reference namelist' ) 767 745 768 REWIND( numnam_cfg ) ! Namelist namsbc_cice in configuration namelist : Parameters of the run769 746 READ ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 ) 770 747 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist' ) … … 879 856 ! B. Gather pn into global array (png) 880 857 881 IF 858 IF( jpnij > 1) THEN 882 859 CALL mppsync 883 860 CALL mppgather (pn,0,png) … … 892 869 ! (may be OK but not 100% sure) 893 870 894 IF 871 IF(nproc==0) THEN 895 872 ! pcg(:,:)=0.0 896 873 DO jn=1,jpnij … … 996 973 997 974 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 975 DO_2D_10_10 976 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 977 END_2D 1003 978 1004 979 #else … … 1015 990 ! the lbclnk call on pn will replace these with sensible values 1016 991 1017 IF 992 IF(nproc==0) THEN 1018 993 png(:,:,:)=0.0 1019 994 DO jn=1,jpnij … … 1028 1003 ! C. Scatter png into NEMO field (pn) for each processor 1029 1004 1030 IF 1005 IF( jpnij > 1) THEN 1031 1006 CALL mppsync 1032 1007 CALL mppscatter (png,0,pn) … … 1056 1031 END SUBROUTINE sbc_ice_cice 1057 1032 1058 SUBROUTINE cice_sbc_init (ksbc ) ! Dummy routine1033 SUBROUTINE cice_sbc_init (ksbc, Kbb, Kmm) ! Dummy routine 1059 1034 IMPLICIT NONE 1060 1035 INTEGER, INTENT( in ) :: ksbc 1036 INTEGER, INTENT( in ) :: Kbb, Kmm 1061 1037 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?', ksbc 1062 1038 END SUBROUTINE cice_sbc_init
Note: See TracChangeset
for help on using the changeset viewer.
