- Timestamp:
- 2020-10-06T18:17:44+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC
- Files:
-
- 18 edited
-
cpl_oasis3.F90 (modified) (6 diffs)
-
fldread.F90 (modified) (1 diff)
-
sbc_ice.F90 (modified) (5 diffs)
-
sbc_oce.F90 (modified) (2 diffs)
-
sbcblk.F90 (modified) (21 diffs)
-
sbcblk_algo_coare3p0.F90 (modified) (3 diffs)
-
sbcblk_algo_coare3p6.F90 (modified) (2 diffs)
-
sbcblk_algo_ecmwf.F90 (modified) (2 diffs)
-
sbcblk_algo_ncar.F90 (modified) (3 diffs)
-
sbcblk_phy.F90 (modified) (8 diffs)
-
sbcblk_skin_coare.F90 (modified) (2 diffs)
-
sbcblk_skin_ecmwf.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (34 diffs)
-
sbcdcy.F90 (modified) (4 diffs)
-
sbcflx.F90 (modified) (9 diffs)
-
sbcmod.F90 (modified) (6 diffs)
-
sbcrnf.F90 (modified) (4 diffs)
-
sbcwave.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/cpl_oasis3.F90
r13286 r13571 165 165 ENDIF 166 166 ! 167 ! ... Define the shape for the area that excludes the halo 168 ! For serial configuration (key_mpp_mpi not being active) 169 ! nl* is set to the global values 1 and jp*glo. 167 ! ... Define the shape for the area that excludes the halo as we don't want them to be "seen" by oasis 170 168 ! 171 169 ishape(1) = 1 … … 176 174 ! ... Allocate memory for data exchange 177 175 ! 178 ALLOCATE(exfld(Ni_0, Nj_0), stat = nerror) 176 ALLOCATE(exfld(Ni_0, Nj_0), stat = nerror) ! allocate only inner domain (without halos) 179 177 IF( nerror > 0 ) THEN 180 178 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN … … 182 180 ! 183 181 ! ----------------------------------------------------------------- 184 ! ... Define the partition 182 ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 185 183 ! ----------------------------------------------------------------- 186 184 187 paral(1) = 2 188 paral(2) = jpiglo * (Njs0-1+njmpp-1) + (Nis0-1+nimpp-1) ! NEMO lower left corner global offset189 paral(3) = Ni_0 ! local extent in i190 paral(4) = Nj_0 ! local extent in j191 paral(5) = jpiglo ! global extent in x185 paral(1) = 2 ! box partitioning 186 paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos 187 paral(3) = Ni_0 ! local extent in i, excluding halos 188 paral(4) = Nj_0 ! local extent in j, excluding halos 189 paral(5) = Ni0glo ! global extent in x, excluding halos 192 190 193 191 IF( sn_cfctl%l_oasout ) THEN 194 192 WRITE(numout,*) ' multiexchg: paral (1:5)', paral 195 WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj193 WRITE(numout,*) ' multiexchg: Ni_0, Nj_0 =', Ni_0, Nj_0 196 194 WRITE(numout,*) ' multiexchg: Nis0, Nie0, nimpp =', Nis0, Nie0, nimpp 197 195 WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 198 196 ENDIF 199 197 200 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo )198 CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo ) ! global number of points, excluding halos 201 199 ! 202 200 ! ... Announce send variables. … … 327 325 DO jm = 1, ssnd(kid)%ncplmodel 328 326 329 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 327 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN ! exclude halos from data sent to oasis 330 328 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 331 329 … … 386 384 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 387 385 388 IF ( sn_cfctl%l_oasout ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 386 IF ( sn_cfctl%l_oasout ) & 387 & WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 389 388 390 IF( llaction ) THEN 389 IF( llaction ) THEN ! data received from oasis do not include halos 391 390 392 391 kinfo = OASIS_Rcv … … 417 416 ENDDO 418 417 419 !--- Fill the overlap areas and extra hallows (mpp) 420 !--- check periodicity conditions (all cases) 418 !--- we must call lbc_lnk to fill the halos that where not received. 421 419 IF( .NOT. ll_1st ) THEN 422 420 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/fldread.F90
r13295 r13571 216 216 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 217 217 & sd(jf)%nrec(1,ibb), sd(jf)%nrec(1,iaa), REAL(sd(jf)%nrec(2,ibb),wp)/rday, REAL(sd(jf)%nrec(2,iaa),wp)/rday 218 WRITE(numout, *) ' zt_offset is : ',zt_offset218 IF( zt_offset /= 0._wp ) WRITE(numout, *) ' zt_offset is : ', zt_offset 219 219 ENDIF 220 220 ! temporal interpolation weights -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbc_ice.F90
r12396 r13571 69 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s] 70 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_ice !: wind speed module at T-point [m/s] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sstfrz !: wind speed module at T-point [m/s] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sstfrz !: sea surface freezing temperature [degC] 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rCdU_ice !: ice-ocean drag at T-point (<0) [m/s] 72 73 #endif 73 74 … … 89 90 ! variables used in the coupled interface 90 91 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice 92 93 93 94 ! already defined in ice.F90 for SI3 … … 98 99 #endif 99 100 100 REAL(wp), PUBLIC, SAVE :: cldf_ice= 0.81 !: cloud fraction over sea ice, summer CLIO value [-]101 REAL(wp), PUBLIC, SAVE :: pp_cldf = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 101 102 102 103 !! arrays relating to embedding ice in the ocean … … 131 132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 132 133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 133 & emp_ice (jpi,jpj) , sstfrz (jpi,jpj) , STAT= ierr(2) )134 & emp_ice (jpi,jpj) , sstfrz (jpi,jpj) , rCdU_ice (jpi,jpj) , STAT= ierr(2) ) 134 135 #endif 135 136 … … 167 168 LOGICAL , PUBLIC, PARAMETER :: lk_si3 = .FALSE. !: no SI3 ice model 168 169 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE ice model 169 REAL(wp) , PUBLIC, PARAMETER :: cldf_ice = 0.81!: cloud fraction over sea ice, summer CLIO value [-]170 REAL(wp) , PUBLIC, PARAMETER :: pp_cldf = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 170 171 INTEGER , PUBLIC, PARAMETER :: jpl = 1 171 172 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbc_oce.F90
r13295 r13571 136 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] 137 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-] 138 139 139 140 !!--------------------------------------------------------------------- … … 188 189 ! 189 190 ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , & 190 & atm_co2(jpi,jpj) , tsk_m(jpi,jpj) , 191 & atm_co2(jpi,jpj) , tsk_m(jpi,jpj) , cloud_fra(jpi,jpj), & 191 192 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 192 193 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk.F90
r13295 r13571 44 44 USE lib_fortran ! to use key_nosignedzero 45 45 #if defined key_si3 46 USE ice , ONLY : jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif47 USE ice thd_dh ! for CALL ice_thd_snwblow46 USE ice , ONLY : u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif, nn_qtrice 47 USE icevar ! for CALL ice_var_snwblow 48 48 #endif 49 49 USE sbcblk_algo_ncar ! => turb_ncar : NCAR - CORE (Large & Yeager, 2009) … … 87 87 INTEGER , PUBLIC, PARAMETER :: jp_voatm = 11 ! index of surface current (j-component) 88 88 ! ! seen by the atmospheric forcing (m/s) at T-point 89 INTEGER , PUBLIC, PARAMETER :: jp_hpgi = 12 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 90 INTEGER , PUBLIC, PARAMETER :: jp_hpgj = 13 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 91 INTEGER , PUBLIC, PARAMETER :: jpfld = 13 ! maximum number of files to read 89 INTEGER , PUBLIC, PARAMETER :: jp_cc = 12 ! index of cloud cover (-) range:0-1 90 INTEGER , PUBLIC, PARAMETER :: jp_hpgi = 13 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 91 INTEGER , PUBLIC, PARAMETER :: jp_hpgj = 14 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 92 INTEGER , PUBLIC, PARAMETER :: jpfld = 14 ! maximum number of files to read 92 93 93 94 ! Warning: keep this structure allocatable for Agrif... … … 175 176 TYPE(FLD_N) :: sn_qlw , sn_tair , sn_prec, sn_snow ! " " 176 177 TYPE(FLD_N) :: sn_slp , sn_uoatm, sn_voatm ! " " 177 TYPE(FLD_N) :: sn_ hpgi, sn_hpgj! " "178 TYPE(FLD_N) :: sn_cc, sn_hpgi, sn_hpgj ! " " 178 179 INTEGER :: ipka ! number of levels in the atmospheric variable 179 180 NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw , & ! input fields 180 181 & sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm, & 181 & sn_ hpgi, sn_hpgj,&182 & sn_cc, sn_hpgi, sn_hpgj, & 182 183 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF, & ! bulk algorithm 183 184 & cn_dir , rn_zqt, rn_zu, & … … 260 261 slf_i(jp_tair ) = sn_tair ; slf_i(jp_humi ) = sn_humi 261 262 slf_i(jp_prec ) = sn_prec ; slf_i(jp_snow ) = sn_snow 262 slf_i(jp_slp ) = sn_slp 263 slf_i(jp_slp ) = sn_slp ; slf_i(jp_cc ) = sn_cc 263 264 slf_i(jp_uoatm) = sn_uoatm ; slf_i(jp_voatm) = sn_voatm 264 265 slf_i(jp_hpgi ) = sn_hpgi ; slf_i(jp_hpgj ) = sn_hpgj … … 289 290 ! 290 291 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to default) 291 IF( jfpr == jp_slp 292 IF( jfpr == jp_slp ) THEN 292 293 sf(jfpr)%fnow(:,:,1:ipka) = 101325._wp ! use standard pressure in Pa 293 294 ELSEIF( jfpr == jp_prec .OR. jfpr == jp_snow .OR. jfpr == jp_uoatm .OR. jfpr == jp_voatm ) THEN 294 295 sf(jfpr)%fnow(:,:,1:ipka) = 0._wp ! no precip or no snow or no surface currents 295 ELSEIF( ( jfpr == jp_hpgi .OR. jfpr == jp_hpgj ) .AND. .NOT. ln_abl ) THEN 296 DEALLOCATE( sf(jfpr)%fnow ) ! deallocate as not used in this case 296 ELSEIF( jfpr == jp_hpgi .OR. jfpr == jp_hpgj ) THEN 297 IF( .NOT. ln_abl ) THEN 298 DEALLOCATE( sf(jfpr)%fnow ) ! deallocate as not used in this case 299 ELSE 300 sf(jfpr)%fnow(:,:,1:ipka) = 0._wp 301 ENDIF 302 ELSEIF( jfpr == jp_cc ) THEN 303 sf(jp_cc)%fnow(:,:,1:ipka) = pp_cldf 297 304 ELSE 298 305 WRITE(ctmp1,*) 'sbc_blk_init: no default value defined for field number', jfpr … … 303 310 ! 304 311 IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) & 305 306 312 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 313 & ' This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 307 314 ENDIF 308 315 END DO … … 559 566 ptsk(:,:) = pst(:,:) + rt0 ! by default: skin temperature = "bulk SST" (will remain this way if NCAR algorithm used!) 560 567 568 ! --- cloud cover --- ! 569 cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 570 561 571 ! ----------------------------------------------------------------------------- ! 562 572 ! 0 Wind components and module at T-point relative to the moving ocean ! … … 568 578 zwnd_j(:,:) = 0._wp 569 579 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) 570 DO_2D( 1, 1, 1, 1)580 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 571 581 zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 572 582 zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) … … 576 586 #else 577 587 ! ... scalar wind module at T-point (not masked) 578 DO_2D( 1, 1, 1, 1)588 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 579 589 wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 580 590 END_2D … … 628 638 ! use scalar version of gamma_moist() ... 629 639 IF( ln_tpot ) THEN 630 DO_2D( 1, 1, 1, 1)640 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 631 641 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 632 642 END_2D … … 690 700 691 701 IF( ln_abl ) THEN !== ABL formulation ==! multiplication by rho_air and turbulent fluxes computation done in ablstp 692 DO_2D( 1, 1, 1, 1)702 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 693 703 zztmp = zU_zu(ji,jj) 694 704 wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod … … 710 720 pevp(:,:) = pevp(:,:) * tmask(:,:,1) 711 721 712 DO_2D( 1, 1, 1, 1)722 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 713 723 IF( wndm(ji,jj) > 0._wp ) THEN 714 724 zztmp = taum(ji,jj) / wndm(ji,jj) … … 828 838 829 839 ! use scalar version of L_vap() for AGRIF compatibility 830 DO_2D( 1, 1, 1, 1)840 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 831 841 zqla(ji,jj) = - L_vap( ztskk(ji,jj) ) * pevp(ji,jj) ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 832 842 END_2D … … 933 943 ! ------------------------------------------------------------ ! 934 944 ! C-grid ice dynamics : U & V-points (same as ocean) 935 DO_2D( 1, 1, 1, 1)945 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 936 946 wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 937 947 END_2D … … 978 988 zztmp1 = 11637800.0_wp 979 989 zztmp2 = -5897.8_wp 980 DO_2D( 1, 1, 1, 1)990 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 981 991 pcd_dui(ji,jj) = zcd_dui (ji,jj) 982 992 pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) … … 1019 1029 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 1020 1030 REAL(wp) :: zztmp, zztmp2, z1_rLsub ! - - 1021 REAL(wp) :: zfr1, zfr2 ! local variables1022 1031 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature 1023 1032 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice … … 1028 1037 REAL(wp), DIMENSION(jpi,jpj) :: zqair ! specific humidity of air at z=rn_zqt [kg/kg] !LB 1029 1038 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 1039 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1030 1040 !!--------------------------------------------------------------------- 1031 1041 ! … … 1112 1122 ! --- evaporation minus precipitation --- ! 1113 1123 zsnw(:,:) = 0._wp 1114 CALL ice_ thd_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing1124 CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing 1115 1125 emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 1116 1126 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw … … 1139 1149 END DO 1140 1150 1141 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 1142 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm 1143 zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1 1144 ! 1145 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 1146 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 1147 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 1148 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 1149 ELSEWHERE ! zero when hs>0 1150 qtr_ice_top(:,:,:) = 0._wp 1151 END WHERE 1152 ! 1153 1151 ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 1152 IF( nn_qtrice == 0 ) THEN 1153 ! formulation derived from Grenfell and Maykut (1977), where transmission rate 1154 ! 1) depends on cloudiness 1155 ! 2) is 0 when there is any snow 1156 ! 3) tends to 1 for thin ice 1157 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 1158 DO jl = 1, jpl 1159 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 1160 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 1161 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 1162 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 1163 ELSEWHERE ! zero when hs>0 1164 qtr_ice_top(:,:,jl) = 0._wp 1165 END WHERE 1166 ENDDO 1167 ELSEIF( nn_qtrice == 1 ) THEN 1168 ! formulation is derived from the thesis of M. Lebrun (2019). 1169 ! It represents the best fit using several sets of observations 1170 ! It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 1171 qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:) 1172 ENDIF 1173 ! 1154 1174 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN 1155 1175 ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) … … 1233 1253 ! 1234 1254 DO jl = 1, jpl 1235 DO_2D( 1, 1, 1, 1)1255 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 1236 1256 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness 1237 1257 IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor … … 1248 1268 ! 1249 1269 DO jl = 1, jpl 1250 DO_2D( 1, 1, 1, 1)1270 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 1251 1271 ! 1252 1272 zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk_algo_coare3p0.F90
r13295 r13571 394 394 !!------------------------------------------------------------------- 395 395 ! 396 DO_2D( 1, 1, 1, 1)396 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 397 397 ! 398 398 zw = pwnd(ji,jj) ! wind speed … … 430 430 !!---------------------------------------------------------------------------------- 431 431 ! 432 DO_2D( 1, 1, 1, 1)432 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 433 433 ! 434 434 zta = pzeta(ji,jj) … … 481 481 REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 482 482 ! 483 DO_2D( 1, 1, 1, 1)483 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 484 484 ! 485 485 zta = pzeta(ji,jj) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk_algo_coare3p6.F90
r13295 r13571 430 430 !!---------------------------------------------------------------------------------- 431 431 ! 432 DO_2D( 1, 1, 1, 1)432 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 433 433 ! 434 434 zta = pzeta(ji,jj) … … 481 481 REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 482 482 ! 483 DO_2D( 1, 1, 1, 1)483 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 484 484 ! 485 485 zta = pzeta(ji,jj) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r13295 r13571 410 410 REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab 411 411 !!---------------------------------------------------------------------------------- 412 DO_2D( 1, 1, 1, 1)412 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 413 413 ! 414 414 zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): … … 455 455 !!---------------------------------------------------------------------------------- 456 456 ! 457 DO_2D( 1, 1, 1, 1)457 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 458 458 ! 459 459 zzeta = MIN(pzeta(ji,jj) , 5._wp) ! Very stable conditions (L positif and big!): -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk_algo_ncar.F90
r13295 r13571 241 241 !!---------------------------------------------------------------------------------- 242 242 ! 243 DO_2D( 1, 1, 1, 1)243 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 244 244 ! 245 245 zw = pw10(ji,jj) … … 277 277 REAL(wp) :: zx2, zx, zstab ! local scalars 278 278 !!---------------------------------------------------------------------------------- 279 DO_2D( 1, 1, 1, 1)279 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 280 280 zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 281 281 zx2 = MAX( zx2 , 1._wp ) … … 308 308 !!---------------------------------------------------------------------------------- 309 309 ! 310 DO_2D( 1, 1, 1, 1)310 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 311 311 zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 312 312 zx2 = MAX( zx2 , 1._wp ) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk_phy.F90
r13295 r13571 181 181 !!---------------------------------------------------------------------------------- 182 182 ! 183 DO_2D( 1, 1, 1, 1)183 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 184 184 ztc = ptak(ji,jj) - rt0 ! air temp, in deg. C 185 185 ztc2 = ztc*ztc … … 270 270 INTEGER :: ji, jj ! dummy loop indices 271 271 !!---------------------------------------------------------------------------------- 272 DO_2D( 1, 1, 1, 1)272 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 273 273 gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) ) 274 274 END_2D … … 315 315 !!------------------------------------------------------------------- 316 316 ! 317 DO_2D( 1, 1, 1, 1)317 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 318 318 ! 319 319 zqa = (1._wp + rctv0*pqa(ji,jj)) … … 351 351 !!------------------------------------------------------------------- 352 352 ! 353 DO_2D( 1, 1, 1, 1)353 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 354 354 ! 355 355 zqa = 0.5_wp*(pqa(ji,jj)+pssq(ji,jj)) ! ~ mean q within the layer... … … 448 448 !!---------------------------------------------------------------------------------- 449 449 ! 450 DO_2D( 1, 1, 1, 1)450 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 451 451 ! 452 452 ze_sat = e_sat_sclr( ptak(ji,jj) ) … … 473 473 !!---------------------------------------------------------------------------------- 474 474 ! 475 DO_2D( 1, 1, 1, 1)475 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 476 476 ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj)) 477 477 q_air_rh(ji,jj) = ze*reps0/(pslp(ji,jj) - (1. - reps0)*ze) … … 511 511 INTEGER :: ji, jj ! dummy loop indices 512 512 !!---------------------------------------------------------------------------------- 513 DO_2D( 1, 1, 1, 1)513 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 514 514 515 515 zdt = pTa(ji,jj) - pTs(ji,jj) ; zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt ) … … 621 621 IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 622 622 623 DO_2D( 1, 1, 1, 1)623 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 624 624 625 625 CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk_skin_coare.F90
r13295 r13571 89 89 REAL(wp) :: zQabs, zdlt, zfr, zalfa, zqlat, zus 90 90 !!--------------------------------------------------------------------- 91 DO_2D( 1, 1, 1, 1)91 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 92 92 93 93 zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, … … 156 156 ztime = REAL(nsec_day,wp)/(24._wp*3600._wp) ! time of current time step since 00:00 for current day (UTC) -> ztime = 0 -> 00:00 / ztime = 0.5 -> 12:00 ... 157 157 158 DO_2D( 1, 1, 1, 1)158 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 159 159 160 160 l_exit = .FALSE. -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcblk_skin_ecmwf.F90
r13295 r13571 95 95 REAL(wp) :: zQabs, zdlt, zfr, zalfa, zus 96 96 !!--------------------------------------------------------------------- 97 DO_2D( 1, 1, 1, 1)97 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 98 98 99 99 zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, … … 173 173 IF( PRESENT(pustk) ) l_pustk_known = .TRUE. 174 174 175 DO_2D( 1, 1, 1, 1)175 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 176 176 177 177 zHwl = Hz_wl(ji,jj) ! first guess for warm-layer depth (and unique..., less advanced than COARE3p6 !) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbccpl.F90
r13295 r13571 41 41 #endif 42 42 #if defined key_si3 43 USE ice thd_dh ! for CALL ice_thd_snwblow43 USE icevar ! for CALL ice_var_snwblow 44 44 #endif 45 45 ! … … 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 … … 191 205 192 206 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 207 #if defined key_si3 || defined key_cice 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time 209 #endif 193 210 194 211 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 211 228 !! *** FUNCTION sbc_cpl_alloc *** 212 229 !!---------------------------------------------------------------------- 213 INTEGER :: ierr( 4)230 INTEGER :: ierr(5) 214 231 !!---------------------------------------------------------------------- 215 232 ierr(:) = 0 … … 221 238 #endif 222 239 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 223 ! 224 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 240 #if defined key_si3 || defined key_cice 241 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 242 #endif 243 ! 244 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 225 245 226 246 sbc_cpl_alloc = MAXVAL( ierr ) … … 249 269 REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos 250 270 !! 251 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 271 NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, & 272 & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 252 273 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 253 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc ,&254 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr ,&274 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 275 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 255 276 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_tauwoc, & 256 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal ,&257 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,&258 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl ,&277 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 278 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 279 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 259 280 & sn_rcv_ts_ice 260 261 281 !!--------------------------------------------------------------------- 262 282 ! … … 278 298 ENDIF 279 299 IF( lwp .AND. ln_cpl ) THEN ! control print 300 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 301 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 302 WRITE(numout,*)' ln_scale_ice_flux = ', ln_scale_ice_flux 303 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 280 304 WRITE(numout,*)' received fields (mutiple ice categogies)' 281 305 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 326 350 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 327 351 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 328 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel329 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask330 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl331 352 ENDIF 332 353 … … 367 388 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & 368 389 .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 369 390 ! 370 391 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 371 392 … … 698 719 ! Change first letter to couple with atmosphere if already coupled OPA 699 720 ! this is nedeed as each variable name used in the namcouple must be unique: 700 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere721 ! for example O_Runoff received by OPA from SAS and therefore S_Runoff received by SAS from the Atmosphere 701 722 DO jn = 1, jprcv 702 723 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) … … 822 843 END SELECT 823 844 845 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 846 #if defined key_si3 || defined key_cice 847 a_i_last_couple(:,:,:) = 0._wp 848 #endif 824 849 ! ! ------------------------- ! 825 850 ! ! Ice Meltponds ! … … 1110 1135 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1111 1136 REAL(wp) :: zzx, zzy ! temporary variables 1112 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1137 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1113 1138 !!---------------------------------------------------------------------- 1114 1139 ! … … 1170 1195 ! 1171 1196 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1172 DO_2D( 0, 0, 0, 0 ) 1197 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1173 1198 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1174 1199 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) … … 1224 1249 ENDIF 1225 1250 ENDIF 1226 1251 !!$ ! ! ========================= ! 1252 !!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction ! 1253 !!$ ! ! ========================= ! 1254 !!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 1255 !!$ END SELECT 1256 !!$ 1257 zcloud_fra(:,:) = pp_cldf ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 1258 IF( ln_mixcpl ) THEN 1259 cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 1260 ELSE 1261 cloud_fra(:,:) = zcloud_fra(:,:) 1262 ENDIF 1263 ! ! ========================= ! 1227 1264 ! u(v)tau and taum will be modified by ice model 1228 1265 ! -> need to be reset before each call of the ice/fsbc … … 1549 1586 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1550 1587 CASE( 'T' ) 1551 DO_2D( 0, 0, 0, 0 ) 1588 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1552 1589 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1553 1590 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) … … 1623 1660 ! 1624 1661 INTEGER :: ji, jj, jl ! dummy loop index 1625 REAL(wp) :: ztri ! local scalar1626 1662 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1627 1663 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1628 1664 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1665 REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total 1629 1666 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 1667 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1630 1668 !!---------------------------------------------------------------------- 1631 1669 ! … … 1647 1685 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1648 1686 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1649 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)1650 1687 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1651 1688 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1659 1696 1660 1697 #if defined key_si3 1698 1699 ! --- evaporation over ice (kg/m2/s) --- ! 1700 IF (ln_scale_ice_flux) THEN ! typically met-office requirements 1701 IF (sn_rcv_emp%clcat == 'yes') THEN 1702 WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1703 ELSEWHERE ; zevap_ice(:,:,:) = 0._wp 1704 END WHERE 1705 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1706 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1707 END WHERE 1708 ELSE 1709 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 1710 ELSEWHERE ; zevap_ice(:,:,1) = 0._wp 1711 END WHERE 1712 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1713 DO jl = 2, jpl 1714 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1715 ENDDO 1716 ENDIF 1717 ELSE 1718 IF (sn_rcv_emp%clcat == 'yes') THEN 1719 zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 1720 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1721 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1722 END WHERE 1723 ELSE 1724 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 1725 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1726 DO jl = 2, jpl 1727 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1728 ENDDO 1729 ENDIF 1730 ENDIF 1731 1732 IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 1733 ! For conservative case zemp_ice has not been defined yet. Do it now. 1734 zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 1735 ENDIF 1736 1661 1737 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1662 zsnw(:,:) = 0._wp ; CALL ice_ thd_snwblow( ziceld, zsnw )1738 zsnw(:,:) = 0._wp ; CALL ice_var_snwblow( ziceld, zsnw ) 1663 1739 1664 1740 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! … … 1667 1743 1668 1744 ! --- evaporation over ocean (used later for qemp) --- ! 1669 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1670 1671 ! --- evaporation over ice (kg/m2/s) --- ! 1672 DO jl=1,jpl 1673 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1674 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1675 ENDDO 1745 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 1676 1746 1677 1747 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1751 1821 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1752 1822 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1753 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving1754 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs1755 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow1756 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation1757 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation1758 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)1759 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)1760 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average)1761 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )! Sublimation over sea-ice (cell average)1762 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &1763 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )! ice-free oce evap (cell average)1823 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1824 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs 1825 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1826 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation 1827 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1828 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1829 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1830 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1831 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1832 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1833 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1764 1834 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1765 1835 ! … … 1769 1839 CASE( 'oce only' ) ! the required field is directly provided 1770 1840 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1841 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1842 ! here so the only flux is the ocean only one. 1843 zqns_ice(:,:,:) = 0._wp 1771 1844 CASE( 'conservative' ) ! the required fields are directly provided 1772 1845 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1798 1871 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1799 1872 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1800 & 1873 & + pist(:,:,jl) * picefr(:,:) ) ) 1801 1874 END DO 1802 1875 ELSE … … 1804 1877 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1805 1878 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1806 & 1879 & + pist(:,:,jl) * picefr(:,:) ) ) 1807 1880 END DO 1808 1881 ENDIF … … 1910 1983 CASE( 'oce only' ) 1911 1984 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1985 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 1986 ! here so the only flux is the ocean only one. 1987 zqsr_ice(:,:,:) = 0._wp 1912 1988 CASE( 'conservative' ) 1913 1989 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1995 2071 ENDDO 1996 2072 ENDIF 2073 CASE( 'none' ) 2074 zdqns_ice(:,:,:) = 0._wp 1997 2075 END SELECT 1998 2076 … … 2010 2088 ! ! ========================= ! 2011 2089 CASE ('coupled') 2012 IF( ln_mixcpl ) THEN 2013 DO jl=1,jpl 2014 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2015 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2016 ENDDO 2090 IF (ln_scale_ice_flux) THEN 2091 WHERE( a_i(:,:,:) > 1.e-10_wp ) 2092 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2093 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2094 ELSEWHERE 2095 qml_ice(:,:,:) = 0.0_wp 2096 qcn_ice(:,:,:) = 0.0_wp 2097 END WHERE 2017 2098 ELSE 2018 2099 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) … … 2025 2106 IF( .NOT.ln_cndflx ) THEN !== No conduction flux as surface forcing ==! 2026 2107 ! 2027 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2028 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm (Grenfell Maykut 77) 2029 ! 2030 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2031 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2032 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2033 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2034 ELSEWHERE ! zero when hs>0 2035 zqtr_ice_top(:,:,:) = 0._wp 2036 END WHERE 2108 IF( nn_qtrice == 0 ) THEN 2109 ! formulation derived from Grenfell and Maykut (1977), where transmission rate 2110 ! 1) depends on cloudiness 2111 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2112 ! ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 2113 ! 2) is 0 when there is any snow 2114 ! 3) tends to 1 for thin ice 2115 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 2116 DO jl = 1, jpl 2117 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2118 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 2119 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2120 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 2121 ELSEWHERE ! zero when hs>0 2122 zqtr_ice_top(:,:,jl) = 0._wp 2123 END WHERE 2124 ENDDO 2125 ELSEIF( nn_qtrice == 1 ) THEN 2126 ! formulation is derived from the thesis of M. Lebrun (2019). 2127 ! It represents the best fit using several sets of observations 2128 ! It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 2129 zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 2130 ENDIF 2037 2131 ! 2038 2132 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2039 2133 ! 2040 ! 2041 ! 2134 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2135 ! for now just assume zero (fully opaque ice) 2042 2136 zqtr_ice_top(:,:,:) = 0._wp 2043 2137 ! … … 2096 2190 ! 2097 2191 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 2192 info = OASIS_idle 2098 2193 2099 2194 zfr_l(:,:) = 1.- fr_i(:,:) … … 2234 2329 ENDIF 2235 2330 2331 #if defined key_si3 || defined key_cice 2332 ! If this coupling was successful then save ice fraction for use between coupling points. 2333 ! This is needed for some calculations where the ice fraction at the last coupling point 2334 ! is needed. 2335 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2336 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2337 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2338 a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 2339 ENDIF 2340 ENDIF 2341 #endif 2342 2236 2343 IF( ssnd(jps_fice1)%laction ) THEN 2237 2344 SELECT CASE( sn_snd_thick1%clcat ) … … 2297 2404 SELECT CASE( sn_snd_mpnd%clcat ) 2298 2405 CASE( 'yes' ) 2299 ztmp3(:,:,1:jpl) = a_ip_ frac(:,:,1:jpl)2406 ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl) 2300 2407 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2301 2408 CASE( 'no' ) … … 2303 2410 ztmp4(:,:,:) = 0.0 2304 2411 DO jl=1,jpl 2305 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2306 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2412 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2413 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2307 2414 ENDDO 2308 2415 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcdcy.F90
r13295 r13571 110 110 111 111 imask_night(:,:) = 0 112 DO_2D( 1, 1, 1, 1)112 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 113 113 ztmpm = 0._wp 114 114 IF( ABS(rab(ji,jj)) < 1. ) THEN ! day duration is less than 24h … … 193 193 194 194 zsin = SIN( zdecrad ) ; zcos = COS( zdecrad ) 195 DO_2D( 1, 1, 1, 1)195 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 196 196 ztmp = rad * gphit(ji,jj) 197 197 raa(ji,jj) = SIN( ztmp ) * zsin … … 202 202 ! rab to test if the day time is equal to 0, less than 24h of full day 203 203 rab(:,:) = -raa(:,:) / rbb(:,:) 204 DO_2D( 1, 1, 1, 1)204 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 205 205 IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 206 206 ! When is it night? … … 226 226 ! Avoid possible infinite scaling factor, associated with very short daylight 227 227 ! periods, by ignoring periods less than 1/1000th of a day (ticket #1040) 228 DO_2D( 1, 1, 1, 1)228 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 229 229 IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 230 230 rscal(ji,jj) = 0.0_wp -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcflx.F90
r13295 r13571 29 29 PUBLIC sbc_flx ! routine called by step.F90 30 30 31 INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read32 31 INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file 33 32 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file … … 35 34 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file 36 35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 36 !!INTEGER , PARAMETER :: jp_sfx = 6 ! index of salt flux flux 37 INTEGER , PARAMETER :: jpfld = 5 !! 6 ! maximum number of files to read 37 38 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 38 39 … … 59 60 !! net downward radiative flux qsr (watt/m2) 60 61 !! net upward freshwater (evapo - precip) emp (kg/m2/s) 62 !! salt flux sfx (pss*dh*rho/dt => g/m2/s) 61 63 !! 62 64 !! CAUTION : - never mask the surface stress fields … … 71 73 !! - emp upward mass flux (evap. - precip.) 72 74 !! - sfx salt flux; set to zero at nit000 but possibly non-zero 73 !! if ice is present75 !! if ice 74 76 !!---------------------------------------------------------------------- 75 77 INTEGER, INTENT(in) :: kt ! ocean time step … … 85 87 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 86 88 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures 87 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read88 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 89 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx ! informations about the fields to be read 90 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx 89 91 !!--------------------------------------------------------------------- 90 92 ! … … 105 107 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau 106 108 slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr 107 slf_i(jp_emp ) = sn_emp 109 slf_i(jp_emp ) = sn_emp !! ; slf_i(jp_sfx ) = sn_sfx 108 110 ! 109 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure … … 118 120 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 119 121 ! 120 sfx(:,:) = 0.0_wp ! salt flux due to freezing/melting (non-zero only if ice is present)121 !122 122 ENDIF 123 123 … … 126 126 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 127 127 128 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle 129 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 128 IF( ln_dm2dc ) THEN ! modify now Qsr to include the diurnal cycle 129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(ji,jj,1) 130 ELSE 131 DO_2D( 0, 0, 0, 0 ) 132 qsr(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 133 END_2D 130 134 ENDIF 131 DO_2D( 1, 1, 1, 1 ) 132 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 133 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 134 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 135 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 135 DO_2D( 0, 0, 0, 0 ) ! set the ocean fluxes from read fields 136 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * umask(ji,jj,1) 137 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * vmask(ji,jj,1) 138 qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 139 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * tmask(ji,jj,1) 140 !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) 136 141 END_2D 137 142 ! ! add to qns the heat due to e-p 138 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 143 !!clem: I do not think it is needed 144 !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 139 145 ! 140 qns(:,:) = qns(:,:) * tmask(:,:,1) 141 emp(:,:) = emp(:,:) * tmask(:,:,1) 146 ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 147 CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 148 & qns, 'T', 1._wp, emp , 'T', 1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp ) 142 149 ! 143 ! ! module of wind stress and wind speed at T-point144 zcoef = 1. / ( zrhoa * zcdrag )145 DO_2D( 0, 0, 0, 0 )146 ztx = utau(ji-1,jj ) + utau(ji,jj)147 zty = vtau(ji ,jj-1) + vtau(ji,jj)148 zmod = 0.5 * SQRT( ztx * ztx + zty * zty )149 taum(ji,jj) = zmod150 wndm(ji,jj) = SQRT( zmod * zcoef )151 END_2D152 taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)153 CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1.0_wp ) ; CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1.0_wp )154 155 150 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 156 151 WRITE(numout,*) … … 166 161 ! 167 162 ENDIF 163 ! ! module of wind stress and wind speed at T-point 164 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 165 zcoef = 1. / ( zrhoa * zcdrag ) 166 DO_2D( 0, 0, 0, 0 ) 167 ztx = ( utau(ji-1,jj ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj ,1), umask(ji,jj,1) ) ) 168 zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) ) 169 zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 170 taum(ji,jj) = zmod 171 wndm(ji,jj) = SQRT( zmod * zcoef ) !!clem: not used? 172 END_2D 173 ! 174 CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 168 175 ! 169 176 END SUBROUTINE sbc_flx -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcmod.F90
r13286 r13571 99 99 & nn_ice , ln_ice_embd, & 100 100 & ln_traqsr, ln_dm2dc , & 101 & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn,&102 & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor ,&101 & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn, & 102 & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor , & 103 103 & ln_tauw , nn_lsm, nn_sdrift 104 104 !!---------------------------------------------------------------------- … … 119 119 #if defined key_mpp_mpi 120 120 ncom_fsbc = nn_fsbc ! make nn_fsbc available for lib_mpp 121 #endif 122 #if ! defined key_si3 123 IF( nn_ice == 2 ) nn_ice = 0 ! without key key_si3 you cannot use si3... 121 124 #endif 122 125 ! … … 243 246 ENDIF 244 247 ! 245 246 248 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 247 249 IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case … … 250 252 sfx (:,:) = 0._wp !* salt flux due to freezing/melting 251 253 fmmflx(:,:) = 0._wp !* freezing minus melting flux 254 cloud_fra(:,:) = pp_cldf !* cloud fraction over sea ice (used in si3) 252 255 253 256 taum(:,:) = 0._wp !* wind stress module (needed in GLS in case of reduced restart) … … 334 337 IF( l_sbc_clo ) CALL sbc_clo_init ! closed sea surface initialisation 335 338 ! 336 IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization337 338 IF( ln_abl ) CALL sbc_abl_init ! Atmospheric Boundary Layer (ABL)339 340 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization339 IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization 340 341 IF( ln_abl ) CALL sbc_abl_init ! Atmospheric Boundary Layer (ABL) 342 343 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization 341 344 ! 342 345 ! … … 563 566 ENDIF 564 567 ! 565 CALL iom_put( "utau", utau ) ! i-wind stress (stress can be updated at each time step in sea-ice)566 CALL iom_put( "vtau", vtau ) ! j-wind stress567 !568 568 IF(sn_cfctl%l_prtctl) THEN ! print mean trends (used for debugging) 569 569 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask ) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcrnf.F90
r13295 r13571 215 215 END_2D 216 216 ELSE !* variable volume case 217 DO_2D( 1, 1, 1, 1 ) 217 DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 218 218 h_rnf(ji,jj) = 0._wp 219 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres219 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres 220 220 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm) ! to the bottom of the relevant grid box 221 221 END DO … … 374 374 ENDIF 375 375 END_2D 376 DO_2D( 1, 1, 1, 1 ) 376 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 377 377 h_rnf(ji,jj) = 0._wp 378 378 DO jk = 1, nk_rnf(ji,jj) … … 404 404 WHERE( zrnfcl(:,:,1) > 0._wp ) h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs 405 405 ! 406 DO_2D( 1, 1, 1, 1 ) 406 DO_2D( 1, 1, 1, 1 ) ! take in account min depth of ocean rn_hmin 407 407 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 408 408 jk = mbkt(ji,jj) … … 423 423 END_2D 424 424 ! 425 DO_2D( 1, 1, 1, 1 ) 425 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 426 426 h_rnf(ji,jj) = 0._wp 427 427 DO jk = 1, nk_rnf(ji,jj) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbcwave.F90
r13295 r13571 106 106 !!--------------------------------------------------------------------- 107 107 ! 108 ALLOCATE( ze3divh(jpi,jpj,jpk ) )108 ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 109 109 ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) ) 110 110 ! … … 121 121 zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp ) 122 122 END_2D 123 DO_2D( 1, 0, 1, 0 ) 123 DO_2D( 1, 0, 1, 0 ) ! exp. wave number & Stokes drift velocity at u- & v-points 124 124 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 125 125 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) … … 164 164 zsqrtpi = SQRT(rpi) 165 165 z_two_thirds = 2.0_wp / 3.0_wp 166 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 166 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! exp. wave number & Stokes drift velocity at u- & v-points 167 167 zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) ) ! 2 * bottom depth 168 168 zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) ) ! 2 * bottom depth … … 204 204 ! !== vertical Stokes Drift 3D velocity ==! 205 205 ! 206 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 206 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) ! Horizontal e3*divergence 207 207 ze3divh(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * usd(ji ,jj,jk) & 208 208 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk) &
Note: See TracChangeset
for help on using the changeset viewer.
