- Timestamp:
- 2020-04-24T17:31:59+02:00 (4 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE
- Files:
-
- 7 edited
-
BDY/bdy_oce.F90 (modified) (2 diffs)
-
BDY/bdydta.F90 (modified) (13 diffs)
-
BDY/bdyice.F90 (modified) (7 diffs)
-
LBC/lbc_lnk_multi_generic.h90 (modified) (2 diffs)
-
SBC/sbc_ice.F90 (modified) (3 diffs)
-
SBC/sbcblk.F90 (modified) (9 diffs)
-
SBC/sbccpl.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE/BDY/bdy_oce.F90
r11715 r12812 63 63 REAL(wp), POINTER, DIMENSION(:,:) :: aip !: now ice pond concentration 64 64 REAL(wp), POINTER, DIMENSION(:,:) :: hip !: now ice pond depth 65 REAL(wp), POINTER, DIMENSION(:,:) :: hil !: now ice pond lid depth 65 66 #if defined key_top 66 67 CHARACTER(LEN=20) :: cn_obc !: type of boundary condition to apply … … 115 116 REAL(wp), DIMENSION(jp_bdy) :: rice_apnd !: pond conc. of incoming sea ice 116 117 REAL(wp), DIMENSION(jp_bdy) :: rice_hpnd !: pond thick. of incoming sea ice 118 REAL(wp), DIMENSION(jp_bdy) :: rice_hlid !: pond lid thick. of incoming sea ice 117 119 ! 118 120 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE/BDY/bdydta.F90
r11715 r12812 43 43 PUBLIC bdy_dta_init ! routine called by nemogcm.F90 44 44 45 INTEGER , PARAMETER :: jpbdyfld = 1 6! maximum number of files to read45 INTEGER , PARAMETER :: jpbdyfld = 17 ! maximum number of files to read 46 46 INTEGER , PARAMETER :: jp_bdyssh = 1 ! 47 47 INTEGER , PARAMETER :: jp_bdyu2d = 2 ! … … 60 60 INTEGER , PARAMETER :: jp_bdyaip = 15 ! 61 61 INTEGER , PARAMETER :: jp_bdyhip = 16 ! 62 INTEGER , PARAMETER :: jp_bdyhil = 17 ! 62 63 #if ! defined key_si3 63 64 INTEGER , PARAMETER :: jpl = 1 … … 197 198 dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1) 198 199 dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1) 200 dta_bdy(jbdy)%hil(ib,jl) = h_il(ii,ij,jl) * tmask(ii,ij,1) 199 201 END DO 200 202 END DO … … 302 304 & bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd * a_i ) 303 305 IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 306 IF( TRIM(bf_alias(jp_bdyhil)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhil)%fnow(:,1,:) = rice_hlid(jbdy) 304 307 ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 305 308 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & … … 319 322 bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 320 323 bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 324 bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 325 ENDIF 326 IF ( .NOT.ln_pnd_lids ) THEN 327 bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 321 328 ENDIF 322 329 … … 324 331 ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3) 325 332 IF( ipl /= jpl ) THEN ! ice: convert N-cat fields (input) into jpl-cat (output) 326 CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & 327 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & 328 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 329 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 330 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), &331 & dta_alias%t_i , dta_alias%t_s , & 332 & dta_alias%tsu , dta_alias%s_i , & 333 & dta_alias%aip , dta_alias%hip )333 CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & ! in 334 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & ! out 335 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & ! in (optional) 336 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & ! in - 337 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), bf_alias(jp_bdyhil)%fnow(:,1,:), & ! in - 338 & dta_alias%t_i , dta_alias%t_s , & ! out - 339 & dta_alias%tsu , dta_alias%s_i , & ! out - 340 & dta_alias%aip , dta_alias%hip , dta_alias%hil ) ! out - 334 341 ENDIF 335 342 ENDIF … … 378 385 ! ! =F => baroclinic velocities in 3D boundary data 379 386 LOGICAL :: ln_zinterp ! =T => requires a vertical interpolation of the bdydta 380 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 387 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 381 388 INTEGER :: ipk,ipl ! 382 389 INTEGER :: idvar ! variable ID … … 390 397 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 391 398 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 392 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip 399 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil 393 400 TYPE(FLD_N), DIMENSION(:), POINTER :: bn_alias ! must be an array to be used with fld_fill 394 401 TYPE(FLD ), DIMENSION(:), POINTER :: bf_alias 395 402 ! 396 403 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 397 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip 398 NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 404 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil 405 NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 399 406 NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp 400 407 !!--------------------------------------------------------------------------- … … 452 459 #if defined key_si3 453 460 IF( .NOT.ln_pnd ) THEN 454 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 455 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 461 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. ; rn_ice_hlid = 0. 462 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 & rn_ice_hlid = 0 when no ponds' ) 463 ENDIF 464 IF( .NOT.ln_pnd_lids ) THEN 465 rn_ice_hlid = 0. 456 466 ENDIF 457 467 #endif … … 463 473 rice_apnd(jbdy) = rn_ice_apnd 464 474 rice_hpnd(jbdy) = rn_ice_hpnd 465 475 rice_hlid(jbdy) = rn_ice_hlid 476 466 477 467 478 DO jfld = 1, jpbdyfld … … 562 573 IF( jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 563 574 & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 564 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip 575 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip .OR. jfld == jp_bdyhil ) THEN 565 576 igrd = 1 ! T point 566 577 ipk = ipl ! jpl-cat data … … 613 624 bf_alias => bf(jp_bdyhip,jbdy:jbdy) ! alias for hip structure of bdy number jbdy 614 625 bn_alias => bn_hip ! alias for hip structure of nambdy_dta 626 ENDIF 627 IF( jfld == jp_bdyhil ) THEN 628 cl3 = 'hil' 629 bf_alias => bf(jp_bdyhil,jbdy:jbdy) ! alias for hil structure of bdy number jbdy 630 bn_alias => bn_hil ! alias for hil structure of nambdy_dta 615 631 ENDIF 616 632 … … 681 697 ENDIF 682 698 ENDIF 699 IF( jfld == jp_bdyhil ) THEN 700 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%hil => bf_alias(1)%fnow(:,1,:) 701 ELSE ; ALLOCATE( dta_bdy(jbdy)%hil(iszdim,jpl) ) 702 ENDIF 703 ENDIF 683 704 ENDIF 684 705 -
NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE/BDY/bdyice.F90
r11715 r12812 94 94 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 95 95 ! exchange 3d arrays 96 CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1. &97 & , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1.&98 & , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.&99 & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1)96 CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1. & 97 & , s_i , 'T', 1., t_su, 'T', 1., v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1. & 98 & , a_ip, 'T', 1., v_ip, 'T', 1., v_il, 'T', 1. & 99 & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 100 100 ! exchange 4d arrays : third dimension = 1 and then third dimension = jpk 101 101 CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) … … 163 163 a_ip(ji,jj, jl) = ( a_ip(ji,jj, jl) * zwgt1 + dta%aip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond concentration 164 164 h_ip(ji,jj, jl) = ( h_ip(ji,jj, jl) * zwgt1 + dta%hip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond depth 165 h_il(ji,jj, jl) = ( h_il(ji,jj, jl) * zwgt1 + dta%hil(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond lid depth 165 166 ! 166 167 sz_i(ji,jj,:,jl) = s_i(ji,jj,jl) … … 170 171 a_ip(ji,jj,jl) = 0._wp 171 172 h_ip(ji,jj,jl) = 0._wp 173 h_il(ji,jj,jl) = 0._wp 174 ENDIF 175 176 IF( .NOT.ln_pnd_lids ) THEN 177 h_il(ji,jj,jl) = 0._wp 172 178 ENDIF 173 179 ! … … 231 237 a_ip(ji,jj, jl) = a_ip(ib,jb, jl) 232 238 h_ip(ji,jj, jl) = h_ip(ib,jb, jl) 239 h_il(ji,jj, jl) = h_il(ib,jb, jl) 233 240 ! 234 241 sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) … … 265 272 ! 266 273 ! melt ponds 267 IF( a_i(ji,jj,jl) > epsi10 ) THEN268 a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i (ji,jj,jl)269 ELSE270 a_ip_frac(ji,jj,jl) = 0._wp271 ENDIF272 274 v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) 275 v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) 273 276 ! 274 277 ELSE ! no ice at the boundary … … 278 281 h_s (ji,jj, jl) = 0._wp 279 282 oa_i(ji,jj, jl) = 0._wp 280 a_ip(ji,jj, jl) = 0._wp281 v_ip(ji,jj, jl) = 0._wp282 283 t_su(ji,jj, jl) = rt0 283 284 t_s (ji,jj,:,jl) = rt0 284 285 t_i (ji,jj,:,jl) = rt0 285 286 286 a_ip_frac(ji,jj,jl) = 0._wp 287 h_ip (ji,jj,jl) = 0._wp 288 a_ip (ji,jj,jl) = 0._wp 289 v_ip (ji,jj,jl) = 0._wp 287 a_ip(ji,jj,jl) = 0._wp 288 h_ip(ji,jj,jl) = 0._wp 289 h_il(ji,jj,jl) = 0._wp 290 290 291 291 IF( nn_icesal == 1 ) THEN ! if constant salinity … … 303 303 e_s (ji,jj,:,jl) = 0._wp 304 304 e_i (ji,jj,:,jl) = 0._wp 305 v_ip(ji,jj, jl) = 0._wp 306 v_il(ji,jj, jl) = 0._wp 305 307 306 308 ENDIF -
NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE/LBC/lbc_lnk_multi_generic.h90
r11715 r12812 15 15 #endif 16 16 17 SUBROUTINE ROUTINE_MULTI( cdname & 18 & , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4 & 19 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 20 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 17 SUBROUTINE ROUTINE_MULTI( cdname & 18 & , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4 & 19 & , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8 & 20 & , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12 & 21 & , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16 & 21 22 & , kfillmode, pfillval, lsend, lrecv, ihlcom ) 22 23 !!--------------------------------------------------------------------- 23 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 24 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied 25 ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9 , pt10 , pt11 26 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 27 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 28 REAL(wp) , INTENT(in ) :: psgn1 ! sign used across the north fold 29 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 30 INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 31 REAL(wp) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 32 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 33 INTEGER , OPTIONAL , INTENT(in ) :: ihlcom ! number of ranks and rows to be communicated 24 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 25 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied 26 ARRAY_TYPE(:,:,:,:) , OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9 , & 27 & pt10 , pt11 , pt12 , pt13 , pt14 , pt15 , pt16 28 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 29 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & 30 & cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16 31 REAL(wp) , INTENT(in ) :: psgn1 ! sign used across the north fold 32 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, & 33 & psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16 34 INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 35 REAL(wp) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 36 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 37 INTEGER , OPTIONAL , INTENT(in ) :: ihlcom ! number of ranks and rows to be communicated 34 38 !! 35 39 INTEGER :: kfld ! number of elements that will be attributed 36 PTR_TYPE , DIMENSION(1 1) :: ptab_ptr ! pointer array37 CHARACTER(len=1) , DIMENSION(1 1) :: cdna_ptr ! nature of ptab_ptr grid-points38 REAL(wp) , DIMENSION(1 1) :: psgn_ptr ! sign used across the north fold boundary40 PTR_TYPE , DIMENSION(16) :: ptab_ptr ! pointer array 41 CHARACTER(len=1) , DIMENSION(16) :: cdna_ptr ! nature of ptab_ptr grid-points 42 REAL(wp) , DIMENSION(16) :: psgn_ptr ! sign used across the north fold boundary 39 43 !!--------------------------------------------------------------------- 40 44 ! … … 55 59 IF( PRESENT(psgn10) ) CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 56 60 IF( PRESENT(psgn11) ) CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 61 IF( PRESENT(psgn12) ) CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 62 IF( PRESENT(psgn13) ) CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 63 IF( PRESENT(psgn14) ) CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 64 IF( PRESENT(psgn15) ) CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 65 IF( PRESENT(psgn16) ) CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 57 66 ! 58 CALL lbc_lnk_ptr ( cdname,ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom )67 CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 59 68 ! 60 69 END SUBROUTINE ROUTINE_MULTI -
NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE/SBC/sbc_ice.F90
r11715 r12812 71 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sstfrz !: wind speed module at T-point [m/s] 72 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tsfc_ice !: sea ice surface skin temperature (on categories) 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover [-] 73 74 #endif 74 75 … … 90 91 ! variables used in the coupled interface 91 92 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice 93 94 94 95 ! already defined in ice.F90 for SI3 95 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 96 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i, h_s 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Sea ice fraction on categories at the last coupling point 97 99 98 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K] … … 132 134 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 133 135 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 134 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , STAT= ierr(2) ) 136 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , & 137 & cloud_fra(jpi,jpj) , STAT= ierr(2) ) 135 138 #endif 136 139 -
NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE/SBC/sbcblk.F90
r11715 r12812 80 80 REAL(wp), PARAMETER :: rctv0 = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 81 81 82 INTEGER , PARAMETER :: jpfld =1 0! maximum number of files to read82 INTEGER , PARAMETER :: jpfld =11 ! maximum number of files to read 83 83 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 84 84 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point … … 90 90 INTEGER , PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 91 91 INTEGER , PARAMETER :: jp_slp = 9 ! index of sea level pressure (Pa) 92 INTEGER , PARAMETER :: jp_tdif =10 ! index of tau diff associated to HF tau (N/m2) at T-point 92 INTEGER , PARAMETER :: jp_cc =10 ! index of cloud cover (-) range:0-1 93 INTEGER , PARAMETER :: jp_tdif =11 ! index of tau diff associated to HF tau (N/m2) at T-point 93 94 94 95 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) … … 161 162 !! 162 163 !!---------------------------------------------------------------------- 163 INTEGER :: ifpr, jfld ! dummy loop indice and argument164 INTEGER :: jfpr, jfld ! dummy loop indice and argument 164 165 INTEGER :: ios, ierror, ioptio ! Local integer 165 166 !! … … 168 169 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 169 170 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 170 TYPE(FLD_N) :: sn_slp , sn_tdif 171 TYPE(FLD_N) :: sn_slp , sn_tdif, sn_cc ! " " 171 172 NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw , & ! input fields 172 & sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, 173 & sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, sn_cc, & 173 174 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF, & ! bulk algorithm 174 175 & cn_dir , ln_taudif, rn_zqt, rn_zu, & … … 214 215 slf_i(jp_tair) = sn_tair ; slf_i(jp_humi) = sn_humi 215 216 slf_i(jp_prec) = sn_prec ; slf_i(jp_snow) = sn_snow 216 slf_i(jp_slp) = sn_slp ; slf_i(jp_tdif) = sn_tdif 217 slf_i(jp_slp) = sn_slp ; slf_i(jp_cc) = sn_cc 218 slf_i(jp_tdif) = sn_tdif 217 219 ! 218 220 lhftau = ln_taudif !- add an extra field if HF stress is used … … 222 224 ALLOCATE( sf(jfld), STAT=ierror ) 223 225 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 224 DO ifpr= 1, jfld 225 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 226 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 227 IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 ) & 228 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 229 & ' This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 230 231 END DO 226 232 227 ! !- fill the bulk structure with namelist informations 233 228 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 234 229 ! 230 DO jfpr = 1, jfld 231 ! 232 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to zero) 233 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 234 sf(jfpr)%fnow(:,:,1) = 0._wp 235 ELSE !-- used field --! 236 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 237 IF( slf_i(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 238 IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 ) & 239 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 240 & ' This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 241 ENDIF 242 ENDDO 243 ! fill cloud cover array with constant value if "not used" 244 IF( TRIM(sf(jp_cc)%clrootname) == 'NOT USED' ) sf(jp_cc)%fnow(:,:,1) = cldf_ice 245 235 246 IF ( ln_wave ) THEN 236 247 !Activated wave module but neither drag nor stokes drift activated … … 792 803 REAL(wp) :: zst3 ! local variable 793 804 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 794 REAL(wp) :: zztmp, z1_rLsub ! - - 795 REAL(wp) :: zfr1, zfr2 ! local variables 805 REAL(wp) :: zztmp, z1_rLsub ! - - 796 806 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature 797 807 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice … … 801 811 REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3) 802 812 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa 813 REAL(wp), DIMENSION(jpi,jpj) :: ztri 803 814 !!--------------------------------------------------------------------- 804 815 ! … … 902 913 END DO 903 914 915 ! --- cloud cover --- ! 916 cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 917 904 918 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 905 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm 906 zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1 907 ! 908 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 909 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 910 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 911 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 912 ELSEWHERE ! zero when hs>0 913 qtr_ice_top(:,:,:) = 0._wp 914 END WHERE 919 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 920 ! 921 DO jl = 1, jpl 922 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 923 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 924 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 925 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 926 ELSEWHERE ! zero when hs>0 927 qtr_ice_top(:,:,jl) = 0._wp 928 END WHERE 929 ENDDO 915 930 ! 916 931 IF(ln_ctl) THEN -
NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch/src/OCE/SBC/sbccpl.F90
r11715 r12812 48 48 USE lib_mpp ! distribued memory computing library 49 49 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 50 51 #if defined key_oasis3 52 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 53 #endif 50 54 51 55 IMPLICIT NONE … … 152 156 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 153 157 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 154 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area 158 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area fraction 155 159 INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness 156 160 INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity … … 159 163 160 164 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 165 166 #if ! defined key_oasis3 167 ! Dummy variables to enable compilation when oasis3 is not being used 168 INTEGER :: OASIS_Sent = -1 169 INTEGER :: OASIS_SentOut = -1 170 INTEGER :: OASIS_ToRest = -1 171 INTEGER :: OASIS_ToRestOut = -1 172 #endif 161 173 162 174 ! !!** namelist namsbc_cpl ** … … 184 196 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 185 197 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 198 LOGICAL :: ln_scale_ice_flux ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 199 186 200 TYPE :: DYNARR 187 201 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 248 262 REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos 249 263 !! 250 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 264 NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, & 265 & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 251 266 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 252 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc ,&253 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr ,&267 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 268 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 254 269 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_tauwoc, & 255 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal ,&256 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,&257 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl ,&270 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 271 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 272 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 258 273 & sn_rcv_ts_ice 259 260 274 !!--------------------------------------------------------------------- 261 275 ! … … 279 293 ENDIF 280 294 IF( lwp .AND. ln_cpl ) THEN ! control print 295 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 296 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 297 WRITE(numout,*)' ln_scale_ice_flux = ', ln_scale_ice_flux 298 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 281 299 WRITE(numout,*)' received fields (mutiple ice categogies)' 282 300 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 327 345 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 328 346 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 329 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel330 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask331 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl332 347 ENDIF 333 348 … … 815 830 END SELECT 816 831 832 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 833 #if defined key_si3 || defined key_cice 834 a_i_last_couple(:,:,:) = 0._wp 835 #endif 817 836 ! ! ------------------------- ! 818 837 ! ! Ice Meltponds ! … … 1639 1658 ! 1640 1659 INTEGER :: ji, jj, jl ! dummy loop index 1641 REAL(wp) :: ztri ! local scalar1642 1660 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1643 1661 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1644 1662 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1645 1663 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i 1664 REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total 1665 REAL(wp), DIMENSION(jpi,jpj) :: ztri, zcloud_fra 1646 1666 !!---------------------------------------------------------------------- 1647 1667 ! … … 1663 1683 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1664 1684 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1665 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)1666 1685 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1667 1686 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1675 1694 1676 1695 #if defined key_si3 1696 1697 ! --- evaporation over ice (kg/m2/s) --- ! 1698 IF (ln_scale_ice_flux) THEN ! typically met-office requirements 1699 IF (sn_rcv_emp%clcat == 'yes') THEN 1700 WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1701 ELSEWHERE ; zevap_ice(:,:,:) = 0._wp 1702 END WHERE 1703 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1704 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1705 END WHERE 1706 ELSE 1707 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 1708 ELSEWHERE ; zevap_ice(:,:,1) = 0._wp 1709 END WHERE 1710 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1711 DO jl = 2, jpl 1712 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1713 ENDDO 1714 ENDIF 1715 ELSE 1716 IF (sn_rcv_emp%clcat == 'yes') THEN 1717 zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 1718 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1719 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1720 END WHERE 1721 ELSE 1722 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 1723 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1724 DO jl = 2, jpl 1725 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1726 ENDDO 1727 ENDIF 1728 ENDIF 1729 1730 IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 1731 ! For conservative case zemp_ice has not been defined yet. Do it now. 1732 zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 1733 ENDIF 1734 1677 1735 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1678 1736 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) … … 1683 1741 1684 1742 ! --- evaporation over ocean (used later for qemp) --- ! 1685 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1686 1687 ! --- evaporation over ice (kg/m2/s) --- ! 1688 DO jl=1,jpl 1689 IF (sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1690 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1691 ENDDO 1743 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 1692 1744 1693 1745 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1784 1836 CASE( 'oce only' ) ! the required field is directly provided 1785 1837 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1838 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1839 ! here so the only flux is the ocean only one. 1840 zqns_ice(:,:,:) = 0._wp 1786 1841 CASE( 'conservative' ) ! the required fields are directly provided 1787 1842 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1914 1969 CASE( 'oce only' ) 1915 1970 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1971 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 1972 ! here so the only flux is the ocean only one. 1973 zqsr_ice(:,:,:) = 0._wp 1916 1974 CASE( 'conservative' ) 1917 1975 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1992 2050 ENDDO 1993 2051 ENDIF 2052 CASE( 'none' ) 2053 zdqns_ice(:,:,:) = 0._wp 1994 2054 END SELECT 1995 2055 … … 2007 2067 ! ! ========================= ! 2008 2068 CASE ('coupled') 2009 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2010 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2069 IF (ln_scale_ice_flux) THEN 2070 WHERE( a_i(:,:,:) > 1.e-10_wp ) 2071 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2072 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2073 ELSEWHERE 2074 qml_ice(:,:,:) = 0.0_wp 2075 qcn_ice(:,:,:) = 0.0_wp 2076 END WHERE 2077 ELSE 2078 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2079 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2080 ENDIF 2011 2081 END SELECT 2012 ! 2082 !!$ ! ! ========================= ! 2083 !!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction ! 2084 !!$ ! ! ========================= ! 2085 !!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 2086 !!$ END SELECT 2087 zcloud_fra(:,:) = cldf_ice ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 2088 IF( ln_mixcpl ) THEN 2089 cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 2090 ELSE 2091 cloud_fra(:,:) = zcloud_fra(:,:) 2092 ENDIF 2013 2093 ! ! ========================= ! 2014 2094 ! ! Transmitted Qsr ! [W/m2] … … 2017 2097 ! 2018 2098 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2019 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 2099 ! ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 2100 ztri(:,:) = 0.18 * ( 1.0 - zcloud_fra(:,:) ) + 0.35 * zcloud_fra(:,:) ! surface transmission when hi>10cm (Grenfell Maykut 77) 2020 2101 ! 2021 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2022 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2023 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2102 DO jl = 1, jpl 2103 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2104 zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 2105 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2106 zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 2107 ELSEWHERE ! zero when hs>0 2108 zqtr_ice_top(:,:,jl) = 0._wp 2109 END WHERE 2110 ENDDO 2024 2111 ! 2025 2112 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! … … 2193 2280 ENDIF 2194 2281 2282 #if defined key_si3 || defined key_cice 2283 ! If this coupling was successful then save ice fraction for use between coupling points. 2284 ! This is needed for some calculations where the ice fraction at the last coupling point 2285 ! is needed. 2286 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2287 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2288 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2289 a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 2290 ENDIF 2291 ENDIF 2292 #endif 2293 2195 2294 IF( ssnd(jps_fice1)%laction ) THEN 2196 2295 SELECT CASE( sn_snd_thick1%clcat ) … … 2256 2355 SELECT CASE( sn_snd_mpnd%clcat ) 2257 2356 CASE( 'yes' ) 2258 ztmp3(:,:,1:jpl) = a_ip (:,:,1:jpl)2259 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl)2357 ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl) 2358 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2260 2359 CASE( 'no' ) 2261 2360 ztmp3(:,:,:) = 0.0 2262 2361 ztmp4(:,:,:) = 0.0 2263 2362 DO jl=1,jpl 2264 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip (:,:,jpl)2265 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)2363 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2364 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2266 2365 ENDDO 2267 2366 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )
Note: See TracChangeset
for help on using the changeset viewer.
