Changeset 3396 for branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM
- Timestamp:
- 2012-05-17T18:33:12+02:00 (12 years ago)
- Location:
- branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO
- Files:
-
- 26 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r2715 r3396 19 19 PUBLIC ice_alloc_2 ! Called in iceini_2.F90 20 20 21 INTEGER , PUBLIC :: numit !: ice iteration index22 REAL(wp), PUBLIC :: rdt_ice !: ice time step21 INTEGER , PUBLIC :: numit !: ice iteration index 22 REAL(wp), PUBLIC :: rdt_ice !: ice time step 23 23 24 24 ! !!* namicerun read in iceini * … … 98 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qstoif !: Energy stored in the brine pockets 99 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbif !: Heat flux at the ice base 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmsnif !: Variation of snow mass 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmicif !: Variation of ice mass 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_snw !: Variation of snow mass over 1 time step [Kg/m2] 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_snw !: Heat content associated with rdm_snw [J/m2] 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_ice !: Variation of ice mass over 1 time step [Kg/m2] 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_ice !: Heat content associated with rdm_ice [J/m2] 102 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qldif !: heat balance of the lead (or of the open ocean) 103 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qcmif !: Energy needed to freeze the ocean surface layer … … 153 155 154 156 ALLOCATE(phicif(jpi,jpj) , pfrld (jpi,jpj) , qstoif (jpi,jpj) , & 155 & fbif (jpi,jpj) , rdmsnif(jpi,jpj) , rdmicif(jpi,jpj) , & 157 & fbif (jpi,jpj) , rdm_snw(jpi,jpj) , rdq_snw(jpi,jpj) , & 158 & rdm_ice(jpi,jpj) , rdq_ice(jpi,jpj) , & 159 & qldif (jpi,jpj) , qcmif (jpi,jpj) , fdtcn (jpi,jpj) , & 156 160 & qldif (jpi,jpj) , qcmif (jpi,jpj) , fdtcn (jpi,jpj) , & 157 161 & qdtcn (jpi,jpj) , thcm (jpi,jpj) , STAT=ierr(4) ) -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r3294 r3396 9 9 !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 10 10 !! - ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step 11 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 11 !! 3.3.1 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 12 !! 3.5 ! 2012-11 ((G. Madec, Y. Aksenov, A. Coward) salt and heat fluxes associated with e-p 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_lim2 … … 88 89 !! - Update the fluxes provided to the ocean 89 90 !! 90 !! ** Outputs : - qsr : sea heat flux :solar91 !! - qns : sea heat flux : non solar92 !! - emp : freshwater budget: volumeflux93 !! - emps : freshwater budget: concentration/dillution91 !! ** Outputs : - qsr : sea heat flux : solar 92 !! - qns : sea heat flux : non solar (including heat content of the mass flux) 93 !! - emp : freshwater budget: mass flux 94 !! - emps : freshwater budget: salt flux due to Freezing/Melting 94 95 !! - utau : sea surface i-stress (ocean referential) 95 96 !! - vtau : sea surface j-stress (ocean referential) … … 107 108 INTEGER :: ifvt, i1mfr, idfr, iflt ! - - 108 109 INTEGER :: ial, iadv, ifral, ifrdv ! - - 109 REAL(wp) :: zqsr, zqns, zfm ! local scalars 110 REAL(wp) :: zinda, zfons, zemp ! - - 110 REAL(wp) :: zqsr, zqns, zfmm ! local scalars 111 REAL(wp) :: zinda, zfsalt, zemp ! - - 112 REAL(wp) :: zemp_snw, zqhc, zcd ! - - 113 REAL(wp) :: zswitch ! - - 111 114 REAL(wp), POINTER, DIMENSION(:,:) :: zqnsoce ! 2D workspace 112 115 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace … … 116 119 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 117 120 121 zswitch = 1 ! Default standard levitating sea-ice (salt exchanges only) 122 !!gm ice embedment 123 ! SELECT CASE( nn_ice_embd ) ! levitating/embedded sea-ice option (not yet activated) 124 ! CASE( 0 ) ; zswitch = 1 ! standard levitating sea-ice : salt exchange only 125 ! CASE( 1, 2 ) ; zswitch = 0 ! other levitating sea-ice or embedded sea-ice : salt and volume fluxes 126 ! END SELECT ! 127 !!gm end embedment 118 128 !------------------------------------------! 119 129 ! heat flux at the ocean surface ! … … 133 143 ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 134 144 135 !!$ zinda = 1.0 - AINT( pfrld(ji,jj) ) ! = 0. if pure ocean else 1. (at previous time)136 !!$ 137 !!$ i1mfr = 1.0 - AINT( frld(ji,jj) ) ! = 0. if pure ocean else 1. (at current time)138 !!$ 139 !!$ IF( phicif(ji,jj) <= 0. ) THEN ; ifvt = zinda ! = 1. if (snow and no ice at previous time) else 0. ???140 !!$ ELSE ; ifvt = 0. 145 !!$ attempt to explain the tricky flags set above.... 146 !!$ zinda = 1.0 - AINT( pfrld(ji,jj) ) ! = 0. if ice-free ocean else 1. (after ice adv, but before ice thermo) 147 !!$ i1mfr = 1.0 - AINT( frld(ji,jj) ) ! = 0. if ice-free ocean else 1. (after ice thermo) 148 !!$ 149 !!$ IF( phicif(ji,jj) <= 0. ) THEN ; ifvt = zinda ! = 1. if there was snow and ice before the ice thermo. which has been completely melted (possibly overmelted) 150 !!$ ELSE ; ifvt = 0. ! 141 151 !!$ ENDIF 142 152 !!$ 143 !!$ IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN ; idfr = 0. ! = 0. if lead fraction increases from previous to current153 !!$ IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN ; idfr = 0. ! = 0. if lead fraction increases due to ice thermodynamics 144 154 !!$ ELSE ; idfr = 1. 145 155 !!$ ENDIF 146 156 !!$ 147 !!$ iflt = zinda * (1 - i1mfr) * (1 - ifvt ) ! = 1. if ice (not only snow) at previous and pure ocean at current157 !!$ iflt = zinda * (1 - i1mfr) * (1 - ifvt ) ! = 1. if ice (not only snow) at previous time and ice-free ocean currently 148 158 !!$ 149 159 !!$ ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr 160 !!$ = i1mfr if ifvt = 1 i.e. 161 !!$ = idfr if ifvt = 0 150 162 !!$! snow no ice ice ice or nothing lead fraction increases 151 163 !!$! at previous now at previous 152 !!$! -> ice a era increases ??? -> ice aera decreases ???164 !!$! -> ice area increases ??? -> ice area decreases ??? 153 165 !!$ 154 166 !!$ iadv = ( 1 - i1mfr ) * zinda … … 174 186 #endif 175 187 ! computation the non solar heat flux at ocean surface 176 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads 177 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) & 178 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 179 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice 180 181 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! ??? 188 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads 189 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) & 190 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 191 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice 192 193 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! store residual heat flux (to put into the ocean at the next time-step) 194 zqhc = ( rdq_snw(ji,jj) + rdq_ice(ji,jj) ) * r1_rdtice ! heat flux due to snow & ice heat content exchange 182 195 ! 183 196 qsr (ji,jj) = zqsr ! solar heat flux 184 qns (ji,jj) = zqns - fdtcn(ji,jj) ! non solar heat flux 197 qns (ji,jj) = zqns - fdtcn(ji,jj) + zqhc ! non solar heat flux 198 ! !------------------------------------------! 199 ! ! mass flux at the ocean surface ! 200 ! !------------------------------------------! 201 ! 202 ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 203 #if defined key_coupled 204 ! ! coupled mode: 205 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 206 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice 207 #else 208 ! ! forced mode: 209 zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction 210 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean 211 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld) 212 #endif 213 ! 214 ! mass flux at the ocean/ice interface (sea ice fraction) 215 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean 216 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus Melting (F-M) 217 218 ! salt flux at the ice/ocean interface (sea ice fraction) [PSU*kg/m2/s] 219 zfsalt = - sice_0(ji,jj) * zfmm ! F-M salt exchange 220 zcd = soce_0(ji,jj) * zfmm ! concentration/dilution term due to F-M 221 ! 222 ! salt flux only : add concentration dilution term in salt flux and no F-M term in volume flux 223 ! salt and mass fluxes : non concentartion dilution term in salt flux and add F-M term in volume flux 224 emps(ji,jj) = zfsalt + zswitch * zcd ! salt flux (+ C/D if no ice/ocean mass exchange) 225 emp (ji,jj) = zemp + zemp_snw + ( 1.- zswitch) * zfmm ! mass flux (- F/M mass flux if no ice/ocean mass exchange) 226 ! 185 227 END DO 186 228 END DO … … 190 232 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 191 233 192 !------------------------------------------!193 ! mass flux at the ocean surface !194 !------------------------------------------!195 DO jj = 1, jpj196 DO ji = 1, jpi197 !198 #if defined key_coupled199 ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode)200 zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & !201 & + rdmsnif(ji,jj) * r1_rdtice ! freshwaterflux due to snow melting202 #else203 ! computing freshwater exchanges at the ice/ocean interface204 zemp = + emp(ji,jj) * frld(ji,jj) & ! e-p budget over open ocean fraction205 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precipitation reaches directly the ocean206 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! change in ice cover within the time step207 & + rdmsnif(ji,jj) * r1_rdtice ! freshwater flux due to snow melting208 #endif209 !210 ! computing salt exchanges at the ice/ocean interface211 zfons = ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice )212 !213 ! converting the salt flux from ice to a freshwater flux from ocean214 zfm = zfons / ( sss_m(ji,jj) + epsi16 )215 !216 emps(ji,jj) = zemp + zfm ! surface ocean concentration/dilution effect (use on SSS evolution)217 emp (ji,jj) = zemp ! surface ocean volume flux (use on sea-surface height evolution)218 !219 END DO220 END DO221 222 234 IF( lk_diaar5 ) THEN ! AR5 diagnostics 223 CALL iom_put( 'isnwmlt_cea' , rdm snif(:,:) * r1_rdtice )224 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm icif(:,:) * r1_rdtice )225 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm icif(:,:) * r1_rdtice )235 CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice ) 236 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 237 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 226 238 ENDIF 227 239 -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r3294 r3396 89 89 REAL(wp) :: za , zh, zthsnice ! 90 90 REAL(wp) :: zfric_u ! friction velocity 91 REAL(wp) :: zfnsol ! total non solar heat92 REAL(wp) :: zfontn ! heat flux from snow thickness93 91 REAL(wp) :: zfntlat, zpareff ! test. the val. of lead heat budget 94 92 … … 129 127 zdvolif(:,:) = 0.e0 ! total variation of ice volume 130 128 zdvonif(:,:) = 0.e0 ! transformation of snow to sea-ice volume 131 ! zdvonif(:,:) = 0.e0 ! lateral variation of ice volume132 129 zlicegr(:,:) = 0.e0 ! lateral variation of ice volume 133 130 zdvomif(:,:) = 0.e0 ! variation of ice volume at bottom due to melting only … … 137 134 ffltbif(:,:) = 0.e0 ! linked with fstric 138 135 qfvbq (:,:) = 0.e0 ! linked with fstric 139 rdmsnif(:,:) = 0.e0 ! variation of snow mass per unit area 140 rdmicif(:,:) = 0.e0 ! variation of ice mass per unit area 136 rdm_snw(:,:) = 0.e0 ! variation of snow mass over 1 time step 137 rdq_snw(:,:) = 0.e0 ! heat content associated with rdm_snw 138 rdm_ice(:,:) = 0.e0 ! variation of ice mass over 1 time step 139 rdq_ice(:,:) = 0.e0 ! heat content associated with rdm_ice 141 140 zmsk (:,:,:) = 0.e0 142 141 … … 199 198 !-------------------------------------------------------------------------- 200 199 201 sst_m(:,:) = sst_m(:,:) + rt0 202 203 !CDIR NOVERRCHK 204 DO jj = 1, jpj 205 !CDIR NOVERRCHK 200 !CDIR NOVERRCHK 201 DO jj = 1, jpj 202 !CDIR NOVERRCHK 206 203 DO ji = 1, jpi 207 204 zthsnice = hsnif(ji,jj) + hicif(ji,jj) … … 217 214 ! temperature and turbulent mixing (McPhee, 1992) 218 215 zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) ! friction velocity 219 fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_m(ji,jj) - tfu(ji,jj) )216 fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_m(ji,jj) + rt0 - tfu(ji,jj) ) 220 217 qdtcn(ji,jj) = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice 221 218 222 219 ! partial computation of the lead energy budget (qldif) 223 220 #if defined key_coupled 224 qldif(ji,jj) = tms(ji,jj) * rdt_ice &221 qldif(ji,jj) = tms(ji,jj) * rdt_ice & 225 222 & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) & 226 223 & + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp ) & 227 224 & + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) ) ) 228 225 #else 229 zfontn = ( sprecip(ji,jj) / rhosn ) * xlsn ! energy for melting solid precipitation 230 zfnsol = qns(ji,jj) ! total non solar flux over the ocean 231 qldif(ji,jj) = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & 232 & + zfnsol + fdtcn(ji,jj) - zfontn & 233 & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) & 234 & * frld(ji,jj) * rdt_ice 235 !!$ qldif(ji,jj) = tms(ji,jj) * rdt_ice * frld(ji,jj) 236 !!$ & * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & 237 !!$ & + qns(ji,jj) + fdtcn(ji,jj) - zfontn & 238 !!$ & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) & 226 qldif(ji,jj) = tms(ji,jj) * rdt_ice * frld(ji,jj) & 227 & * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & 228 & + qns(ji,jj) + fdtcn(ji,jj) & 229 & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) 239 230 #endif 240 231 ! parlat : percentage of energy used for lateral ablation (0.0) … … 246 237 247 238 ! energy needed to bring ocean surface layer until its freezing 248 qcmif (ji,jj) = rau0 * rcp * fse3t_m(ji,jj,1) & 249 & * ( tfu(ji,jj) - sst_m(ji,jj) ) * ( 1 - zinda ) 239 qcmif (ji,jj) = rau0 * rcp * fse3t_m(ji,jj,1) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda ) 250 240 251 241 ! calculate oceanic heat flux. … … 257 247 END DO 258 248 259 sst_m(:,:) = sst_m(:,:) - rt0260 261 249 ! Select icy points and fulfill arrays for the vectorial grid. 262 250 !---------------------------------------------------------------------- … … 312 300 CALL tab_2d_1d_2( nbpb, qldif_1d (1:nbpb) , qldif , jpi, jpj, npb(1:nbpb) ) 313 301 CALL tab_2d_1d_2( nbpb, qstbif_1d (1:nbpb) , qstoif , jpi, jpj, npb(1:nbpb) ) 314 CALL tab_2d_1d_2( nbpb, rdmicif_1d (1:nbpb) , rdmicif , jpi, jpj, npb(1:nbpb) ) 302 CALL tab_2d_1d_2( nbpb, rdm_ice_1d (1:nbpb) , rdm_ice , jpi, jpj, npb(1:nbpb) ) 303 CALL tab_2d_1d_2( nbpb, rdq_ice_1d (1:nbpb) , rdq_ice , jpi, jpj, npb(1:nbpb) ) 315 304 CALL tab_2d_1d_2( nbpb, dmgwi_1d (1:nbpb) , dmgwi , jpi, jpj, npb(1:nbpb) ) 305 CALL tab_2d_1d_2( nbpb, rdm_snw_1d (1:nbpb) , rdm_snw , jpi, jpj, npb(1:nbpb) ) 306 CALL tab_2d_1d_2( nbpb, rdq_snw_1d (1:nbpb) , rdq_snw , jpi, jpj, npb(1:nbpb) ) 316 307 CALL tab_2d_1d_2( nbpb, qlbbq_1d (1:nbpb) , zqlbsbq , jpi, jpj, npb(1:nbpb) ) 317 308 ! … … 332 323 CALL tab_1d_2d_2( nbpb, qfvbq , npb, qfvbq_1d (1:nbpb) , jpi, jpj ) 333 324 CALL tab_1d_2d_2( nbpb, qstoif , npb, qstbif_1d (1:nbpb) , jpi, jpj ) 334 CALL tab_1d_2d_2( nbpb, rdmicif , npb, rdmicif_1d(1:nbpb) , jpi, jpj ) 325 CALL tab_1d_2d_2( nbpb, rdm_ice , npb, rdm_ice_1d(1:nbpb) , jpi, jpj ) 326 CALL tab_1d_2d_2( nbpb, rdq_ice , npb, rdq_ice_1d(1:nbpb) , jpi, jpj ) 335 327 CALL tab_1d_2d_2( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) 336 CALL tab_1d_2d_2( nbpb, rdmsnif , npb, rdmsnif_1d(1:nbpb) , jpi, jpj ) 328 CALL tab_1d_2d_2( nbpb, rdm_snw , npb, rdm_snw_1d(1:nbpb) , jpi, jpj ) 329 CALL tab_1d_2d_2( nbpb, rdq_snw , npb, rdq_snw_1d(1:nbpb) , jpi, jpj ) 337 330 CALL tab_1d_2d_2( nbpb, zdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 338 331 CALL tab_1d_2d_2( nbpb, zdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) … … 393 386 IF( nbpac > 0 ) THEN 394 387 ! 395 zlicegr(:,:) = rdm icif(:,:) ! to output the lateral sea-ice growth388 zlicegr(:,:) = rdm_ice(:,:) ! to output the lateral sea-ice growth 396 389 !...Put the variable in a 1-D array for lateral accretion 397 390 CALL tab_2d_1d_2( nbpac, frld_1d (1:nbpac) , frld , jpi, jpj, npac(1:nbpac) ) … … 404 397 CALL tab_2d_1d_2( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) ) 405 398 CALL tab_2d_1d_2( nbpac, qstbif_1d (1:nbpac) , qstoif , jpi, jpj, npac(1:nbpac) ) 406 CALL tab_2d_1d_2( nbpac, rdmicif_1d(1:nbpac) , rdmicif , jpi, jpj, npac(1:nbpac) ) 399 CALL tab_2d_1d_2( nbpac, rdm_ice_1d(1:nbpac) , rdm_ice , jpi, jpj, npac(1:nbpac) ) 400 CALL tab_2d_1d_2( nbpac, rdq_ice_1d(1:nbpac) , rdq_ice , jpi, jpj, npac(1:nbpac) ) 407 401 CALL tab_2d_1d_2( nbpac, dvlbq_1d (1:nbpac) , zdvolif , jpi, jpj, npac(1:nbpac) ) 408 402 CALL tab_2d_1d_2( nbpac, tfu_1d (1:nbpac) , tfu , jpi, jpj, npac(1:nbpac) ) … … 418 412 CALL tab_1d_2d_2( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d (1:nbpac , 3 ), jpi, jpj ) 419 413 CALL tab_1d_2d_2( nbpac, qstoif , npac(1:nbpac), qstbif_1d (1:nbpac) , jpi, jpj ) 420 CALL tab_1d_2d_2( nbpac, rdmicif , npac(1:nbpac), rdmicif_1d(1:nbpac) , jpi, jpj ) 414 CALL tab_1d_2d_2( nbpac, rdm_ice , npac(1:nbpac), rdm_ice_1d(1:nbpac) , jpi, jpj ) 415 CALL tab_1d_2d_2( nbpac, rdq_ice , npac(1:nbpac), rdq_ice_1d(1:nbpac) , jpi, jpj ) 421 416 CALL tab_1d_2d_2( nbpac, zdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj ) 422 417 ! … … 449 444 CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] 450 445 IF( lk_diaar5 ) THEN 451 CALL iom_put( 'snowmel_cea' , rdm snif(:,:) * zztmp ) ! Snow melt [kg/m2/s]446 CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp ) ! Snow melt [kg/m2/s] 452 447 zztmp = rhoic / rdt_ice 453 448 CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation [kg/m2/s] 454 449 CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top [kg/m2/s] 455 450 CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s] 456 zlicegr(:,:) = MAX( 0.e0, rdm icif(:,:)-zlicegr(:,:) )457 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Later eal sea ice growth[kg/m2/s]451 zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) ) 452 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Lateral sea ice growth [kg/m2/s] 458 453 ENDIF 459 454 ! -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
r3294 r3396 145 145 frld_1d (ji) = MAX( zfrlnew , zfrlmin(ji) ) 146 146 !--computation of the remaining part of ice thickness which has been already used 147 zdhicbot(ji) = ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) ) &148 147 zdhicbot(ji) = ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) ) & 148 & - ( ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) ) * ( zqbgow(ji) / xlic ) 149 149 END DO 150 150 … … 196 196 & ) / zah 197 197 198 tbif_1d(ji,3) = ( iiceform * ( zhnews2 - zdh3 )* zta1 &198 tbif_1d(ji,3) = ( iiceform * ( zhnews2 - zdh3 ) * zta1 & 199 199 & + ( iiceform * zdh3 + ( 1 - iiceform ) * zdh1 ) * zta2 & 200 200 & + ( iiceform * ( zhnews2 - zdh5 ) + ( 1 - iiceform ) * ( zhnews2 - zdh1 ) ) * zta3 & … … 217 217 DO ji = kideb , kiut 218 218 dvlbq_1d (ji) = ( 1. - frld_1d(ji) ) * h_ice_1d(ji) - ( 1. - zfrl_old(ji) ) * zhice_old(ji) 219 rdmicif_1d(ji) = rdmicif_1d(ji) + rhoic * dvlbq_1d(ji) 219 rdm_ice_1d(ji) = rdm_ice_1d(ji) + rhoic * dvlbq_1d(ji) 220 rdq_ice_1d(ji) = rdq_ice_1d(ji) + rcpic * dvlbq_1d(ji) * ( tfu_1d(ji) - rt0 ) ! heat content relative to rt0 220 221 END DO 221 222 -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r3294 r3396 86 86 REAL(wp), POINTER, DIMENSION(:) :: zrcpdt ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 87 87 REAL(wp), POINTER, DIMENSION(:) :: zts_old ! previous surface temperature 88 REAL(wp), POINTER, DIMENSION(:) :: zidsn , z1midsn , zidsnic ! tempor y variables88 REAL(wp), POINTER, DIMENSION(:) :: zidsn , z1midsn , zidsnic ! temporary variables 89 89 REAL(wp), POINTER, DIMENSION(:) :: zfnet ! net heat flux at the top surface( incl. conductive heat flux) 90 90 REAL(wp), POINTER, DIMENSION(:) :: zsprecip ! snow accumulation … … 98 98 REAL(wp), POINTER, DIMENSION(:) :: zep ! internal temperature of the 2nd layer of the snow/ice system 99 99 REAL(wp), DIMENSION(3) :: & 100 zplediag & ! principle diagonal, subdiag. and supdiag. of the100 zplediag & ! principle diagonal, subdiag. and supdiag. of the 101 101 , zsubdiag & ! tri-diagonal matrix coming from the computation 102 102 , zsupdiag & ! of the temperatures inside the snow-ice system 103 103 , zsmbr ! second member 104 REAL(wp) :: & 105 zhsu & ! thickness of surface layer 106 , zhe & ! effective thickness for compu. of equ. thermal conductivity 107 , zheshth & ! = zhe / thth 108 , zghe & ! correction factor of the thermal conductivity 109 , zumsb & ! parameter for numerical method to solve heat-diffusion eq. 110 , zkhsn & ! conductivity at the snow layer 111 , zkhic & ! conductivity at the ice layers 112 , zkint & ! equivalent conductivity at the snow-ice interface 113 , zkhsnint & ! = zkint*dt / (hsn*rhosn*cpsn) 114 , zkhicint & ! = 2*zkint*dt / (hic*rhoic*cpic) 115 , zpiv1 , zpiv2 & ! tempory scalars used to solve the tri-diagonal system 116 , zb2 , zd2 , zb3 , zd3 & 104 REAL(wp) :: & 105 zhsu & ! thickness of surface layer 106 , zhe & ! effective thickness for compu. of equ. thermal conductivity 107 , zheshth & ! = zhe / thth 108 , zghe & ! correction factor of the thermal conductivity 109 , zumsb & ! parameter for numerical method to solve heat-diffusion eq. 110 , zkhsn & ! conductivity at the snow layer 111 , zkhic & ! conductivity at the ice layers 112 , zkint & ! equivalent conductivity at the snow-ice interface 113 , zkhsnint & ! = zkint*dt / (hsn*rhosn*cpsn) 114 , zkhicint & ! = 2*zkint*dt / (hic*rhoic*cpic) 115 , zpiv1, zpiv2 & ! temporary scalars used to solve the tri-diagonal system 116 , zb2, zd2 & ! temporary scalars used to solve the tri-diagonal system 117 , zb3, zd3 & ! temporary scalars used to solve the tri-diagonal system 117 118 , ztint ! equivalent temperature at the snow-ice interface 118 REAL(wp) :: &119 zexp &! exponential function of the ice thickness120 , zfsab & 121 , zfts & 122 , zdfts & 123 , zdts & 124 , zqsnw_mlt & 125 , zdhsmlt & 126 , zhsn & 127 , zqsn_mlt_rem & 128 , zqice_top_mlt & 129 , zdhssub &! change in snow thick. due to sublimation or evaporation130 , zdhisub &! change in ice thick. due to sublimation or evaporation131 , zdhsn &! snow ice thickness increment132 , zdtsn &! snow internal temp. increment133 , zdtic &! ice internal temp. increment119 REAL(wp) :: & 120 zexp & ! exponential function of the ice thickness 121 , zfsab & ! part of solar radiation stored in brine pockets 122 , zfts & ! value of energy balance function when the temp. equal surf. temp. 123 , zdfts & ! value of derivative of ztfs when the temp. equal surf. temp. 124 , zdts & ! surface temperature increment 125 , zqsnw_mlt & ! energy needed to melt snow 126 , zdhsmlt & ! change in snow thickness due to melt 127 , zhsn & ! snow thickness (previous+accumulation-melt) 128 , zqsn_mlt_rem & ! remaining heat coming from snow melting 129 , zqice_top_mlt &! energy used to melt ice at top surface 130 , zdhssub & ! change in snow thick. due to sublimation or evaporation 131 , zdhisub & ! change in ice thick. due to sublimation or evaporation 132 , zdhsn & ! snow ice thickness increment 133 , zdtsn & ! snow internal temp. increment 134 , zdtic & ! ice internal temp. increment 134 135 , zqnes ! conductive energy due to ice melting in the first ice layer 135 REAL(wp) :: & 136 ztbot & ! temperature at the bottom surface 137 , zfcbot & ! conductive heat flux at bottom surface 138 , zqice_bot & ! energy used for bottom melting/growing 139 , zqice_bot_mlt & ! energy used for bottom melting 140 , zqstbif_bot & ! part of energy stored in brine pockets used for bottom melting 141 , zqstbif_old & ! tempory var. for zqstbif_bot 142 , zdhicmlt & ! change in ice thickness due to bottom melting 143 , zdhicm & ! change in ice thickness var. 144 , zdhsnm & ! change in snow thickness var. 145 , zhsnfi & ! snow thickness var. 146 , zc1, zpc1, zc2, zpc2, zp1, zp2 & ! tempory variables 147 , ztb2, ztb3 148 REAL(wp) :: & 149 zdrmh & ! change in snow/ice thick. after snow-ice formation 150 , zhicnew & ! new ice thickness 151 , zhsnnew & ! new snow thickness 152 , zquot , ztneq & ! tempory temp. variables 153 , zqice, zqicetot & ! total heat inside the snow/ice system 154 , zdfrl & ! change in ice concentration 155 , zdvsnvol & ! change in snow volume 156 , zdrfrl1, zdrfrl2 & ! tempory scalars 157 , zihsn, zidhb, zihic, zihe, zihq, ziexp, ziqf, zihnf, zibmlt, ziqr, zihgnew, zind 136 REAL(wp) :: & 137 ztbot & ! temperature at the bottom surface 138 , zfcbot & ! conductive heat flux at bottom surface 139 , zqice_bot & ! energy used for bottom melting/growing 140 , zqice_bot_mlt &! energy used for bottom melting 141 , zqstbif_bot & ! part of energy stored in brine pockets used for bottom melting 142 , zqstbif_old & ! temporary var. for zqstbif_bot 143 , zdhicmlt & ! change in ice thickness due to bottom melting 144 , zdhicm & ! change in ice thickness var. 145 , zdhsnm & ! change in snow thickness var. 146 , zhsnfi & ! snow thickness var. 147 , zc1, zpc1 & ! temporary variables 148 , zc2, zpc2 & ! temporary variables 149 , zp1, zp2 & ! temporary variables 150 , ztb2, ztb3 ! temporary variables 151 REAL(wp) :: & 152 zdrmh & ! change in snow/ice thick. after snow-ice formation 153 , zhicnew & ! new ice thickness 154 , zhsnnew & ! new snow thickness 155 , zquot & 156 , ztneq & ! temporary temp. variables 157 , zqice & 158 , zqicetot & ! total heat inside the snow/ice system 159 , zdfrl & ! change in ice concentration 160 , zdvsnvol & ! change in snow volume 161 , zdrfrl1, zdrfrl2, zihsn, zidhb, zihic & ! temporary scalars 162 , zihe, zihq, ziexp, ziqf, zihnf & ! temporary scalars 163 , zibmlt, ziqr, zihgnew, zind, ztmp ! temporary scalars 158 164 !!---------------------------------------------------------------------- 159 165 CALL wrk_alloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax ) … … 169 175 170 176 DO ji = kideb , kiut 177 ! do nothing if the snow (ice) thickness falls below its minimum thickness 171 178 zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) ) 172 179 zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) ) 173 !--computation of energy due to surface melting 174 zqcmlts(ji) = ( MAX ( zzero , & 175 & rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 176 !--computation of energy due to bottom melting 177 zqcmltb(ji) = ( MAX( zzero , & 178 & rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 179 & + MAX( zzero , & 180 & rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 181 & ) * ( 1.0 - zihic ) 182 !--limitation of snow/ice system internal temperature 180 !--energy required to bring snow to its melting point (rt0_snow) 181 zqcmlts(ji) = ( MAX ( zzero , rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 182 !--energy required to bring ice to its melting point (rt0_ice) 183 zqcmltb(ji) = ( MAX( zzero , rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 184 & + MAX( zzero , rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 185 & ) * ( 1.0 - zihic ) 186 !--limitation of snow/ice system internal temperature 183 187 tbif_1d(ji,1) = MIN( rt0_snow, tbif_1d(ji,1) ) 184 188 tbif_1d(ji,2) = MIN( rt0_ice , tbif_1d(ji,2) ) … … 480 484 dvsbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) ) 481 485 dvsbq_1d(ji) = MIN( zzero , dvsbq_1d(ji) ) 482 rdmsnif_1d(ji) = rhosn * dvsbq_1d(ji) 486 ztmp = rhosn * dvsbq_1d(ji) 487 rdm_snw_1d(ji) = ztmp 488 !--heat content of the water provided to the ocean (referenced to rt0) 489 rdq_snw_1d(ji) = cpic * ztmp * ( rt0_snow - rt0 ) 483 490 !-- If the snow is completely melted the remaining heat is used to melt ice 484 491 zqsn_mlt_rem = MAX( zzero , -zhsn ) * xlsn … … 623 630 !---updating new ice thickness and computing the newly formed ice mass 624 631 zhicnew = zihgnew * zhicnew 625 rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic 632 ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic 633 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 634 !---heat content of the water provided to the ocean (referenced to rt0) 635 ! use of rt0_ice is OK for melting ice; in the case of freezing, tfu_1d should be used. 636 ! This is done in 9.5 section (see below) 637 rdq_ice_1d(ji) = cpic * ztmp * ( rt0_ice - rt0 ) 626 638 !---updating new snow thickness and computing the newly formed snow mass 627 639 zhsnfi = zhsn + zdhsnm 628 640 h_snow_1d(ji) = MAX( zzero , zhsnfi ) 629 rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn 641 ztmp = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn 642 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 643 !---updating the heat content of the water provided to the ocean (referenced to rt0) 644 rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 ) 630 645 !--remaining energy in case of total ablation 631 646 zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) ) … … 659 674 tbif_1d(ji,3) = zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji) 660 675 h_ice_1d(ji) = zhicnew 676 ! update the ice heat content given to the ocean in freezing case 677 ! (part due to difference between rt0_ice and tfu_1d) 678 ztmp = ( 1. - zidhb ) * rhoic * dvbbq_1d(ji) 679 rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0_ice ) 661 680 END DO 662 681 … … 700 719 dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn 701 720 !--- volume change of ice and snow (used for ocean-ice freshwater flux computation) 702 rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d (ji) ) * rhoic 703 rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhsnnew - h_snow_1d(ji) ) * rhosn 721 ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d (ji) ) * rhoic 722 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 723 rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0 ) 724 !!gm BUG ?? snow ==> only needed for nn_ice_embd == 0 (standard levitating sea-ice) 725 ztmp = ( 1.0 - frld_1d(ji) ) * ( zhsnnew - h_snow_1d(ji) ) * rhosn 726 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 727 rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 ) 704 728 705 729 !--- Actualize new snow and ice thickness. … … 748 772 !--variation of ice volume and ice mass 749 773 dvlbq_1d(ji) = zihic * ( zfrl_old(ji) - frld_1d(ji) ) * h_ice_1d(ji) 750 rdmicif_1d(ji) = rdmicif_1d(ji) + dvlbq_1d(ji) * rhoic 774 ztmp = dvlbq_1d(ji) * rhoic 775 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 776 !!gm 777 !!gm This should be split in two parts: 778 !!gm 1- heat required to bring sea-ice to tfu : this part should be added to the heat flux taken from the ocean 779 !!gm cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0_ice ) 780 !!gm 2- heat content of lateral ablation referenced to rt0 : this part only put in rdq_ice_1d 781 !!gm cpic * ztmp * ( rt0_ice - rt0 ) 782 !!gm Currently we put all the heat in rdq_ice_1d 783 rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0 ) 784 ! 751 785 !--variation of snow volume and snow mass 752 zdvsnvol = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji) 753 rdmsnif_1d(ji) = rdmsnif_1d(ji) + zdvsnvol * rhosn 786 zdvsnvol = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji) 787 ztmp = zdvsnvol * rhosn 788 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 789 !!gm 790 !!gm This should be split in two parts: 791 !!gm 1- heat required to bring snow to tfu : this part should be added to the heat flux taken from the ocean 792 !!gm cpic * ztmp * ( tbif_1d(ji,1) - rt0_snow ) 793 !!gm 2- heat content of lateral ablation referenced to rt0 : this part only put in rdq_snw_1d 794 !!gm cpic * ztmp * ( rt0_snow - rt0 ) 795 !!gm Currently we put all the heat in rdq_snw_1d 796 rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( tbif_1d(ji,1) - rt0 ) 797 754 798 h_snow_1d(ji) = ziqf * h_snow_1d(ji) 755 799 -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
r2715 r3396 68 68 qstbif_1d , & !: " " qstoif 69 69 fbif_1d , & !: " " fbif 70 rdmicif_1d , & !: " " rdmicif 71 rdmsnif_1d , & !: " " rdmsnif 70 rdm_ice_1d , & !: " " rdm_ice 71 rdq_ice_1d , & !: " " rdq_ice 72 rdm_snw_1d , & !: " " rdm_snw 73 rdq_snw_1d , & !: " " rdq_snw 72 74 qlbbq_1d , & !: " " qlbsbq 73 75 dmgwi_1d , & !: " " dmgwi … … 108 110 & qstbif_1d(jpij), fbif_1d(jpij), Stat=ierr(2)) 109 111 ! 110 ALLOCATE( rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij), & 112 ALLOCATE( rdm_ice_1d(jpij), rdq_ice_1d(jpij) , & 113 & rdm_snw_1d(jpij), rdq_snw_1d(jpij), qlbbq_1d(jpij) , & 111 114 & dmgwi_1d(jpij) , dvsbq_1d(jpij) , rdvomif_1d(jpij), & 112 115 & dvbbq_1d(jpij) , dvlbq_1d(jpij) , dvnbq_1d(jpij) , & -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r2777 r3396 264 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: phicif !: Old ice thickness 265 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbif !: Heat flux at the ice base 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmsnif !: Variation of snow mass 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmicif !: Variation of ice mass 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_snw !: Variation of snow mass over 1 time step [Kg/m2] 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_snw !: Heat content associated with rdm_snw [J/m2] 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_ice !: Variation of ice mass over 1 time step [Kg/m2] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_ice !: Heat content associated with rdm_ice [J/m2] 268 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qldif !: heat balance of the lead (or of the open ocean) 269 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qcmif !: Energy needed to bring the ocean to freezing … … 448 450 & sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , hicifp (jpi,jpj) , & 449 451 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , fbif (jpi,jpj) , & 450 & rdmsnif (jpi,jpj) , rdmicif(jpi,jpj) , qldif (jpi,jpj) , qcmif (jpi,jpj) , & 452 & rdm_snw (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice (jpi,jpj) , rdq_ice (jpi,jpj) , & 453 & qldif (jpi,jpj) , qcmif (jpi,jpj) , & 451 454 & fdtcn (jpi,jpj) , qdtcn (jpi,jpj) , fstric (jpi,jpj) , fscmbq (jpi,jpj) , & 452 455 & ffltbif (jpi,jpj) , fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) , & -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r3294 r3396 83 83 z_frc_trd_s = SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 84 84 ! Add penetrative solar radiation 85 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r o0cpr* SUM( qsr (:,:) * surf(:,:) )85 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qsr (:,:) * surf(:,:) ) 86 86 ! Add geothermal heat flux 87 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + r o0cpr* SUM( qgh_trd0(:,:) * surf(:,:) )87 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qgh_trd0(:,:) * surf(:,:) ) 88 88 IF( lk_mpp ) THEN 89 89 CALL mpp_sum( z_frc_trd_v ) -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r3294 r3396 27 27 REAL(wp), PUBLIC :: rsmall = 0.5 * EPSILON( 1.e0 ) !: smallest real computer value 28 28 29 REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day (s) 30 REAL(wp), PUBLIC :: rsiyea !: sideral year (s) 31 REAL(wp), PUBLIC :: rsiday !: sideral day (s) 32 REAL(wp), PUBLIC :: raamo = 12._wp !: number of months in one year 33 REAL(wp), PUBLIC :: rjjhh = 24._wp !: number of hours in one day 34 REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour 35 REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute 36 !! REAL(wp), PUBLIC :: omega = 7.292115083046061e-5_wp , & !: change the last digit! 37 REAL(wp), PUBLIC :: omega !: earth rotation parameter 38 REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius (meter) 39 REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity (m/s2) 40 41 REAL(wp), PUBLIC :: rtt = 273.16_wp !: triple point of temperature (Kelvin) 42 REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of water (Kelvin) 29 REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day [s] 30 REAL(wp), PUBLIC :: rsiyea !: sideral year [s] 31 REAL(wp), PUBLIC :: rsiday !: sideral day [s] 32 REAL(wp), PUBLIC :: raamo = 12._wp !: number of months in one year 33 REAL(wp), PUBLIC :: rjjhh = 24._wp !: number of hours in one day 34 REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour 35 REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute 36 REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1] 37 REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m] 38 REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2] 39 40 REAL(wp), PUBLIC :: rtt = 273.16_wp !: triple point of temperature [Kelvin] 41 REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin] 43 42 #if defined key_lim3 44 REAL(wp), PUBLIC :: rt0_snow = 273.16_wp !: melting point of snow (Kelvin) 45 REAL(wp), PUBLIC :: rt0_ice = 273.16_wp !: melting point of ice (Kelvin) 46 #else 47 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow (Kelvin) 48 REAL(wp), PUBLIC :: rt0_ice = 273.05_wp !: melting point of ice (Kelvin) 49 #endif 50 43 REAL(wp), PUBLIC :: rt0_snow = 273.16_wp !: melting point of snow [Kelvin] 44 REAL(wp), PUBLIC :: rt0_ice = 273.16_wp !: melting point of ice [Kelvin] 45 #else 46 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin] 47 REAL(wp), PUBLIC :: rt0_ice = 273.05_wp !: melting point of ice [Kelvin] 48 #endif 51 49 #if defined key_cice 52 REAL(wp), PUBLIC :: rau0 = 1026._wp !: reference volumic mass (density) (kg/m3) 53 #else 54 REAL(wp), PUBLIC :: rau0 = 1035._wp !: reference volumic mass (density) (kg/m3) 55 #endif 56 REAL(wp), PUBLIC :: rau0r !: reference specific volume (m3/kg) 57 REAL(wp), PUBLIC :: rcp = 4.e+3_wp !: ocean specific heat 58 REAL(wp), PUBLIC :: ro0cpr !: = 1. / ( rau0 * rcp ) 50 REAL(wp), PUBLIC :: rau0 = 1026._wp !: volumic mass of reference [kg/m3] 51 #else 52 REAL(wp), PUBLIC :: rau0 = 1035._wp !: volumic mass of reference [kg/m3] 53 #endif 54 REAL(wp), PUBLIC :: r1_rau0 !: = 1. / rau0 [m3/kg] 55 REAL(wp), PUBLIC :: rauw = 1000._wp !: volumic mass of pure water [m3/kg] 56 REAL(wp), PUBLIC :: rcp = 4.e3_wp !: ocean specific heat [J/Kelvin] 57 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] 58 REAL(wp), PUBLIC :: r1_rau0_rcp !: = 1. / ( rau0 * rcp ) 59 60 REAL(wp), PUBLIC :: rhosn = 330._wp !: volumic mass of snow [kg/m3] 61 REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice 62 REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice [psu] 63 REAL(wp), PUBLIC :: soce = 34.7_wp !: salinity of sea [psu] 64 REAL(wp), PUBLIC :: cevap = 2.5e+6_wp !: latent heat of evaporation (water) 65 REAL(wp), PUBLIC :: srgamma = 0.9_wp !: correction factor for solar radiation (Oberhuber, 1974) 66 REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant 67 REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 59 68 60 69 #if defined key_lim3 || defined key_cice 61 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 62 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice 63 REAL(wp), PUBLIC :: cpic = 2067.0 !: specific heat of sea ice 64 REAL(wp), PUBLIC :: lsub = 2.834e+6 !: pure ice latent heat of sublimation (J.kg-1) 65 REAL(wp), PUBLIC :: lfus = 0.334e+6 !: latent heat of fusion of fresh ice (J.kg-1) 66 REAL(wp), PUBLIC :: rhoic = 917._wp !: volumic mass of sea ice (kg/m3) 67 REAL(wp), PUBLIC :: tmut = 0.054 !: decrease of seawater meltpoint with salinity 68 #else 69 REAL(wp), PUBLIC :: rcdsn = 0.22_wp !: conductivity of the snow 70 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: conductivity of the ice 71 REAL(wp), PUBLIC :: rcpsn = 6.9069e+5_wp !: density times specific heat for snow 72 REAL(wp), PUBLIC :: rcpic = 1.8837e+6_wp !: volumetric latent heat fusion of sea ice 73 REAL(wp), PUBLIC :: lfus = 0.3337e+6 !: latent heat of fusion of fresh ice (J.kg-1) 74 REAL(wp), PUBLIC :: xlsn = 110.121e+6_wp !: volumetric latent heat fusion of snow 75 REAL(wp), PUBLIC :: xlic = 300.33e+6_wp !: volumetric latent heat fusion of ice 76 REAL(wp), PUBLIC :: xsn = 2.8e+6 !: latent heat of sublimation of snow 77 REAL(wp), PUBLIC :: rhoic = 900._wp !: volumic mass of sea ice (kg/m3) 78 #endif 79 REAL(wp), PUBLIC :: rhosn = 330._wp !: volumic mass of snow (kg/m3) 80 REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice 81 REAL(wp), PUBLIC :: sice = 6.0_wp !: reference salinity of ice (psu) 82 REAL(wp), PUBLIC :: soce = 34.7_wp !: reference salinity of sea (psu) 83 REAL(wp), PUBLIC :: cevap = 2.5e+6_wp !: latent heat of evaporation (water) 84 REAL(wp), PUBLIC :: srgamma = 0.9_wp !: correction factor for solar radiation (Oberhuber, 1974) 85 REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant 86 REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 70 REAL(wp), PUBLIC :: rhoic = 917._wp !: volumic mass of sea ice [kg/m3] 71 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice 72 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 73 REAL(wp), PUBLIC :: cpic = 2067.0_wp !: specific heat for ice 74 REAL(wp), PUBLIC :: lsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg] 75 REAL(wp), PUBLIC :: lfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg] 76 REAL(wp), PUBLIC :: tmut = 0.054_wp !: decrease of seawater meltpoint with salinity 77 REAL(wp), PUBLIC :: xlsn !: = lfus*rhosn (volumetric latent heat fusion of snow) [J/m3] 78 #else 79 REAL(wp), PUBLIC :: rhoic = 900._wp !: volumic mass of sea ice [kg/m3] 80 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: conductivity of the ice [W/m/K] 81 REAL(wp), PUBLIC :: rcpic = 1.8837e+6_wp !: volumetric specific heat for ice [J/m3/K] 82 REAL(wp), PUBLIC :: cpic !: = rcpic / rhoic (specific heat for ice) [J/Kg/K] 83 REAL(wp), PUBLIC :: rcdsn = 0.22_wp !: conductivity of the snow [W/m/K] 84 REAL(wp), PUBLIC :: rcpsn = 6.9069e+5_wp !: volumetric specific heat for snow [J/m3/K] 85 REAL(wp), PUBLIC :: xlsn = 110.121e+6_wp !: volumetric latent heat fusion of snow [J/m3] 86 REAL(wp), PUBLIC :: lfus !: = xlsn / rhosn (latent heat of fusion of fresh ice) [J/Kg] 87 REAL(wp), PUBLIC :: xlic = 300.33e+6_wp !: volumetric latent heat fusion of ice [J/m3] 88 REAL(wp), PUBLIC :: xsn = 2.8e+6_wp !: volumetric latent heat of sublimation of snow [J/m3] 89 #endif 87 90 !!---------------------------------------------------------------------- 88 91 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 102 105 !!---------------------------------------------------------------------- 103 106 104 ! ! Define additional parameters 105 rsiyea = 365.25 * rday * 2. * rpi / 6.283076 106 rsiday = rday / ( 1. + rday / rsiyea ) 107 #if defined key_cice 108 omega = 7.292116e-05 109 #else 110 omega = 2. * rpi / rsiday 111 #endif 112 113 rau0r = 1. / rau0 114 ro0cpr = 1. / ( rau0 * rcp ) 115 116 117 IF(lwp) THEN ! control print 118 WRITE(numout,*) 119 WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 120 WRITE(numout,*) ' ~~~~~~~' 107 IF(lwp) WRITE(numout,*) 108 IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 109 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 110 111 ! Ocean Parameters 112 ! ---------------- 113 IF(lwp) THEN 121 114 WRITE(numout,*) ' Domain info' 122 115 WRITE(numout,*) ' dimension of model' … … 131 124 WRITE(numout,*) ' jpnij : ', jpnij 132 125 WRITE(numout,*) ' lateral domain boundary condition type : jperio = ', jperio 133 WRITE(numout,*) 134 WRITE(numout,*) ' Constants' 135 WRITE(numout,*) 136 WRITE(numout,*) ' mathematical constant rpi = ', rpi 137 WRITE(numout,*) ' day rday = ', rday, ' s' 138 WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 139 WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 140 WRITE(numout,*) ' omega omega = ', omega, ' s-1' 141 WRITE(numout,*) 142 WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 143 WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 144 WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 145 WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 146 WRITE(numout,*) 147 WRITE(numout,*) ' earth radius ra = ', ra, ' m' 148 WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 149 WRITE(numout,*) 150 WRITE(numout,*) ' triple point of temperature rtt = ', rtt , ' K' 151 WRITE(numout,*) ' freezing point of water rt0 = ', rt0 , ' K' 152 WRITE(numout,*) ' melting point of snow rt0_snow = ', rt0_snow, ' K' 153 WRITE(numout,*) ' melting point of ice rt0_ice = ', rt0_ice , ' K' 154 WRITE(numout,*) 155 WRITE(numout,*) ' ocean reference volumic mass rau0 = ', rau0 , ' kg/m^3' 156 WRITE(numout,*) ' ocean reference specific volume rau0r = ', rau0r, ' m^3/Kg' 157 WRITE(numout,*) ' ocean specific heat rcp = ', rcp 158 WRITE(numout,*) ' 1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 126 ENDIF 127 128 ! Define constants 129 ! ---------------- 130 IF(lwp) WRITE(numout,*) 131 IF(lwp) WRITE(numout,*) ' Constants' 132 133 IF(lwp) WRITE(numout,*) 134 IF(lwp) WRITE(numout,*) ' mathematical constant rpi = ', rpi 135 136 rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp 137 rsiday = rday / ( 1._wp + rday / rsiyea ) 138 #if defined key_cice 139 omega = 7.292116e-05 140 #else 141 omega = 2._wp * rpi / rsiday 142 #endif 143 IF(lwp) WRITE(numout,*) 144 IF(lwp) WRITE(numout,*) ' day rday = ', rday, ' s' 145 IF(lwp) WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 146 IF(lwp) WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 147 IF(lwp) WRITE(numout,*) ' omega omega = ', omega, ' s^-1' 148 149 IF(lwp) WRITE(numout,*) 150 IF(lwp) WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 151 IF(lwp) WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 152 IF(lwp) WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 153 IF(lwp) WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 154 155 IF(lwp) WRITE(numout,*) 156 IF(lwp) WRITE(numout,*) ' earth radius ra = ', ra, ' m' 157 IF(lwp) WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 158 159 IF(lwp) WRITE(numout,*) 160 IF(lwp) WRITE(numout,*) ' triple point of temperature rtt = ', rtt , ' K' 161 IF(lwp) WRITE(numout,*) ' freezing point of water rt0 = ', rt0 , ' K' 162 IF(lwp) WRITE(numout,*) ' melting point of snow rt0_snow = ', rt0_snow, ' K' 163 IF(lwp) WRITE(numout,*) ' melting point of ice rt0_ice = ', rt0_ice , ' K' 164 165 r1_rau0 = 1._wp / rau0 166 r1_rcp = 1._wp / rcp 167 r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 168 IF(lwp) WRITE(numout,*) 169 IF(lwp) WRITE(numout,*) ' volumic mass of pure water rauw = ', rauw , ' kg/m^3' 170 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0 , ' kg/m^3' 171 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 172 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 173 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 174 175 176 #if defined key_lim3 || defined key_cice 177 xlsn = lfus * rhosn ! volumetric latent heat fusion of snow [J/m3] 178 #else 179 cpic = rcpic / rhoic ! specific heat for ice [J/Kg/K] 180 lfus = xlsn / rhosn ! latent heat of fusion of fresh ice 181 #endif 182 183 IF(lwp) THEN 159 184 WRITE(numout,*) 160 185 WRITE(numout,*) ' thermal conductivity of the snow = ', rcdsn , ' J/s/m/K' 161 186 WRITE(numout,*) ' thermal conductivity of the ice = ', rcdic , ' J/s/m/K' 162 #if defined key_lim3163 187 WRITE(numout,*) ' fresh ice specific heat = ', cpic , ' J/kg/K' 164 188 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' 189 #if defined key_lim3 165 190 WRITE(numout,*) ' latent heat of subl. of fresh ice / snow = ', lsub , ' J/kg' 166 #elif defined key_cice167 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg'168 191 #else 169 192 WRITE(numout,*) ' density times specific heat for snow = ', rcpsn , ' J/m^3/K' 170 193 WRITE(numout,*) ' density times specific heat for ice = ', rcpic , ' J/m^3/K' 171 194 WRITE(numout,*) ' volumetric latent heat fusion of sea ice = ', xlic , ' J/m' 172 WRITE(numout,*) ' volumetric latent heat fusion of snow = ', xlsn , ' J/m'173 195 WRITE(numout,*) ' latent heat of sublimation of snow = ', xsn , ' J/kg' 174 196 #endif 197 WRITE(numout,*) ' volumetric latent heat fusion of snow = ', xlsn , ' J/m^3' 175 198 WRITE(numout,*) ' density of sea ice = ', rhoic , ' kg/m^3' 176 199 WRITE(numout,*) ' density of snow = ', rhosn , ' kg/m^3' -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r3294 r3396 61 61 ! 62 62 INTEGER :: ji, jj, jk, jl ! dummy loop indices 63 REAL(wp) :: z rau0r, zlavmr, zua, zva ! local scalars63 REAL(wp) :: zlavmr, zua, zva ! local scalars 64 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy, zwz, zww 65 65 !!---------------------------------------------------------------------- … … 75 75 ENDIF 76 76 77 zrau0r = 1. / rau0 ! Local constant initialization78 77 zlavmr = 1. / REAL( nn_zdfexp ) 79 78 … … 81 80 DO jj = 2, jpjm1 ! Surface boundary condition 82 81 DO ji = 2, jpim1 83 zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r84 zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r82 zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0 83 zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_rau0 85 84 END DO 86 85 END DO -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r3294 r3396 161 161 DO ji = fs_2, fs_jpim1 ! vector opt. 162 162 ua(ji,jj,1) = ub(ji,jj,1) + p2dt * ( ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 163 & / ( fse3u(ji,jj,1) * rau0 ))163 & * r1_rau0 / fse3u(ji,jj,1) ) 164 164 END DO 165 165 END DO … … 247 247 DO ji = fs_2, fs_jpim1 ! vector opt. 248 248 va(ji,jj,1) = vb(ji,jj,1) + p2dt * ( va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 249 & / ( fse3v(ji,jj,1) * rau0 ))249 & * r1_rau0 / fse3v(ji,jj,1) ) 250 250 END DO 251 251 END DO -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r3294 r3396 60 60 !! 61 61 !! ** Action : - set the ocean surface boundary condition, i.e. 62 !! utau, vtau, taum, wndm, qns, qsr, emp , emps62 !! utau, vtau, taum, wndm, qns, qsr, emp 63 63 !!---------------------------------------------------------------------- 64 64 INTEGER, INTENT(in) :: kt ! ocean time step … … 89 89 nn_tau000 = MAX( nn_tau000, 1 ) ! must be >= 1 90 90 ! 91 qns (:,:) = rn_qns0 91 emp (:,:) = rn_emp0 92 qns (:,:) = rn_qns0 - emp(:,:) * sst_m(:,:) * rcp ! including heat content associated with mass flux at SST 92 93 qsr (:,:) = rn_qsr0 93 emp (:,:) = rn_emp094 emps(:,:) = rn_emp095 94 ! 96 95 utau(:,:) = rn_utau0 … … 130 129 !! 131 130 !! ** Action : - set the ocean surface boundary condition, i.e. 132 !! utau, vtau, taum, wndm, qns, qsr, emp , emps131 !! utau, vtau, taum, wndm, qns, qsr, emp 133 132 !! 134 133 !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000. … … 211 210 END DO 212 211 END DO 213 emps(:,:) = emp(:,:)214 212 215 213 ! Compute the emp flux such as its integration on the whole domain at each time is zero … … 224 222 ENDIF 225 223 226 ! salinity terms227 emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1) 228 emps(:,:) = emp(:,:)224 ! freshwater (mass flux) and update of qns with heat content of emp 225 emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1) ! freshwater flux (=0 in domain average) 226 qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! evap and precip are at SST 229 227 230 228 -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r3294 r3396 12 12 13 13 !!---------------------------------------------------------------------- 14 !! sbc_blk_clio : CLIO bulk formulation: read and update required input fields15 !! blk_clio_oce : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean16 !! blk_ice_clio : ice CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice14 !! sbc_blk_clio : CLIO bulk formulation: read and update required input fields 15 !! blk_clio_oce : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean 16 !! blk_ice_clio : ice CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice 17 17 !! blk_clio_qsr_oce : shortwave radiation for ocean computed from the cloud cover 18 18 !! blk_clio_qsr_ice : shortwave radiation for ice computed from the cloud cover 19 !! flx_blk_declin : solar declinaison19 !! flx_blk_declin : solar declination 20 20 !!---------------------------------------------------------------------- 21 21 USE oce ! ocean dynamics and tracers … … 50 50 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) (N/m2) at V-point 51 51 INTEGER , PARAMETER :: jp_wndm = 3 ! index of 10m wind module (m/s) at T-point 52 INTEGER , PARAMETER :: jp_humi = 4 ! index of specific humidity ( -)53 INTEGER , PARAMETER :: jp_ccov = 5 ! index of cloud cover ( -)52 INTEGER , PARAMETER :: jp_humi = 4 ! index of specific humidity ( % ) 53 INTEGER , PARAMETER :: jp_ccov = 5 ! index of cloud cover ( % ) 54 54 INTEGER , PARAMETER :: jp_tair = 6 ! index of 10m air temperature (Kelvin) 55 55 INTEGER , PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) … … 100 100 !! the i-component of the stress (N/m2) 101 101 !! the j-component of the stress (N/m2) 102 !! the 10m wind pseed module (m/s)102 !! the 10m wind speed module (m/s) 103 103 !! the 10m air temperature (Kelvin) 104 !! the 10m specific humidity ( -)105 !! the cloud cover ( -)104 !! the 10m specific humidity (%) 105 !! the cloud cover (%) 106 106 !! the total precipitation (rain+snow) (Kg/m2/s) 107 107 !! (2) CALL blk_oce_clio 108 108 !! 109 109 !! C A U T I O N : never mask the surface stress fields 110 !! the stress is assumed to be in the mesh referential 111 !! i.e. the (i,j) referential 110 !! the stress is assumed to be in the (i,j) mesh referential 112 111 !! 113 112 !! ** Action : defined at each time-step at the air-sea interface … … 115 114 !! - taum wind stress module at T-point 116 115 !! - wndm 10m wind module at T-point 117 !! - qns, qsr non-slor and solar heat flux 118 !! - emp, emps evaporation minus precipitation 116 !! - qns non-solar heat flux including latent heat of solid 117 !! precip. melting and emp heat content 118 !! - qsr solar heat flux 119 !! - emp upward mass flux (evap. - precip) 119 120 !!---------------------------------------------------------------------- 120 INTEGER, INTENT( in) :: kt ! ocean time step121 INTEGER, INTENT( in ) :: kt ! ocean time step 121 122 !! 122 123 INTEGER :: ifpr, jfpr ! dummy indices … … 205 206 !! - taum wind stress module at T-point 206 207 !! - wndm 10m wind module at T-point 207 !! - qns, qsr non-slor and solar heat flux 208 !! - emp, emps evaporation minus precipitation 208 !! - qns non-solar heat flux including latent heat of solid 209 !! precip. melting and emp heat content 210 !! - qsr solar heat flux 211 !! - emp suface mass flux (evap.-precip.) 209 212 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC 210 213 !!---------------------------------------------------------------------- … … 223 226 REAL(wp) :: zsst, ztatm, zcco1, zpatm, zcmax, zrmax ! - - 224 227 REAL(wp) :: zrhoa, zev, zes, zeso, zqatm, zevsqr ! - - 225 REAL(wp) :: ztx2, zty2 228 REAL(wp) :: ztx2, zty2, zcevap, zcprec ! - - 226 229 REAL(wp), POINTER, DIMENSION(:,:) :: zqlw ! long-wave heat flux over ocean 227 230 REAL(wp), POINTER, DIMENSION(:,:) :: zqla ! latent heat flux over ocean … … 363 366 ! III Total FLUXES ! 364 367 ! ----------------------------------------------------------------------------- ! 365 366 !CDIR COLLAPSE 367 emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 368 qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! Downward Non Solar flux 369 emps(:,:) = emp(:,:) 370 ! 368 zcevap = rcp / cevap ! convert zqla ==> evap (Kg/m2/s) ==> m/s ==> W/m2 369 zcprec = rcp / rday ! convert prec ( mm/day ==> m/s) ==> W/m2 370 371 !CDIR COLLAPSE 372 emp(:,:) = zqla(:,:) / cevap & ! freshwater flux 373 & - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 374 ! 375 !CDIR COLLAPSE 376 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 377 & - zqla(:,:) * pst(:,:) * zcevap & ! remove evap. heat content at SST in Celcius 378 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 379 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 380 371 381 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 372 382 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean … … 407 417 !! 408 418 !! ** Action : call albedo_oce/albedo_ice to compute ocean/ice albedo 409 !! computation of snow precipitation 410 !! computation of solar flux at the ocean and ice surfaces 411 !! computation of the long-wave radiation for the ocean and sea/ice 412 !! computation of turbulent heat fluxes over water and ice 413 !! computation of evaporation over water 414 !! computation of total heat fluxes sensitivity over ice (dQ/dT) 415 !! computation of latent heat flux sensitivity over ice (dQla/dT) 416 !! 419 !! - snow precipitation 420 !! - solar flux at the ocean and ice surfaces 421 !! - the long-wave radiation for the ocean and sea/ice 422 !! - turbulent heat fluxes over water and ice 423 !! - evaporation over water 424 !! - total heat fluxes sensitivity over ice (dQ/dT) 425 !! - latent heat flux sensitivity over ice (dQla/dT) 426 !! - qns : modified the non solar heat flux over the ocean 427 !! to take into account solid precip latent heat flux 417 428 !!---------------------------------------------------------------------- 418 429 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] … … 594 605 ! 595 606 ! ----------------------------------------------------------------------------- ! 596 ! Total FLUXES !607 ! Total FLUXES ! 597 608 ! ----------------------------------------------------------------------------- ! 598 609 ! … … 601 612 !CDIR COLLAPSE 602 613 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 614 ! 615 ! ----------------------------------------------------------------------------- ! 616 ! Correct the OCEAN non solar flux with the existence of solid precipitation ! 617 ! ---------------=====--------------------------------------------------------- ! 618 !CDIR COLLAPSE 619 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 620 & - p_spr(:,:) * lfus & ! remove melting solid precip 621 & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 622 & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 603 623 ! 604 624 !!gm : not necessary as all input data are lbc_lnk... -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3294 r3396 52 52 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 53 53 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point 54 INTEGER , PARAMETER :: jp_humi = 3 ! index of specific humidity ( -)54 INTEGER , PARAMETER :: jp_humi = 3 ! index of specific humidity ( % ) 55 55 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat (W/m2) 56 56 INTEGER , PARAMETER :: jp_qlw = 5 ! index of Long wave (W/m2) … … 69 69 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 70 70 REAL(wp), PARAMETER :: Cice = 1.63e-3 ! transfer coefficient over ice 71 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be con tant71 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 72 72 73 73 ! !!* Namelist namsbc_core : CORE bulk parameters … … 96 96 !! the 10m wind velocity (i-component) (m/s) at T-point 97 97 !! the 10m wind velocity (j-component) (m/s) at T-point 98 !! the specific humidity ( -)98 !! the 10m or 2m specific humidity ( % ) 99 99 !! the solar heat (W/m2) 100 100 !! the Long wave (W/m2) 101 !! the 10m air temperature(Kelvin)101 !! the 10m or 2m air temperature (Kelvin) 102 102 !! the total precipitation (rain+snow) (Kg/m2/s) 103 103 !! the snow (solid prcipitation) (kg/m2/s) 104 !! OPTIONAL parameter (see ln_taudif namelist flag): 105 !! the tau diff associated to HF tau (N/m2) at T-point 104 !! the tau diff associated to HF tau (N/m2) at T-point (ln_taudif=T) 106 105 !! (2) CALL blk_oce_core 107 106 !! 108 107 !! C A U T I O N : never mask the surface stress fields 109 !! the stress is assumed to be in the mesh referential 110 !! i.e. the (i,j) referential 108 !! the stress is assumed to be in the (i,j) mesh referential 111 109 !! 112 110 !! ** Action : defined at each time-step at the air-sea interface 113 111 !! - utau, vtau i- and j-component of the wind stress 114 !! - taum wind stress module at T-point 115 !! - wndm 10m wind module at T-point 116 !! - qns, qsr non-slor and solar heat flux 117 !! - emp, emps evaporation minus precipitation 112 !! - taum, wndm wind stress and 10m wind modules at T-point 113 !! - qns, qsr non-solar and solar heat flux 114 !! - emp upward mass flux (evapo. - precip.) 118 115 !!---------------------------------------------------------------------- 119 116 INTEGER, INTENT(in) :: kt ! ocean time step … … 125 122 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 126 123 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 127 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 128 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 129 TYPE(FLD_N) :: sn_tdif ! " " 124 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 125 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif ! - - 130 126 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 131 127 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & … … 221 217 !! - qns : Non Solar heat flux over the ocean (W/m2) 222 218 !! - evap : Evaporation over the ocean (kg/m2/s) 223 !! - emp (s): evaporation minus precipitation (kg/m2/s)219 !! - emp : evaporation minus precipitation (kg/m2/s) 224 220 !! 225 221 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC … … 378 374 379 375 !CDIR COLLAPSE 380 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! Downward Non Solar flux 381 !CDIR COLLAPSE 382 emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 383 !CDIR COLLAPSE 384 emps(:,:) = emp(:,:) 376 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 377 & - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1) 378 !CDIR COLLAPSE 379 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 380 & - sf(jp_snow)%fnow(:,:,1) * lfus & ! remove latent melting heat for solid precip 381 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST 382 & + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) & ! add liquid precip heat content at Tair 383 & * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & 384 & + sf(jp_snow)%fnow(:,:,1) & ! add solid precip heat content at min(Tair,Tsnow) 385 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic 385 386 ! 386 387 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3294 r3396 664 664 !! ** Action : update utau, vtau ocean stress at U,V grid 665 665 !! taum, wndm wind stres and wind speed module at T-point 666 !! qns , qsr non solar and solar ocean heat fluxes ('ocean only case) 667 !! emp = emps evap. - precip. (- runoffs) (- calving) ('ocean only case) 666 !! qns non solar heat fluxes including emp heat content (ocean only case) 667 !! and the latent heat flux of solid precip. melting 668 !! qsr solar ocean heat fluxes (ocean only case) 669 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 668 670 !!---------------------------------------------------------------------- 669 671 INTEGER, INTENT(in) :: kt ! ocean model time step index … … 821 823 ! ! ========================= ! 822 824 ! 823 ! ! non solar heat flux over the ocean (qns)824 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)825 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)826 ! add the latent heat of solid precip. melting827 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus828 829 ! ! solar flux over the ocean (qsr)830 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)831 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)832 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle833 !834 825 ! ! total freshwater fluxes over the ocean (emp, emps) 835 826 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation … … 863 854 !!gm end of internal cooking 864 855 ! 865 emps(:,:) = emp(:,:) ! concentration/dilution = emp 856 ! ! non solar heat flux over the ocean (qns) 857 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 858 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 859 ! add the latent heat of solid precip. melting 860 IF( srcv(jpr_snow )%laction ) THEN ! update qns over the free ocean with: 861 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean 862 & - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 863 ENDIF 864 865 ! ! solar flux over the ocean (qsr) 866 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 867 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 868 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 869 ! 866 870 867 871 ENDIF … … 1141 1145 1142 1146 zicefr(:,:) = 1.- p_frld(:,:) 1143 IF( lk_diaar5 ) zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 1147 !zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 1148 zcptn(:,:) = rcp * sst_m(:,:) 1144 1149 ! 1145 1150 ! ! ========================= ! … … 1233 1238 & + pist(:,:,1) * zicefr(:,:) ) ) 1234 1239 END SELECT 1235 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus ! add the latent heat of solid precip. melting 1236 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) ! over free ocean 1240 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 1241 qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with: 1242 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1243 & + ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1244 & - emp_ice(:,:) * p_frld(:,:,1) ) * zcptn(:,:) 1237 1245 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1238 1246 !!gm -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r2715 r3396 61 61 !! 62 62 !! CAUTION : - never mask the surface stress fields 63 !! - the stress is assumed to be in the mesh referential 64 !! i.e. the (i,j) referential 63 !! - the stress is assumed to be in the (i,j) mesh referential 65 64 !! 66 65 !! ** Action : update at each time-step … … 68 67 !! - taum wind stress module at T-point 69 68 !! - wndm 10m wind module at T-point 70 !! - qns, qsr non-slor and solar heat flux 71 !! - emp, emps evaporation minus precipitation 69 !! - qns non solar heat flux including heat flux due to emp 70 !! - qsr solar heat flux 71 !! - emp upward mass flux (evap. - precip.) 72 72 !!---------------------------------------------------------------------- 73 73 INTEGER, INTENT(in) :: kt ! ocean time step … … 139 139 END DO 140 140 END DO 141 ! ! add to qns the heat due to e-p 142 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 143 ! 141 144 ! ! module of wind stress and wind speed at T-point 142 145 zcoef = 1. / ( zrhoa * zcdrag ) … … 154 157 CALL lbc_lnk( taum(:,:), 'T', 1. ) ; CALL lbc_lnk( wndm(:,:), 'T', 1. ) 155 158 156 emps(:,:) = emp (:,:) ! Initialization of emps (needed when no ice model)157 158 159 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 159 160 WRITE(numout,*) -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r3294 r3396 64 64 INTEGER, INTENT( in ) :: kn_fwb ! ocean time-step index 65 65 ! 66 INTEGER :: inum, ikty, iyear ! local integers 67 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars 68 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread ! - - 69 REAL(wp), POINTER, DIMENSION(:,:) :: ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor 66 INTEGER :: inum, ikty, iyear ! local integers 67 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars 68 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread, zcoef ! - - 69 REAL(wp), POINTER, DIMENSION(:,:) :: ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 70 REAL(wp), POINTER, DIMENSION(:,:) :: ztmsk_tospread, zerp_cor ! - - 70 71 !!---------------------------------------------------------------------- 71 72 ! … … 96 97 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 97 98 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area ! sum over the global domain 98 emp (:,:) = emp (:,:) - z_fwf 99 emps(:,:) = emps(:,:) - z_fwf 99 zcoef = z_fwf * rcp 100 emp(:,:) = emp(:,:) - z_fwf 101 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) ! ensure fw correction does not change the heat budget 100 102 ENDIF 101 103 ! … … 103 105 ! 104 106 IF( kt == nit000 ) THEN ! initialisation 105 ! 107 ! ! Read the corrective factor on precipitations (fwfold) 106 108 CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 107 109 READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb … … 125 127 ENDIF 126 128 ! 127 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes 128 emp (:,:) = emp (:,:) + fwfold 129 emps(:,:) = emps(:,:) + fwfold 130 ENDIF 131 ! 132 IF( kt == nitend .AND. lwp ) THEN ! save fwfold value in a file 129 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes 130 zcoef = fwfold * rcp 131 emp(:,:) = emp(:,:) + fwfold 132 qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) ! ensure fw correction does not change the heat budget 133 ENDIF 134 ! 135 IF( kt == nitend .AND. lwp ) THEN ! save fwfold value in a file 133 136 CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 134 137 WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb … … 143 146 ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 144 147 ! 145 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) 148 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp 146 149 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 147 150 ! ! fwf global mean 148 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area151 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 149 152 ! 150 153 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation … … 160 163 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 161 164 ! ! weight to respect erp field 2D structure 162 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )165 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 163 166 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 164 167 ! ! final correction term to apply … … 168 171 CALL lbc_lnk( zerp_cor, 'T', 1. ) 169 172 ! 170 emp (:,:) = emp(:,:) + zerp_cor(:,:)171 emps(:,:) = emps(:,:) + zerp_cor(:,:)172 erp (:,:) = erp(:,:) + zerp_cor(:,:)173 emp(:,:) = emp(:,:) + zerp_cor(:,:) 174 qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:) 175 erp(:,:) = erp(:,:) + zerp_cor(:,:) 173 176 ! 174 177 IF( nprint == 1 .AND. lwp ) THEN ! control print -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3294 r3396 140 140 IF( nn_ice == 0 ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 141 141 142 emps(:,:) = 0.e0 ! the salt flux will be computed (i.e. will be non-zero) only if 143 ! ! sea-ice is present, or lk_vvl=F, or surface salt restoring is used. 144 142 145 ! ! restartability 143 146 IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. & -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r3294 r3396 56 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rnf_tsc_b, rnf_tsc !: before and now T & S runoff contents [K.m/s & PSU.m/s] 57 57 58 REAL(wp) :: r1_rau0 ! = 1 / rau059 58 60 59 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read) … … 129 128 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) 130 129 ! 131 r1_rau0 = 1._wp / rau0132 130 ! ! set temperature & salinity content of runoffs 133 131 IF( ln_rnf_tem ) THEN ! use runoffs temperature data … … 199 197 !! 200 198 INTEGER :: ji, jj, jk ! dummy loop indices 201 REAL(wp) :: r1_rau0 ! local scalar202 199 REAL(wp) :: zfact ! local scalar 203 200 !!---------------------------------------------------------------------- … … 205 202 zfact = 0.5_wp 206 203 ! 207 r1_rau0 = 1._wp / rau0208 204 IF( ln_rnf_depth ) THEN !== runoff distributed over several levels ==! 209 205 IF( lk_vvl ) THEN ! variable volume case -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r3294 r3396 156 156 ! ! ========================= ! 157 157 ! 158 IF( nn_sstr == 1 ) THEN !* Temperature restoring term158 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 159 159 !CDIR COLLAPSE 160 160 DO jj = 1, jpj … … 168 168 ENDIF 169 169 ! 170 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux, emps only)170 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (emps)) 171 171 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 172 172 !CDIR COLLAPSE … … 174 174 DO ji = 1, jpi 175 175 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 176 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 177 & / ( sss_m(ji,jj) + 1.e-20 ) 178 emps(ji,jj) = emps(ji,jj) + zerp 179 erp( ji,jj) = zerp 176 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) 177 emps(ji,jj) = emps(ji,jj) + zerp ! salt flux 178 erp( ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 180 179 END DO 181 180 END DO 182 181 CALL iom_put( "erp", erp ) ! freshwater flux damping 183 182 ! 184 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux, emp and emps)183 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 185 184 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 186 185 zerp_bnd = rn_sssr_bnd / rday ! - - … … 190 189 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 191 190 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 192 & / ( sss_m(ji,jj) +1.e-20 )191 & / MAX( sss_m(ji,jj), 1.e-20 ) 193 192 IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 194 emp 195 emps(ji,jj) = emps(ji,jj) + zerp196 erp 193 emp(ji,jj) = emp (ji,jj) + zerp 194 qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 195 erp(ji,jj) = zerp 197 196 END DO 198 197 END DO -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r3294 r3396 121 121 REAL(wp) :: zd , zc , zaw, za ! - - 122 122 REAL(wp) :: zb1, za1, zkw, zk0 ! - - 123 REAL(wp) :: zrau0r ! - -124 123 REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 125 124 !!---------------------------------------------------------------------- … … 133 132 ! 134 133 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 135 zrau0r = 1.e0 / rau0136 134 !CDIR NOVERRCHK 137 135 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) … … 174 172 ! masked in situ density anomaly 175 173 prd(ji,jj,jk) = ( zrhop / ( 1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) ) ) & 176 & - rau0 ) * zrau0r* tmask(ji,jj,jk)174 & - rau0 ) * r1_rau0 * tmask(ji,jj,jk) 177 175 END DO 178 176 END DO … … 254 252 INTEGER :: ji, jj, jk ! dummy loop indices 255 253 REAL(wp) :: zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw ! local scalars 256 REAL(wp) :: zb, zd, zc, zaw, za, zb1, za1, zkw, zk0 , zrau0r! - -254 REAL(wp) :: zb, zd, zc, zaw, za, zb1, za1, zkw, zk0 ! - - 257 255 REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 258 256 !!---------------------------------------------------------------------- … … 265 263 ! 266 264 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 267 zrau0r = 1.e0 / rau0268 265 !CDIR NOVERRCHK 269 266 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) … … 309 306 ! masked in situ density anomaly 310 307 prd(ji,jj,jk) = ( zrhop / ( 1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) ) ) & 311 & - rau0 ) * zrau0r* tmask(ji,jj,jk)308 & - rau0 ) * r1_rau0 * tmask(ji,jj,jk) 312 309 END DO 313 310 END DO -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r3294 r3396 155 155 CASE ( 1 ) !* constant flux 156 156 IF(lwp) WRITE(numout,*) ' *** constant heat flux = ', rn_geoflx_cst 157 qgh_trd0(:,:) = r o0cpr* rn_geoflx_cst157 qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 158 158 ! 159 159 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 … … 162 162 CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 163 163 CALL iom_close( inum ) 164 qgh_trd0(:,:) = r o0cpr* qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2164 qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2 165 165 ! 166 166 CASE DEFAULT -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r3294 r3396 147 147 ! ! ============================================== ! 148 148 DO jk = 1, jpkm1 149 qsr_hc(:,:,jk) = r o0cpr* ( etot3(:,:,jk) - etot3(:,:,jk+1) )149 qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 150 150 END DO 151 151 ! Add to the general trend … … 219 219 ! 220 220 DO jk = 1, nksr ! compute and add qsr trend to ta 221 qsr_hc(:,:,jk) = r o0cpr* ( zea(:,:,jk) - zea(:,:,jk+1) )221 qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 222 222 END DO 223 223 zea(:,:,nksr+1:jpk) = 0.e0 ! below 400m set to zero … … 236 236 ! 237 237 IF( lk_vvl ) THEN !* variable volume 238 zz0 = rn_abs * r o0cpr239 zz1 = ( 1. - rn_abs ) * r o0cpr238 zz0 = rn_abs * r1_rau0_rcp 239 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 240 240 DO jk = 1, nksr ! solar heat absorbed at T-point in the top 400m 241 241 DO jj = 1, jpj … … 463 463 ! 464 464 DO jk = 1, nksr 465 etot3(:,:,jk) = r o0cpr* ( zea(:,:,jk) - zea(:,:,jk+1) )465 etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 466 466 END DO 467 467 etot3(:,:,nksr+1:jpk) = 0.e0 ! below 400m set to zero … … 484 484 IF(lwp) WRITE(numout,*) ' key_vvl: light distribution will be computed at each time step' 485 485 ELSE ! constant volume: computes one for all 486 zz0 = rn_abs * r o0cpr487 zz1 = ( 1. - rn_abs ) * r o0cpr486 zz0 = rn_abs * r1_rau0_rcp 487 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 488 488 DO jk = 1, nksr !* solar heat absorbed at T-point computed once for all 489 489 DO jj = 1, jpj ! top 400 meters -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r3294 r3396 60 60 !! at the surface by evaporation, precipitations and runoff (E-P-R); 61 61 !! (3) Fwe, tracer carried with the water that is exchanged. 62 !! - salinity : salt flux only due to freezing/melting 63 !! sa = sa + fsalt / rau0 / e3t for k=1 62 64 !! 63 65 !! Fext, flux through the air-sea interface for temperature and salt: … … 84 86 !! (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST 85 87 !! - salinity : evaporation, precipitation and runoff 86 !! water has a zero salinity (Fwe=0), thus only Fwi remains: 87 !! sa = sa + emp * sn / e3t for k=1 88 !! water has a zero salinity but there is a salt flux due to 89 !! freezing/melting, thus: 90 !! sa = sa + emp * sn / rau0 / e3t for k=1 91 !! + fsalt / rau0 / e3t 88 92 !! where emp, the surface freshwater budget (evaporation minus 89 93 !! precipitation minus runoff) given in kg/m2/s is divided … … 109 113 !! 110 114 INTEGER :: ji, jj, jk, jn ! dummy loop indices 111 REAL(wp) :: zfact, z1_e3t, z srau, zdep115 REAL(wp) :: zfact, z1_e3t, zdep 112 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds 113 117 !!---------------------------------------------------------------------- … … 120 124 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 121 125 ENDIF 122 123 zsrau = 1. / rau0 ! initialization124 126 125 127 IF( l_trdtra ) THEN !* Save ta and sa trends … … 163 165 ! evaporation, precipitation and qns, but not river runoff 164 166 165 IF( lk_vvl ) THEN ! Variable Volume case 167 IF( lk_vvl ) THEN ! Variable Volume case ==>> heat content of mass flux is in qns 166 168 DO jj = 1, jpj 167 169 DO ji = 1, jpi 168 ! temperature : heat flux + cooling/heating effet of EMP flux 169 sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 170 ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration 171 sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) 170 sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) ! non solar heat flux 171 sbc_tsc(ji,jj,jp_sal) = r1_rau0 * emps(ji,jj) ! salt flux (freezing/melting) 172 172 END DO 173 173 END DO … … 176 176 DO ji = fs_2, fs_jpim1 ! vector opt. 177 177 ! temperature : heat flux 178 sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) 178 sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) & ! non solar heat flux 179 & + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem) ! concent./dilut. effect 179 180 ! salinity : salt flux + concent./dilut. effect (both in emps) 180 sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal) 181 sbc_tsc(ji,jj,jp_sal) = r1_rau0 * ( emps(ji,jj) & ! salt flux (freezing/melting) 182 & + emp (ji,jj) * tsn(ji,jj,1,jp_sal) ) ! concent./dilut. effect 181 183 END DO 182 184 END DO -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r3294 r3396 167 167 ! 168 168 ! surface friction 169 ustars2(ji,jj) = r au0r* taum(ji,jj) * tmask(ji,jj,1)169 ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 170 170 ! 171 171 ! bottom friction (explicit before friction) -
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r3294 r3396 428 428 zBo (ji,jj) = grav * zthermal * qns(ji,jj) - grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) ) 429 429 ! Surface Temperature flux for non-local term 430 wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r o0cpr* tmask(ji,jj,1)430 wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r1_rau0_rcp * tmask(ji,jj,1) 431 431 ! Surface salinity flux for non-local term 432 432 ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1)
Note: See TracChangeset
for help on using the changeset viewer.