- Timestamp:
- 2015-02-11T11:50:34+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r4627 r5075 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, & 41 42 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm, & … … 44 45 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 45 46 swvdr,swvdf,swidr,swidf 47 USE ice_therm_vertical, only: calc_Tsfc 48 #else 49 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 50 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, & 51 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, & 52 flatn_f,fsurfn_f,fcondtopn_f, & 53 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 54 swvdr,swvdf,swidr,swidf 55 USE ice_therm_shared, only: calc_Tsfc 56 #endif 46 57 USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf 47 58 USE ice_atmo, only: calc_strair 48 USE ice_therm_vertical, only: calc_Tsfc49 59 50 60 USE CICE_InitMod … … 95 105 END FUNCTION sbc_ice_cice_alloc 96 106 97 SUBROUTINE sbc_ice_cice( kt, nsbc )107 SUBROUTINE sbc_ice_cice( kt, ksbc ) 98 108 !!--------------------------------------------------------------------- 99 109 !! *** ROUTINE sbc_ice_cice *** … … 113 123 !!--------------------------------------------------------------------- 114 124 INTEGER, INTENT(in) :: kt ! ocean time step 115 INTEGER, INTENT(in) :: nsbc ! surface forcing type125 INTEGER, INTENT(in) :: ksbc ! surface forcing type 116 126 !!---------------------------------------------------------------------- 117 127 ! … … 123 133 124 134 ! Make sure any fluxes required for CICE are set 125 IF ( nsbc == 2 )THEN135 IF ( ksbc == jp_flx ) THEN 126 136 CALL cice_sbc_force(kt) 127 ELSE IF ( nsbc == 5) THEN137 ELSE IF ( ksbc == jp_cpl ) THEN 128 138 CALL sbc_cpl_ice_flx( 1.0-fr_i ) 129 139 ENDIF 130 140 131 CALL cice_sbc_in ( kt, nsbc )141 CALL cice_sbc_in ( kt, ksbc ) 132 142 CALL CICE_Run 133 CALL cice_sbc_out ( kt, nsbc )134 135 IF ( nsbc == 5) CALL cice_sbc_hadgam(kt+1)143 CALL cice_sbc_out ( kt, ksbc ) 144 145 IF ( ksbc == jp_cpl ) CALL cice_sbc_hadgam(kt+1) 136 146 137 147 ENDIF ! End sea-ice time step only … … 141 151 END SUBROUTINE sbc_ice_cice 142 152 143 SUBROUTINE cice_sbc_init ( nsbc)153 SUBROUTINE cice_sbc_init (ksbc) 144 154 !!--------------------------------------------------------------------- 145 155 !! *** ROUTINE cice_sbc_init *** 146 156 !! ** Purpose: Initialise ice related fields for NEMO and coupling 147 157 !! 148 INTEGER, INTENT( in ) :: nsbc ! surface forcing type158 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 149 159 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 150 160 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 151 INTEGER :: ji, jj, jl 161 INTEGER :: ji, jj, jl, jk ! dummy loop indices 152 162 !!--------------------------------------------------------------------- 153 163 … … 161 171 jj_off = INT ( (jpjglo - ny_global) / 2 ) 162 172 173 #if defined key_nemocice_decomp 174 ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 175 ! there is no restart file. 176 ! Values from a CICE restart file would overwrite this 177 IF ( .NOT. ln_rstart ) THEN 178 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 179 ENDIF 180 #endif 181 163 182 ! Initialize CICE 164 183 CALL CICE_Initialize 165 184 166 185 ! Do some CICE consistency checks 167 IF ( ( nsbc == 2) .OR. (nsbc == 5) ) THEN186 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 168 187 IF ( calc_strair .OR. calc_Tsfc ) THEN 169 188 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 170 189 ENDIF 171 ELSEIF ( nsbc == 4) THEN190 ELSEIF (ksbc == jp_core) THEN 172 191 IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 173 192 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) … … 190 209 191 210 CALL cice2nemo(aice,fr_i, 'T', 1. ) 192 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN211 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 193 212 DO jl=1,ncat 194 213 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 218 237 snwice_mass_b(:,:) = 0.0_wp ! no mass exchanges 219 238 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 ! 239 IF( .NOT. ln_rstart ) THEN 240 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2) deplete the initial ssh below sea-ice area 241 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 242 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 243 #if defined key_vvl 244 ! key_vvl necessary? clem: yes for compilation purpose 245 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 246 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 247 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 248 ENDDO 249 fse3t_a(:,:,:) = fse3t_b(:,:,:) 250 ! Reconstruction of all vertical scale factors at now and before time 251 ! steps 252 ! ============================================================================= 253 ! Horizontal scale factor interpolations 254 ! -------------------------------------- 255 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 256 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 257 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 258 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 259 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 260 ! Vertical scale factor interpolations 261 ! ------------------------------------ 262 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 263 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 264 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 265 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 266 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 267 ! t- and w- points depth 268 ! ---------------------- 269 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 270 fsdepw_n(:,:,1) = 0.0_wp 271 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 272 DO jk = 2, jpk 273 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 274 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 275 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 276 END DO 277 #endif 278 ENDIF 225 279 ENDIF 226 280 … … 232 286 233 287 234 SUBROUTINE cice_sbc_in (kt, nsbc)288 SUBROUTINE cice_sbc_in (kt, ksbc) 235 289 !!--------------------------------------------------------------------- 236 290 !! *** ROUTINE cice_sbc_in *** … … 238 292 !!--------------------------------------------------------------------- 239 293 INTEGER, INTENT(in ) :: kt ! ocean time step 240 INTEGER, INTENT(in ) :: nsbc ! surface forcing type294 INTEGER, INTENT(in ) :: ksbc ! surface forcing type 241 295 242 296 INTEGER :: ji, jj, jl ! dummy loop indices … … 262 316 ! forced and coupled case 263 317 264 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN318 IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 265 319 266 320 ztmpn(:,:,:)=0.0 … … 287 341 288 342 ! Surface downward latent heat flux (CI_5) 289 IF ( nsbc == 2) THEN343 IF (ksbc == jp_flx) THEN 290 344 DO jl=1,ncat 291 345 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) … … 316 370 ! GBM conductive flux through ice (CI_6) 317 371 ! Convert to GBM 318 IF ( nsbc == 2) THEN372 IF (ksbc == jp_flx) THEN 319 373 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 320 374 ELSE … … 325 379 ! GBM surface heat flux (CI_7) 326 380 ! Convert to GBM 327 IF ( nsbc == 2) THEN381 IF (ksbc == jp_flx) THEN 328 382 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 329 383 ELSE … … 333 387 ENDDO 334 388 335 ELSE IF ( nsbc == 4) THEN389 ELSE IF (ksbc == jp_core) THEN 336 390 337 391 ! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) … … 375 429 376 430 ! Snowfall 377 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) 431 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) 432 IF( iom_use('snowpre') ) CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit 378 433 ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0) 379 434 CALL nemo2cice(ztmp,fsnow,'T', 1. ) 380 435 381 436 ! Rainfall 437 IF( iom_use('precip') ) CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit 382 438 ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 383 439 CALL nemo2cice(ztmp,frain,'T', 1. ) … … 458 514 459 515 460 SUBROUTINE cice_sbc_out (kt, nsbc)516 SUBROUTINE cice_sbc_out (kt,ksbc) 461 517 !!--------------------------------------------------------------------- 462 518 !! *** ROUTINE cice_sbc_out *** … … 464 520 !!--------------------------------------------------------------------- 465 521 INTEGER, INTENT( in ) :: kt ! ocean time step 466 INTEGER, INTENT( in ) :: nsbc ! surface forcing type522 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 467 523 468 524 INTEGER :: ji, jj, jl ! dummy loop indices … … 510 566 ! Freshwater fluxes 511 567 512 IF ( nsbc == 2) THEN568 IF (ksbc == jp_flx) THEN 513 569 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 514 570 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below … … 516 572 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 517 573 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 518 ELSE IF ( nsbc == 4) THEN574 ELSE IF (ksbc == jp_core) THEN 519 575 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 520 ELSE IF ( nsbc ==5) THEN576 ELSE IF (ksbc == jp_cpl) THEN 521 577 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 522 578 ! This is currently as required with the coupling fields from the UM atmosphere … … 524 580 ENDIF 525 581 582 #if defined key_cice4 526 583 CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 527 584 CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 585 #else 586 CALL cice2nemo(fresh_ai,ztmp1,'T', 1. ) 587 CALL cice2nemo(fsalt_ai,ztmp2,'T', 1. ) 588 #endif 528 589 529 590 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative) … … 535 596 sfx(:,:)=ztmp2(:,:)*1000.0 536 597 emp(:,:)=emp(:,:)-ztmp1(:,:) 537 598 fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 599 538 600 CALL lbc_lnk( emp , 'T', 1. ) 539 601 CALL lbc_lnk( sfx , 'T', 1. ) … … 543 605 ! Scale qsr and qns according to ice fraction (bulk formulae only) 544 606 545 IF ( nsbc == 4) THEN607 IF (ksbc == jp_core) THEN 546 608 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 547 609 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 548 610 ENDIF 549 611 ! Take into account snow melting except for fully coupled when already in qns_tot 550 IF ( nsbc == 5) THEN612 IF (ksbc == jp_cpl) THEN 551 613 qsr(:,:)= qsr_tot(:,:) 552 614 qns(:,:)= qns_tot(:,:) … … 557 619 ! Now add in ice / snow related terms 558 620 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 621 #if defined key_cice4 559 622 CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 623 #else 624 CALL cice2nemo(fswthru_ai,ztmp1,'T', 1. ) 625 #endif 560 626 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 561 627 CALL lbc_lnk( qsr , 'T', 1. ) … … 567 633 ENDDO 568 634 635 #if defined key_cice4 569 636 CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 637 #else 638 CALL cice2nemo(fhocn_ai,ztmp1,'T', 1. ) 639 #endif 570 640 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 571 641 … … 575 645 576 646 CALL cice2nemo(aice,fr_i,'T', 1. ) 577 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN647 IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 578 648 DO jl=1,ncat 579 649 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 611 681 612 682 613 #if defined key_oasis3 || defined key_oasis4614 683 SUBROUTINE cice_sbc_hadgam( kt ) 615 684 !!--------------------------------------------------------------------- … … 653 722 END SUBROUTINE cice_sbc_hadgam 654 723 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 724 662 725 SUBROUTINE cice_sbc_final … … 713 776 IF( kt == nit000 ) THEN ! First call kt=nit000 ! 714 777 ! ! ====================== ! 778 ! namsbc_cice is not yet in the reference namelist 779 ! set file information (default values) 780 cn_dir = './' ! directory in which the model is executed 781 782 ! (NB: frequency positive => hours, negative => months) 783 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! landmask 784 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! file 785 sn_snow = FLD_N( 'snowfall_1m' , -1. , 'snowfall' , .true. , .true. , ' yearly' , '' , '' , '' ) 786 sn_rain = FLD_N( 'rainfall_1m' , -1. , 'rainfall' , .true. , .true. , ' yearly' , '' , '' , '' ) 787 sn_sblm = FLD_N( 'sublim_1m' , -1. , 'sublim' , .true. , .true. , ' yearly' , '' , '' , '' ) 788 sn_top1 = FLD_N( 'topmeltn1_1m' , -1. , 'topmeltn1' , .true. , .true. , ' yearly' , '' , '' , '' ) 789 sn_top2 = FLD_N( 'topmeltn2_1m' , -1. , 'topmeltn2' , .true. , .true. , ' yearly' , '' , '' , '' ) 790 sn_top3 = FLD_N( 'topmeltn3_1m' , -1. , 'topmeltn3' , .true. , .true. , ' yearly' , '' , '' , '' ) 791 sn_top4 = FLD_N( 'topmeltn4_1m' , -1. , 'topmeltn4' , .true. , .true. , ' yearly' , '' , '' , '' ) 792 sn_top5 = FLD_N( 'topmeltn5_1m' , -1. , 'topmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' ) 793 sn_bot1 = FLD_N( 'botmeltn1_1m' , -1. , 'botmeltn1' , .true. , .true. , ' yearly' , '' , '' , '' ) 794 sn_bot2 = FLD_N( 'botmeltn2_1m' , -1. , 'botmeltn2' , .true. , .true. , ' yearly' , '' , '' , '' ) 795 sn_bot3 = FLD_N( 'botmeltn3_1m' , -1. , 'botmeltn3' , .true. , .true. , ' yearly' , '' , '' , '' ) 796 sn_bot4 = FLD_N( 'botmeltn4_1m' , -1. , 'botmeltn4' , .true. , .true. , ' yearly' , '' , '' , '' ) 797 sn_bot5 = FLD_N( 'botmeltn5_1m' , -1. , 'botmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' ) 798 715 799 REWIND( numnam_ref ) ! Namelist namsbc_cice in reference namelist : 716 800 READ ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901) … … 1001 1085 CONTAINS 1002 1086 1003 SUBROUTINE sbc_ice_cice ( kt, nsbc ) ! Dummy routine1087 SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine 1004 1088 WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 1005 1089 END SUBROUTINE sbc_ice_cice 1006 1090 1007 SUBROUTINE cice_sbc_init ( nsbc) ! Dummy routine1091 SUBROUTINE cice_sbc_init (ksbc) ! Dummy routine 1008 1092 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 1009 1093 END SUBROUTINE cice_sbc_init
Note: See TracChangeset
for help on using the changeset viewer.
