Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
- Timestamp:
- 2015-12-03T09:10:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r5260 r5989 67 67 PRIVATE 68 68 69 !! * Routine accessibility70 69 PUBLIC cice_sbc_init ! routine called by sbc_init 71 70 PUBLIC cice_sbc_final ! routine called by sbc_final … … 95 94 !! * Substitutions 96 95 # include "domzgr_substitute.h90" 97 96 !!---------------------------------------------------------------------- 97 !! NEMO/OPA 3.7 , NEMO-consortium (2015) 98 98 !! $Id$ 99 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 100 !!---------------------------------------------------------------------- 99 101 CONTAINS 100 102 … … 138 140 IF ( ksbc == jp_flx ) THEN 139 141 CALL cice_sbc_force(kt) 140 ELSE IF ( ksbc == jp_ cpl ) THEN142 ELSE IF ( ksbc == jp_purecpl ) THEN 141 143 CALL sbc_cpl_ice_flx( 1.0-fr_i ) 142 144 ENDIF … … 146 148 CALL cice_sbc_out ( kt, ksbc ) 147 149 148 IF ( ksbc == jp_ cpl ) CALL cice_sbc_hadgam(kt+1)150 IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1) 149 151 150 152 ENDIF ! End sea-ice time step only … … 154 156 END SUBROUTINE sbc_ice_cice 155 157 156 SUBROUTINE cice_sbc_init (ksbc) 158 159 SUBROUTINE cice_sbc_init( ksbc ) 157 160 !!--------------------------------------------------------------------- 158 161 !! *** ROUTINE cice_sbc_init *** 159 162 !! ** Purpose: Initialise ice related fields for NEMO and coupling 160 163 !! 164 !!--------------------------------------------------------------------- 161 165 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 162 166 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 … … 187 191 188 192 ! Do some CICE consistency checks 189 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_ cpl) ) THEN193 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 190 194 IF ( calc_strair .OR. calc_Tsfc ) THEN 191 195 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) … … 212 216 213 217 CALL cice2nemo(aice,fr_i, 'T', 1. ) 214 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_ cpl) ) THEN218 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 215 219 DO jl=1,ncat 216 220 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 289 293 290 294 291 SUBROUTINE cice_sbc_in (kt, ksbc)295 SUBROUTINE cice_sbc_in( kt, ksbc ) 292 296 !!--------------------------------------------------------------------- 293 297 !! *** ROUTINE cice_sbc_in *** … … 296 300 INTEGER, INTENT(in ) :: kt ! ocean time step 297 301 INTEGER, INTENT(in ) :: ksbc ! surface forcing type 298 302 ! 299 303 INTEGER :: ji, jj, jl ! dummy loop indices 300 304 REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice … … 319 323 ! forced and coupled case 320 324 321 IF ( (ksbc == jp_flx).OR.(ksbc == jp_ cpl) ) THEN325 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 322 326 323 327 ztmpn(:,:,:)=0.0 … … 490 494 ! x comp and y comp of sea surface slope (on F points) 491 495 ! T point to F point 492 DO jj=1,jpjm1 493 DO ji=1,jpim1 494 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj ))/e1u(ji,jj ) & 495 + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 496 * fmask(ji,jj,1) 497 ENDDO 498 ENDDO 499 CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 496 DO jj = 1, jpjm1 497 DO ji = 1, jpim1 498 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 499 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 500 END DO 501 END DO 502 CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 500 503 501 504 ! T point to F point 502 DO jj=1,jpjm1 503 DO ji=1,jpim1 504 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj))/e2v(ji ,jj) & 505 + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 506 * fmask(ji,jj,1) 507 ENDDO 508 ENDDO 505 DO jj = 1, jpjm1 506 DO ji = 1, jpim1 507 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 508 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 509 END DO 510 END DO 509 511 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 510 512 511 CALL wrk_dealloc( jpi,jpj, ztmp )513 CALL wrk_dealloc( jpi,jpj, ztmp, zpice ) 512 514 CALL wrk_dealloc( jpi,jpj,ncat, ztmpn ) 513 515 ! … … 517 519 518 520 519 SUBROUTINE cice_sbc_out (kt,ksbc)521 SUBROUTINE cice_sbc_out( kt, ksbc ) 520 522 !!--------------------------------------------------------------------- 521 523 !! *** ROUTINE cice_sbc_out *** … … 575 577 ! Update taum with modulus of ice-ocean stress 576 578 ! 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.)579 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2) 578 580 579 581 ! Freshwater fluxes … … 587 589 ELSE IF (ksbc == jp_core) THEN 588 590 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 589 ELSE IF (ksbc == jp_ cpl) THEN591 ELSE IF (ksbc == jp_purecpl) THEN 590 592 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 591 593 ! This is currently as required with the coupling fields from the UM atmosphere … … 623 625 ENDIF 624 626 ! Take into account snow melting except for fully coupled when already in qns_tot 625 IF (ksbc == jp_ cpl) THEN627 IF (ksbc == jp_purecpl) THEN 626 628 qsr(:,:)= qsr_tot(:,:) 627 629 qns(:,:)= qns_tot(:,:) … … 658 660 659 661 CALL cice2nemo(aice,fr_i,'T', 1. ) 660 IF ( (ksbc == jp_flx).OR.(ksbc == jp_ cpl) ) THEN662 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 661 663 DO jl=1,ncat 662 664 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 888 890 #endif 889 891 !!--------------------------------------------------------------------- 890 891 892 CHARACTER(len=1), INTENT( in ) :: & 892 893 cd_type ! nature of pn grid-point … … 908 909 909 910 INTEGER :: ji, jj, jn ! dummy loop indices 911 !!--------------------------------------------------------------------- 910 912 911 913 ! A. Ensure all haloes are filled in NEMO field (pn) … … 1096 1098 !! Default option Dummy module NO CICE sea-ice model 1097 1099 !!---------------------------------------------------------------------- 1098 !! $Id$1099 1100 CONTAINS 1100 1101
Note: See TracChangeset
for help on using the changeset viewer.