Changeset 13281
- Timestamp:
- 2020-07-09T15:19:01+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/ICB
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/ICB/icb_oce.F90
r12472 r13281 57 57 TYPE, PUBLIC :: point !: properties of an individual iceberg (position, mass, size, etc...) 58 58 INTEGER :: year 59 REAL(wp) :: xi , yj ! iceberg coordinates in the (i,j) referential (global)60 REAL(wp) :: e1 , e2 ! horizontal scale factors at the iceberg position61 REAL(wp) :: lon, lat, day ! geographic position62 REAL(wp) :: mass, thickness, width, length, uvel, vvel ! iceberg physical properties63 REAL(wp) :: uo, vo, ui, vi, ua, va, ssh_x, ssh_y, sst, cn, hi ! properties of iceberg environment59 REAL(wp) :: xi , yj ! iceberg coordinates in the (i,j) referential (global) 60 REAL(wp) :: e1 , e2 ! horizontal scale factors at the iceberg position 61 REAL(wp) :: lon, lat, day ! geographic position 62 REAL(wp) :: mass, thickness, width, length, uvel, vvel ! iceberg physical properties 63 REAL(wp) :: uo, vo, ui, vi, ua, va, ssh_x, ssh_y, sst, cn, hi, sss ! properties of iceberg environment 64 64 REAL(wp) :: mass_of_bits, heat_density 65 65 END TYPE point … … 86 86 ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid 87 87 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: uo_e, vo_e 88 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ff_e, tt_e, fr_e 88 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ff_e, tt_e, fr_e, ss_e 89 89 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ua_e, va_e 90 90 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ssh_e … … 183 183 & ff_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1) , & 184 184 & tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) , & 185 & ss_e(0:jpi+1,0:jpj+1) , & 185 186 & first_width(nclasses) , first_length(nclasses) , & 186 187 & src_calving (jpi,jpj) , & -
NEMO/trunk/src/OCE/ICB/icbdyn.F90
r10570 r13281 258 258 ! 259 259 INTEGER :: itloop 260 REAL(wp) :: zuo, zui, zua, zuwave, zssh_x, zsst, zcn, zhi 260 REAL(wp) :: zuo, zui, zua, zuwave, zssh_x, zsst, zcn, zhi, zsss 261 261 REAL(wp) :: zvo, zvi, zva, zvwave, zssh_y 262 262 REAL(wp) :: zff, zT, zD, zW, zL, zM, zF … … 271 271 nknberg = berg%number(1) 272 272 CALL icb_utl_interp( pxi, pe1, zuo, zui, zua, zssh_x, & 273 & pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff )273 & pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff, zsss ) 274 274 275 275 zM = berg%current_point%mass -
NEMO/trunk/src/OCE/ICB/icbini.F90
r12489 r13281 81 81 ua_e(:,:) = 0._wp ; va_e(:,:) = 0._wp ; 82 82 ff_e(:,:) = 0._wp ; tt_e(:,:) = 0._wp ; 83 fr_e(:,:) = 0._wp ; 83 fr_e(:,:) = 0._wp ; ss_e(:,:) = 0._wp ; 84 84 #if defined key_si3 85 85 hi_e(:,:) = 0._wp ; -
NEMO/trunk/src/OCE/ICB/icbthm.F90
r13226 r13281 20 20 USE phycst ! NEMO physical constants 21 21 USE sbc_oce 22 USE eosbn2 ! equation of state 22 23 USE lib_fortran, ONLY : DDPDD 23 24 … … 50 51 INTEGER :: ii, ij 51 52 REAL(wp) :: zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn 53 REAL(wp) :: zSSS, zfzpt 52 54 REAL(wp) :: zMv, zMe, zMb, zmelt, zdvo, zdva, zdM, zSs, zdMe, zdMb, zdMv 53 55 REAL(wp) :: zMnew, zMnew1, zMnew2, zheat_hcflux, zheat_latent, z1_12 … … 85 87 CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x, & 86 88 & pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y, & 87 & pt%sst, pt%cn, pt%hi, zff )89 & pt%sst, pt%cn, pt%hi, zff, pt%sss ) 88 90 ! 89 91 zSST = pt%sst 92 zSSS = pt%sss 93 CALL eos_fzp(zSSS,zfzpt) ! freezing point 90 94 zIC = MIN( 1._wp, pt%cn + rn_sicn_shift ) ! Shift sea-ice concentration !!gm ??? 91 95 zM = pt%mass … … 109 113 110 114 ! Melt rates in m/s (i.e. division by rday) 111 zMv = MAX( 7.62d-3*zSST+1.29d-3*(zSST**2) , 0._wp ) * z1_rday ! Buoyant convection at sides (eqn M.A10) 112 zMb = MAX( 0.58_wp*(zdvo**0.8_wp)*(zSST+4.0_wp)/(zL**0.2_wp) , 0._wp ) * z1_rday ! Basal turbulent melting (eqn M.A7 ) 113 zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3))) , 0._wp ) * z1_rday ! Wave erosion (eqn M.A8 ) 115 zMv = MAX( 7.62d-3*zSST+1.29d-3*(zSST**2) , 0._wp ) * z1_rday ! Buoyant convection at sides (eqn M.A10) 116 IF ( zSST > zfzpt ) THEN ! Calculate basal melting only if SST above freezing point 117 zMb = MAX( 0.58_wp*(zdvo**0.8_wp)*(zSST+4.0_wp)/(zL**0.2_wp) , 0._wp ) * z1_rday ! Basal turbulent melting (eqn M.A7 ) 118 ELSE 119 zMb = 0._wp ! No basal melting if SST below freezing point 120 ENDIF 121 zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3))) , 0._wp ) * z1_rday ! Wave erosion (eqn M.A8 ) 114 122 115 123 IF( ln_operator_splitting ) THEN ! Operator split update of volume/mass -
NEMO/trunk/src/OCE/ICB/icbutl.F90
r10702 r13281 74 74 ff_e(1:jpi,1:jpj) = ff_f (:,:) 75 75 tt_e(1:jpi,1:jpj) = sst_m(:,:) 76 ss_e(1:jpi,1:jpj) = sss_m(:,:) 76 77 fr_e(1:jpi,1:jpj) = fr_i (:,:) 77 78 ua_e(1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk … … 85 86 CALL lbc_lnk_icb( 'icbutl', fr_e, 'T', +1._wp, 1, 1 ) 86 87 CALL lbc_lnk_icb( 'icbutl', tt_e, 'T', +1._wp, 1, 1 ) 88 CALL lbc_lnk_icb( 'icbutl', ss_e, 'T', +1._wp, 1, 1 ) 87 89 #if defined key_si3 88 90 hi_e(1:jpi, 1:jpj) = hm_i (:,:) … … 107 109 SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i, & 108 110 & pj, pe2, pvo, pvi, pva, pssh_j, & 109 & psst, pcn, phi, pff 111 & psst, pcn, phi, pff, psss ) 110 112 !!---------------------------------------------------------------------- 111 113 !! *** ROUTINE icb_utl_interp *** … … 128 130 REAL(wp), INTENT( out) :: puo, pvo, pui, pvi, pua, pva ! ocean, ice and wind speeds 129 131 REAL(wp), INTENT( out) :: pssh_i, pssh_j ! ssh i- & j-gradients 130 REAL(wp), INTENT( out) :: psst, pcn, phi, pff ! SST, ice concentration, ice thickness, Coriolis132 REAL(wp), INTENT( out) :: psst, pcn, phi, pff, psss ! SST, ice concentration, ice thickness, Coriolis, SSS 131 133 ! 132 134 REAL(wp) :: zcd, zmod ! local scalars … … 139 141 pvo = icb_utl_bilin_h( vo_e, pi, pj, 'V', .false. ) 140 142 psst = icb_utl_bilin_h( tt_e, pi, pj, 'T', .true. ) ! SST 143 psss = icb_utl_bilin_h( ss_e, pi, pj, 'T', .true. ) ! SSS 141 144 pcn = icb_utl_bilin_h( fr_e, pi, pj, 'T', .true. ) ! ice concentration 142 145 pff = icb_utl_bilin_h( ff_e, pi, pj, 'F', .false. ) ! Coriolis parameter
Note: See TracChangeset
for help on using the changeset viewer.