Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
- Property svn:keywords set to Id
r4627 r5965 17 17 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 18 18 USE in_out_manager ! I/O manager 19 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit 19 20 USE lib_mpp ! distributed memory computing library 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 23 24 USE daymod ! calendar 24 25 USE fldread ! read input fields 25 26 26 USE sbc_oce ! Surface boundary condition: ocean fields 27 27 USE sbc_ice ! Surface boundary condition: ice fields … … 38 38 USE ice_calendar, only: dt 39 39 USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 40 # if defined key_cice4 40 41 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 42 strocnxT,strocnyT, & 41 43 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm, & 42 44 fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt, & … … 44 46 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 45 47 swvdr,swvdf,swidr,swidf 48 USE ice_therm_vertical, only: calc_Tsfc 49 #else 50 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 51 strocnxT,strocnyT, & 52 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, & 53 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, & 54 flatn_f,fsurfn_f,fcondtopn_f, & 55 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 56 swvdr,swvdf,swidr,swidf 57 USE ice_therm_shared, only: calc_Tsfc 58 #endif 46 59 USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf 47 60 USE ice_atmo, only: calc_strair 48 USE ice_therm_vertical, only: calc_Tsfc49 61 50 62 USE CICE_InitMod … … 84 96 # include "domzgr_substitute.h90" 85 97 98 !! $Id$ 86 99 CONTAINS 87 100 … … 95 108 END FUNCTION sbc_ice_cice_alloc 96 109 97 SUBROUTINE sbc_ice_cice( kt, nsbc )110 SUBROUTINE sbc_ice_cice( kt, ksbc ) 98 111 !!--------------------------------------------------------------------- 99 112 !! *** ROUTINE sbc_ice_cice *** … … 113 126 !!--------------------------------------------------------------------- 114 127 INTEGER, INTENT(in) :: kt ! ocean time step 115 INTEGER, INTENT(in) :: nsbc ! surface forcing type128 INTEGER, INTENT(in) :: ksbc ! surface forcing type 116 129 !!---------------------------------------------------------------------- 117 130 ! … … 123 136 124 137 ! Make sure any fluxes required for CICE are set 125 IF ( nsbc == 2 )THEN138 IF ( ksbc == jp_flx ) THEN 126 139 CALL cice_sbc_force(kt) 127 ELSE IF ( nsbc == 5) THEN140 ELSE IF ( ksbc == jp_purecpl ) THEN 128 141 CALL sbc_cpl_ice_flx( 1.0-fr_i ) 129 142 ENDIF 130 143 131 CALL cice_sbc_in ( kt, nsbc )144 CALL cice_sbc_in ( kt, ksbc ) 132 145 CALL CICE_Run 133 CALL cice_sbc_out ( kt, nsbc )134 135 IF ( nsbc == 5) CALL cice_sbc_hadgam(kt+1)146 CALL cice_sbc_out ( kt, ksbc ) 147 148 IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1) 136 149 137 150 ENDIF ! End sea-ice time step only … … 141 154 END SUBROUTINE sbc_ice_cice 142 155 143 SUBROUTINE cice_sbc_init ( nsbc)156 SUBROUTINE cice_sbc_init (ksbc) 144 157 !!--------------------------------------------------------------------- 145 158 !! *** ROUTINE cice_sbc_init *** 146 159 !! ** Purpose: Initialise ice related fields for NEMO and coupling 147 160 !! 148 INTEGER, INTENT( in ) :: nsbc ! surface forcing type161 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 149 162 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 150 163 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 151 INTEGER :: ji, jj, jl 164 INTEGER :: ji, jj, jl, jk ! dummy loop indices 152 165 !!--------------------------------------------------------------------- 153 166 … … 161 174 jj_off = INT ( (jpjglo - ny_global) / 2 ) 162 175 176 #if defined key_nemocice_decomp 177 ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 178 ! there is no restart file. 179 ! Values from a CICE restart file would overwrite this 180 IF ( .NOT. ln_rstart ) THEN 181 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 182 ENDIF 183 #endif 184 163 185 ! Initialize CICE 164 186 CALL CICE_Initialize 165 187 166 188 ! Do some CICE consistency checks 167 IF ( ( nsbc == 2) .OR. (nsbc == 5) ) THEN189 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 168 190 IF ( calc_strair .OR. calc_Tsfc ) THEN 169 191 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 170 192 ENDIF 171 ELSEIF ( nsbc == 4) THEN193 ELSEIF (ksbc == jp_core) THEN 172 194 IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 173 195 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) … … 190 212 191 213 CALL cice2nemo(aice,fr_i, 'T', 1. ) 192 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN214 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 193 215 DO jl=1,ncat 194 216 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 218 240 snwice_mass_b(:,:) = 0.0_wp ! no mass exchanges 219 241 ENDIF 220 IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart : 221 & .NOT.ln_rstart ) THEN ! deplete the initial ssh belew sea-ice area 222 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 223 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 224 ! 242 IF( .NOT. ln_rstart ) THEN 243 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2) deplete the initial ssh below sea-ice area 244 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 245 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 246 #if defined key_vvl 247 ! key_vvl necessary? clem: yes for compilation purpose 248 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 249 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 250 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 251 ENDDO 252 fse3t_a(:,:,:) = fse3t_b(:,:,:) 253 ! Reconstruction of all vertical scale factors at now and before time 254 ! steps 255 ! ============================================================================= 256 ! Horizontal scale factor interpolations 257 ! -------------------------------------- 258 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 259 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 260 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 261 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 262 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 263 ! Vertical scale factor interpolations 264 ! ------------------------------------ 265 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 266 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 267 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 268 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 269 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 270 ! t- and w- points depth 271 ! ---------------------- 272 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 273 fsdepw_n(:,:,1) = 0.0_wp 274 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 275 DO jk = 2, jpk 276 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 277 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 278 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 279 END DO 280 #endif 281 ENDIF 225 282 ENDIF 226 283 … … 232 289 233 290 234 SUBROUTINE cice_sbc_in (kt, nsbc)291 SUBROUTINE cice_sbc_in (kt, ksbc) 235 292 !!--------------------------------------------------------------------- 236 293 !! *** ROUTINE cice_sbc_in *** … … 238 295 !!--------------------------------------------------------------------- 239 296 INTEGER, INTENT(in ) :: kt ! ocean time step 240 INTEGER, INTENT(in ) :: nsbc ! surface forcing type297 INTEGER, INTENT(in ) :: ksbc ! surface forcing type 241 298 242 299 INTEGER :: ji, jj, jl ! dummy loop indices … … 262 319 ! forced and coupled case 263 320 264 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN321 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 265 322 266 323 ztmpn(:,:,:)=0.0 … … 287 344 288 345 ! Surface downward latent heat flux (CI_5) 289 IF ( nsbc == 2) THEN346 IF (ksbc == jp_flx) THEN 290 347 DO jl=1,ncat 291 348 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) … … 316 373 ! GBM conductive flux through ice (CI_6) 317 374 ! Convert to GBM 318 IF ( nsbc == 2) THEN375 IF (ksbc == jp_flx) THEN 319 376 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 320 377 ELSE … … 325 382 ! GBM surface heat flux (CI_7) 326 383 ! Convert to GBM 327 IF ( nsbc == 2) THEN384 IF (ksbc == jp_flx) THEN 328 385 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 329 386 ELSE … … 333 390 ENDDO 334 391 335 ELSE IF ( nsbc == 4) THEN392 ELSE IF (ksbc == jp_core) THEN 336 393 337 394 ! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) … … 375 432 376 433 ! Snowfall 377 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) 434 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) 435 IF( iom_use('snowpre') ) CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit 378 436 ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0) 379 437 CALL nemo2cice(ztmp,fsnow,'T', 1. ) 380 438 381 439 ! Rainfall 440 IF( iom_use('precip') ) CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit 382 441 ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 383 442 CALL nemo2cice(ztmp,frain,'T', 1. ) … … 450 509 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 451 510 452 CALL wrk_dealloc( jpi,jpj, ztmp )511 CALL wrk_dealloc( jpi,jpj, ztmp, zpice ) 453 512 CALL wrk_dealloc( jpi,jpj,ncat, ztmpn ) 454 513 ! … … 458 517 459 518 460 SUBROUTINE cice_sbc_out (kt, nsbc)519 SUBROUTINE cice_sbc_out (kt,ksbc) 461 520 !!--------------------------------------------------------------------- 462 521 !! *** ROUTINE cice_sbc_out *** … … 464 523 !!--------------------------------------------------------------------- 465 524 INTEGER, INTENT( in ) :: kt ! ocean time step 466 INTEGER, INTENT( in ) :: nsbc ! surface forcing type525 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 467 526 468 527 INTEGER :: ji, jj, jl ! dummy loop indices … … 504 563 ! Combine wind stress and ocean-ice stress 505 564 ! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep] 565 ! strocnx and strocny already weighted by ice fraction in CICE so not done here 506 566 507 567 utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:) 508 568 vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:) 569 570 ! Also need ice/ocean stress on T points so that taum can be updated 571 ! This interpolation is already done in CICE so best to use those values 572 CALL cice2nemo(strocnxT,ztmp1,'T',-1.) 573 CALL cice2nemo(strocnyT,ztmp2,'T',-1.) 574 575 ! Update taum with modulus of ice-ocean stress 576 ! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 577 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.) 509 578 510 579 ! Freshwater fluxes 511 580 512 IF ( nsbc == 2) THEN581 IF (ksbc == jp_flx) THEN 513 582 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 514 583 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below … … 516 585 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 517 586 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 518 ELSE IF ( nsbc == 4) THEN587 ELSE IF (ksbc == jp_core) THEN 519 588 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 520 ELSE IF ( nsbc ==5) THEN589 ELSE IF (ksbc == jp_purecpl) THEN 521 590 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 522 591 ! This is currently as required with the coupling fields from the UM atmosphere … … 524 593 ENDIF 525 594 595 #if defined key_cice4 526 596 CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 527 597 CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 598 #else 599 CALL cice2nemo(fresh_ai,ztmp1,'T', 1. ) 600 CALL cice2nemo(fsalt_ai,ztmp2,'T', 1. ) 601 #endif 528 602 529 603 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative) … … 535 609 sfx(:,:)=ztmp2(:,:)*1000.0 536 610 emp(:,:)=emp(:,:)-ztmp1(:,:) 537 611 fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 612 538 613 CALL lbc_lnk( emp , 'T', 1. ) 539 614 CALL lbc_lnk( sfx , 'T', 1. ) … … 543 618 ! Scale qsr and qns according to ice fraction (bulk formulae only) 544 619 545 IF ( nsbc == 4) THEN620 IF (ksbc == jp_core) THEN 546 621 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 547 622 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 548 623 ENDIF 549 624 ! Take into account snow melting except for fully coupled when already in qns_tot 550 IF ( nsbc == 5) THEN625 IF (ksbc == jp_purecpl) THEN 551 626 qsr(:,:)= qsr_tot(:,:) 552 627 qns(:,:)= qns_tot(:,:) … … 557 632 ! Now add in ice / snow related terms 558 633 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 634 #if defined key_cice4 559 635 CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 636 #else 637 CALL cice2nemo(fswthru_ai,ztmp1,'T', 1. ) 638 #endif 560 639 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 561 640 CALL lbc_lnk( qsr , 'T', 1. ) … … 567 646 ENDDO 568 647 648 #if defined key_cice4 569 649 CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 650 #else 651 CALL cice2nemo(fhocn_ai,ztmp1,'T', 1. ) 652 #endif 570 653 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 571 654 … … 575 658 576 659 CALL cice2nemo(aice,fr_i,'T', 1. ) 577 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN660 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 578 661 DO jl=1,ncat 579 662 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 611 694 612 695 613 #if defined key_oasis3 || defined key_oasis4614 696 SUBROUTINE cice_sbc_hadgam( kt ) 615 697 !!--------------------------------------------------------------------- … … 653 735 END SUBROUTINE cice_sbc_hadgam 654 736 655 #else656 SUBROUTINE cice_sbc_hadgam( kt ) ! Dummy routine657 INTEGER, INTENT( in ) :: kt ! ocean time step658 WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?'659 END SUBROUTINE cice_sbc_hadgam660 #endif661 737 662 738 SUBROUTINE cice_sbc_final … … 713 789 IF( kt == nit000 ) THEN ! First call kt=nit000 ! 714 790 ! ! ====================== ! 791 ! namsbc_cice is not yet in the reference namelist 792 ! set file information (default values) 793 cn_dir = './' ! directory in which the model is executed 794 795 ! (NB: frequency positive => hours, negative => months) 796 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! landmask 797 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! file 798 sn_snow = FLD_N( 'snowfall_1m' , -1. , 'snowfall' , .true. , .true. , ' yearly' , '' , '' , '' ) 799 sn_rain = FLD_N( 'rainfall_1m' , -1. , 'rainfall' , .true. , .true. , ' yearly' , '' , '' , '' ) 800 sn_sblm = FLD_N( 'sublim_1m' , -1. , 'sublim' , .true. , .true. , ' yearly' , '' , '' , '' ) 801 sn_top1 = FLD_N( 'topmeltn1_1m' , -1. , 'topmeltn1' , .true. , .true. , ' yearly' , '' , '' , '' ) 802 sn_top2 = FLD_N( 'topmeltn2_1m' , -1. , 'topmeltn2' , .true. , .true. , ' yearly' , '' , '' , '' ) 803 sn_top3 = FLD_N( 'topmeltn3_1m' , -1. , 'topmeltn3' , .true. , .true. , ' yearly' , '' , '' , '' ) 804 sn_top4 = FLD_N( 'topmeltn4_1m' , -1. , 'topmeltn4' , .true. , .true. , ' yearly' , '' , '' , '' ) 805 sn_top5 = FLD_N( 'topmeltn5_1m' , -1. , 'topmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' ) 806 sn_bot1 = FLD_N( 'botmeltn1_1m' , -1. , 'botmeltn1' , .true. , .true. , ' yearly' , '' , '' , '' ) 807 sn_bot2 = FLD_N( 'botmeltn2_1m' , -1. , 'botmeltn2' , .true. , .true. , ' yearly' , '' , '' , '' ) 808 sn_bot3 = FLD_N( 'botmeltn3_1m' , -1. , 'botmeltn3' , .true. , .true. , ' yearly' , '' , '' , '' ) 809 sn_bot4 = FLD_N( 'botmeltn4_1m' , -1. , 'botmeltn4' , .true. , .true. , ' yearly' , '' , '' , '' ) 810 sn_bot5 = FLD_N( 'botmeltn5_1m' , -1. , 'botmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' ) 811 715 812 REWIND( numnam_ref ) ! Namelist namsbc_cice in reference namelist : 716 813 READ ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901) … … 999 1096 !! Default option Dummy module NO CICE sea-ice model 1000 1097 !!---------------------------------------------------------------------- 1098 !! $Id$ 1001 1099 CONTAINS 1002 1100 1003 SUBROUTINE sbc_ice_cice ( kt, nsbc ) ! Dummy routine1101 SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine 1004 1102 WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 1005 1103 END SUBROUTINE sbc_ice_cice 1006 1104 1007 SUBROUTINE cice_sbc_init ( nsbc) ! Dummy routine1105 SUBROUTINE cice_sbc_init (ksbc) ! Dummy routine 1008 1106 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 1009 1107 END SUBROUTINE cice_sbc_init
Note: See TracChangeset
for help on using the changeset viewer.
