Changeset 3625
- Timestamp:
- 2012-11-21T14:19:18+01:00 (11 years ago)
- Location:
- branches/2012/dev_NOC_2012_rev3555
- Files:
-
- 106 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_NOC_2012_rev3555/DOC/TexFiles/Chapters/Chap_SBC.tex
r3609 r3625 1146 1146 \label{SBC_cice} 1147 1147 1148 It is now possible to couple a global NEMO configuration (without AGRIF) to the CICE sea-ice1148 It is now possible to couple a regional or global NEMO configuration (without AGRIF) to the CICE sea-ice 1149 1149 model by using \key{cice}. The CICE code can be obtained from 1150 1150 \href{http://oceans11.lanl.gov/trac/CICE/}{LANL} and the additional 'hadgem3' drivers will be required, -
branches/2012/dev_NOC_2012_rev3555/DOC/TexFiles/Chapters/Introduction.tex
r3308 r3625 63 63 \citep{OASIS2006}. Two-way nesting is also available through an interface to the 64 64 AGRIF package (Adaptative Grid Refinement in \textsc{Fortran}) \citep{Debreu_al_CG2008}. 65 The interface code for coupling to an alternative sea ice model (CICE, \citet{Hunke2008}) is now 66 available although this is currently only designed for global domains, without the use of AGRIF. 65 The interface code for coupling to an alternative sea ice model (CICE, \citet{Hunke2008}) 66 has now been upgraded so that it works for both global and regional domains, although AGRIF 67 is still not available. 67 68 68 69 Other model characteristics are the lateral boundary conditions (chapter~\ref{LBC}). -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/AMM12/EXP00/namelist
r3609 r3625 137 137 ! =1 use observed ice-cover , 138 138 ! =2 ice-model used ("key_lim3" or "key_lim2) 139 nn_ice_embd = 0 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 140 ! =1 levitating ice with mass and salt exchange but no presure effect 141 ! =2 embedded sea-ice (full salt and mass exchanges and pressure) 139 142 ln_dm2dc = .false. ! daily mean to diurnal cycle on short wave 140 143 ln_rnf = .true. ! runoffs (T => fill namsbc_rnf) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist
r3609 r3625 137 137 ! =1 use observed ice-cover , 138 138 ! =2 ice-model used ("key_lim3" or "key_lim2) 139 nn_ice_embd = 0 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 140 ! =1 levitating ice with mass and salt exchange but no presure effect 141 ! =2 embedded sea-ice (full salt and mass exchanges and pressure) 139 142 ln_dm2dc = .false. ! daily mean to diurnal cycle on short wave 140 143 ln_rnf = .true. ! runoffs (T => fill namsbc_rnf) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/GYRE/EXP00/namelist
r3614 r3625 137 137 ! =1 use observed ice-cover , 138 138 ! =2 ice-model used ("key_lim3" or "key_lim2) 139 nn_ice_embd = 0 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 140 ! =1 levitating ice with mass and salt exchange but no presure effect 141 ! =2 embedded sea-ice (full salt and mass exchanges and pressure) 139 142 ln_dm2dc = .false. ! daily mean to diurnal cycle on short wave 140 143 ln_rnf = .false. ! runoffs (T => fill namsbc_rnf) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
r3294 r3625 124 124 125 125 <field id="empmr" description="Net Upward Water Flux" unit="kg/m2/s" /> 126 <field id=" empsmr" description="concentration/dilution water flux" unit="kg/m2/s"/>126 <field id="saltflx" description="Downward Salt Flux" unit="PSU/m2/s" /> 127 127 <field id="snowpre" description="Snow precipitation" unit="kg/m2/s" /> 128 128 <field id="runoffs" description="River Runoffs" unit="Kg/m2/s" /> … … 145 145 <field id="qsb_oce" description="Sensible Downward Heat Flux over open ocean" unit="W/m2" /> 146 146 <field id="qla_oce" description="Latent Downward Heat Flux over open ocean" unit="W/m2" /> 147 <field id="qhc_oce" description="Downward Heat Content of E-P over open ocean" unit="W/m2" /> 147 148 <field id="taum_oce" description="wind stress module over open ocean" unit="N/m2" /> 148 149 … … 173 174 <field id="v_imasstr" description="Sea-ice mass transport along j-axis" unit="kg/s" /> 174 175 176 <!-- available if not defined key_vvl --> 177 <field id="emp_x_sst" description="Concentration/Dilution term on SST" unit="kgC/m2/s" /> 178 <field id="emp_x_sss" description="Concentration/Dilution term on SSS" unit="kgPSU/m2/s" /> 175 179 <!-- available key_coupled --> 176 180 <field id="snow_ao_cea" description="Snow over ice-free ocean (cell average)" unit="kg/m2/s" /> … … 1016 1020 <field ref="empmr" name="sowaflup" /> 1017 1021 <field ref="qsr" name="soshfldo" /> 1018 <field ref=" empsmr" name="sowaflcd" />1022 <field ref="saltflx" name="sosfldow" /> 1019 1023 <field ref="qt" name="sohefldo" /> 1020 1024 <field ref="mldr10_1" name="somxl010" /> -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r3609 r3625 137 137 ! =1 use observed ice-cover , 138 138 ! =2 ice-model used ("key_lim3" or "key_lim2) 139 nn_ice_embd = 0 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 140 ! =1 levitating ice with mass and salt exchange but no presure effect 141 ! =2 embedded sea-ice (full salt and mass exchanges and pressure) 139 142 ln_dm2dc = .false. ! daily mean to diurnal cycle on short wave 140 143 ln_rnf = .true. ! runoffs (T => fill namsbc_rnf) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r3614 r3625 137 137 ! =1 use observed ice-cover , 138 138 ! =2 ice-model used ("key_lim3" or "key_lim2) 139 nn_ice_embd = 0 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 140 ! =1 levitating ice with mass and salt exchange but no presure effect 141 ! =2 embedded sea-ice (full salt and mass exchanges and pressure) 139 142 ln_dm2dc = .false. ! daily mean to diurnal cycle on short wave 140 143 ln_rnf = .true. ! runoffs (T => fill namsbc_rnf) … … 650 653 sn_mld = 'dyna_grid_T' , 120 , 'somixhgt' , .true. , .true. , 'yearly' , '' , '' 651 654 sn_emp = 'dyna_grid_T' , 120 , 'sowaflcd' , .true. , .true. , 'yearly' , '' , '' 655 ! sn_emp = 'dyna_grid_T' , 120 , 'sowaflup' , .true. , .true. , 'yearly' , '' , '' ! v3.5+ 656 ! sn_sfx = 'dyna_grid_T' , 120 , 'sosfldow' , .true. , .true. , 'yearly' , '' , '' ! v3.5+ 652 657 sn_ice = 'dyna_grid_T' , 120 , 'soicecov' , .true. , .true. , 'yearly' , '' , '' 653 658 sn_qsr = 'dyna_grid_T' , 120 , 'soshfldo' , .true. , .true. , 'yearly' , '' , '' -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r2715 r3625 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) , & 156 159 & qldif (jpi,jpj) , qcmif (jpi,jpj) , fdtcn (jpi,jpj) , & 157 160 & qdtcn (jpi,jpj) , thcm (jpi,jpj) , STAT=ierr(4) ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r3294 r3625 13 13 !! 'key_lim2' : LIM 2.0 sea-ice model 14 14 !!---------------------------------------------------------------------- 15 !! ice_init_2 16 !! ice_run_2 15 !! ice_init_2 : sea-ice model initialization 16 !! ice_run_2 : Definition some run parameter for ice model 17 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constants 19 USE dom_oce ! ocean domain 20 USE sbc_oce ! surface boundary condition: ocean 21 USE sbc_ice ! LIM2 surface boundary condition 22 USE dom_ice_2 ! LIM2 ice domain 23 USE par_ice_2 ! LIM2 parameters 24 USE thd_ice_2 ! LIM2 thermodynamical variables 25 USE ice_2 ! LIM2 ice variable 26 USE limmsh_2 ! LIM2 mesh 27 USE limistate_2 ! LIM2 initial state 28 USE limrst_2 ! LIM2 restart 29 USE limsbc_2 ! LIM2 surface boundary condition 30 USE in_out_manager ! I/O manager 31 USE lib_mpp ! MPP library 18 USE phycst ! physical constants 19 USE dom_oce ! ocean domain 20 USE sbc_oce ! surface boundary condition: ocean 21 USE sbc_ice ! LIM2 surface boundary condition 22 USE dom_ice_2 ! LIM2 ice domain 23 USE par_ice_2 ! LIM2 parameters 24 USE thd_ice_2 ! LIM2 thermodynamical variables 25 USE ice_2 ! LIM2 ice variable 26 USE limmsh_2 ! LIM2 mesh 27 USE limistate_2 ! LIM2 initial state 28 USE limrst_2 ! LIM2 restart 29 USE limsbc_2 ! LIM2 surface boundary condition 30 USE in_out_manager ! I/O manager 31 USE lib_mpp ! MPP library 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 33 33 34 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
r3294 r3625 14 14 !! 'key_lim2' LIM 2.0 sea-ice model 15 15 !!---------------------------------------------------------------------- 16 !! lim_adv_x_2 : advection of sea ice on x axis17 !! lim_adv_y_2 : advection of sea ice on y axis16 !! lim_adv_x_2 : advection of sea ice on x axis 17 !! lim_adv_y_2 : advection of sea ice on y axis 18 18 !!---------------------------------------------------------------------- 19 19 USE dom_oce … … 21 21 USE ice_2 22 22 USE lbclnk 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays 26 USE prtctl ! Print control 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays 26 USE prtctl ! Print control 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 28 28 29 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90
r2715 r3625 24 24 USE in_out_manager ! I/O manager 25 25 USE lib_mpp ! MPP library 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 27 27 28 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
r2715 r3625 19 19 USE in_out_manager ! I/O manager 20 20 USE lib_mpp ! MPP library 21 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 21 22 22 23 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
r3294 r3625 31 31 USE in_out_manager ! I/O manager 32 32 USE prtctl ! Print control 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 34 34 35 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r3294 r3625 21 21 USE prtctl ! Print control 22 22 USE in_out_manager ! I/O manager 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 23 24 24 25 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
r3294 r3625 27 27 USE iom 28 28 USE in_out_manager 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 29 30 30 31 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
r3294 r3625 23 23 USE wrk_nemo ! work arrays 24 24 #endif 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 26 26 27 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
r3294 r3625 30 30 USE in_out_manager ! I/O manager 31 31 USE prtctl ! Print control 32 USE oce , ONLY : snwice_mass, snwice_mass_b 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 34 33 35 IMPLICIT NONE … … 80 82 REAL(wp) :: zs21_11, zs21_12, zs21_21, zs21_22 81 83 REAL(wp) :: zs22_11, zs22_12, zs22_21, zs22_22 84 REAL(wp) :: zintb, zintn 82 85 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld, zmass, zcorl 83 86 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct, za2ct, zresr 84 87 REAL(wp), POINTER, DIMENSION(:,:) :: zc1u, zc1v, zc2u, zc2v 85 REAL(wp), POINTER, DIMENSION(:,:) :: zsang 88 REAL(wp), POINTER, DIMENSION(:,:) :: zsang, zpice 86 89 REAL(wp), POINTER, DIMENSION(:,:) :: zu0, zv0 87 90 REAL(wp), POINTER, DIMENSION(:,:) :: zu_n, zv_n … … 93 96 94 97 CALL wrk_alloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr ) 95 CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang )98 CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice ) 96 99 CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 97 100 CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) … … 129 132 !i zviszeta(:,jpj+1) = 0._wp ; zviseta(:,jpj+1) = 0._wp 130 133 134 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! 135 ! 136 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 137 ! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 138 zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 139 ! 140 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 141 ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 142 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 143 ! 144 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 145 ! 146 ! 147 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 148 zpice(:,:) = ssh_m(:,:) 149 ENDIF 131 150 132 151 ! Ice mass, ice strength, and wind stress at the center | … … 196 215 197 216 ! Gradient of the sea surface height 198 zgsshx = ( ( ssh_m(ji ,jj ) - ssh_m(ji-1,jj ))/e1u(ji-1,jj ) &199 & + ( ssh_m(ji ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1) ) * 0.5_wp200 zgsshy = ( ( ssh_m(ji ,jj ) - ssh_m(ji ,jj-1))/e2v(ji ,jj-1) &201 & + ( ssh_m(ji-1,jj ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1) ) * 0.5_wp217 zgsshx = ( (zpice(ji ,jj ) - zpice(ji-1,jj ))/e1u(ji-1,jj ) & 218 & + (zpice(ji ,jj-1) - zpice(ji-1,jj-1))/e1u(ji-1,jj-1) ) * 0.5_wp 219 zgsshy = ( (zpice(ji ,jj ) - zpice(ji ,jj-1))/e2v(ji ,jj-1) & 220 & + (zpice(ji-1,jj ) - zpice(ji-1,jj-1))/e2v(ji-1,jj-1) ) * 0.5_wp 202 221 203 222 ! Computation of the velocity field taking into account the ice-ice interaction. … … 575 594 576 595 CALL wrk_dealloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr ) 577 CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang )596 CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice ) 578 597 CALL wrk_dealloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 579 598 CALL wrk_dealloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r3294 r3625 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 … … 28 29 USE sbc_oce ! surface boundary condition: ocean 29 30 USE sbccpl 30 31 USE cpl_oasis3, ONLY : lk_cpl 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 31 33 USE albedo ! albedo parameters 32 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 37 39 USE iom ! I/O library 38 40 USE prtctl ! Print control 39 USE cpl_oasis3, ONLY : lk_cpl41 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 42 41 43 IMPLICIT NONE … … 88 90 !! - Update the fluxes provided to the ocean 89 91 !! 90 !! ** Outputs : - qsr : sea heat flux :solar91 !! - qns : sea heat flux : non solar92 !! - emp : freshwater budget: volumeflux93 !! - emps : freshwater budget: concentration/dillution92 !! ** Outputs : - qsr : sea heat flux : solar 93 !! - qns : sea heat flux : non solar (including heat content of the mass flux) 94 !! - emp : freshwater budget: mass flux 95 !! - sfx : freshwater budget: salt flux due to Freezing/Melting 94 96 !! - utau : sea surface i-stress (ocean referential) 95 97 !! - vtau : sea surface j-stress (ocean referential) … … 107 109 INTEGER :: ifvt, i1mfr, idfr, iflt ! - - 108 110 INTEGER :: ial, iadv, ifral, ifrdv ! - - 109 REAL(wp) :: zqsr, zqns, zfm ! local scalars 110 REAL(wp) :: zinda, zfons, zemp ! - - 111 REAL(wp) :: zqsr, zqns, zfmm ! local scalars 112 REAL(wp) :: zinda, zfsalt, zemp ! - - 113 REAL(wp) :: zemp_snw, zqhc, zcd ! - - 114 REAL(wp) :: zswitch ! - - 111 115 REAL(wp), POINTER, DIMENSION(:,:) :: zqnsoce ! 2D workspace 112 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace … … 115 119 CALL wrk_alloc( jpi, jpj, zqnsoce ) 116 120 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 121 122 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 123 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only 124 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 125 ! (2) embedded sea-ice : salt and volume fluxes and pressure 126 END SELECT ! 117 127 118 128 !------------------------------------------! … … 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 ! = zinda if previous thermodynamic step overmelted the ice??? 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) ! ??? 182 ! 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) & 195 & + rdq_ice(ji,jj) * ( 1.- zswitch) ) * r1_rdtice ! heat flux due to snow ( & ice heat content, 196 ! ! if ice/ocean mass exchange active) 183 197 qsr (ji,jj) = zqsr ! solar heat flux 184 qns (ji,jj) = zqns - fdtcn(ji,jj) ! non solar heat flux 198 qns (ji,jj) = zqns - fdtcn(ji,jj) + zqhc ! non solar heat flux 199 ! 200 ! !------------------------------------------! 201 ! ! mass and salt flux at the ocean surface ! 202 ! !------------------------------------------! 203 ! 204 ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 205 #if defined key_coupled 206 ! ! coupled mode: 207 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 208 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice 209 #else 210 ! ! forced mode: 211 zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction 212 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean 213 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld) 214 #endif 215 ! 216 ! mass flux at the ocean/ice interface (sea ice fraction) 217 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean 218 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus Melting (F-M) 219 220 ! salt flux at the ice/ocean interface (sea ice fraction) [PSU*kg/m2/s] 221 zfsalt = - sice_0(ji,jj) * zfmm ! F-M salt exchange 222 zcd = soce_0(ji,jj) * zfmm ! concentration/dilution term due to F-M 223 ! 224 ! salt flux only : add concentration dilution term in salt flux and no F-M term in volume flux 225 ! salt and mass fluxes : non concentration dilution term in salt flux and add F-M term in volume flux 226 sfx (ji,jj) = zfsalt + zswitch * zcd ! salt flux (+ C/D if no ice/ocean mass exchange) 227 emp (ji,jj) = zemp + zemp_snw + ( 1.- zswitch) * zfmm ! mass flux (+ F/M mass flux if ice/ocean mass exchange) 228 ! 185 229 END DO 186 230 END DO 231 ! !------------------------------------------! 232 ! ! mass of snow and ice per unit area ! 233 ! !------------------------------------------! 234 IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required) 235 snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step 236 ! ! new mass per unit area 237 snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) ) 238 ! ! time evolution of snow+ice mass 239 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / rdt_ice 240 ENDIF 187 241 188 242 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) … … 190 244 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 191 245 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 246 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 )247 CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice ) 248 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 249 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 226 250 ENDIF 227 251 … … 243 267 IF(ln_ctl) THEN ! control print 244 268 CALL prt_ctl(tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ') 245 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2= emps , clinfo2=' emps: ')269 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ') 246 270 CALL prt_ctl(tab2d_1=utau , clinfo1=' lim_sbc: utau : ', mask1=umask, & 247 271 & tab2d_2=vtau , clinfo2=' vtau : ' , mask2=vmask ) … … 439 463 END WHERE 440 464 ENDIF 465 ! ! embedded sea ice 466 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 467 snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) ) 468 snwice_mass_b(:,:) = snwice_mass(:,:) 469 ELSE 470 snwice_mass (:,:) = 0.e0 ! no mass exchanges 471 snwice_mass_b(:,:) = 0.e0 ! no mass exchanges 472 ENDIF 473 IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart : 474 & .NOT.ln_rstart ) THEN ! deplete the initial ssh below sea-ice area 475 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 476 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 477 ENDIF 441 478 ! 442 479 END SUBROUTINE lim_sbc_init_2 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r3294 r3625 13 13 !! 'key_lim2' : LIM 2.0 sea-ice model 14 14 !!---------------------------------------------------------------------- 15 !! lim_thd_2 : thermodynamic of sea ice16 !! lim_thd_init_2 : initialisation of sea-ice thermodynamic15 !! lim_thd_2 : thermodynamic of sea ice 16 !! lim_thd_init_2 : initialisation of sea-ice thermodynamic 17 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constants19 USE dom_oce ! ocean space and time domain variables18 USE phycst ! physical constants 19 USE dom_oce ! ocean space and time domain variables 20 20 USE domvvl 21 21 USE lbclnk 22 USE in_out_manager ! I/O manager22 USE in_out_manager ! I/O manager 23 23 USE lib_mpp 24 USE wrk_nemo ! work arrays25 USE iom ! IOM library26 USE ice_2 ! LIM sea-ice variables27 USE sbc_oce !28 USE sbc_ice !29 USE thd_ice_2 ! LIM thermodynamic sea-ice variables30 USE dom_ice_2 ! LIM sea-ice domain24 USE wrk_nemo ! work arrays 25 USE iom ! IOM library 26 USE ice_2 ! LIM sea-ice variables 27 USE sbc_oce ! 28 USE sbc_ice ! 29 USE thd_ice_2 ! LIM thermodynamic sea-ice variables 30 USE dom_ice_2 ! LIM sea-ice domain 31 31 USE limthd_zdf_2 32 32 USE limthd_lac_2 33 33 USE limtab_2 34 USE prtctl ! Print control 35 USE cpl_oasis3, ONLY : lk_cpl 36 USE diaar5, ONLY : lk_diaar5 37 34 USE prtctl ! Print control 35 USE cpl_oasis3, ONLY : lk_cpl 36 USE diaar5 , ONLY : lk_diaar5 37 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 38 39 IMPLICIT NONE 39 40 PRIVATE … … 55 56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 57 !!---------------------------------------------------------------------- 57 58 58 CONTAINS 59 59 … … 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_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
r3294 r3625 7 7 8 8 !!---------------------------------------------------------------------- 9 !! lim_lat_acr_2 10 !!---------------------------------------------------------------------- 11 USE par_oce 9 !! lim_lat_acr_2 : lateral accretion of ice 10 !!---------------------------------------------------------------------- 11 USE par_oce ! ocean parameters 12 12 USE phycst 13 13 USE thd_ice_2 14 14 USE ice_2 15 15 USE limistate_2 16 USE lib_mpp ! MPP library 17 USE wrk_nemo ! work arrays 16 USE lib_mpp ! MPP library 17 USE wrk_nemo ! work arrays 18 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 18 19 19 20 IMPLICIT NONE … … 145 146 frld_1d (ji) = MAX( zfrlnew , zfrlmin(ji) ) 146 147 !--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 148 zdhicbot(ji) = ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) ) & 149 & - ( ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) ) * ( zqbgow(ji) / xlic ) 149 150 END DO 150 151 … … 196 197 & ) / zah 197 198 198 tbif_1d(ji,3) = ( iiceform * ( zhnews2 - zdh3 )* zta1 &199 tbif_1d(ji,3) = ( iiceform * ( zhnews2 - zdh3 ) * zta1 & 199 200 & + ( iiceform * zdh3 + ( 1 - iiceform ) * zdh1 ) * zta2 & 200 201 & + ( iiceform * ( zhnews2 - zdh5 ) + ( 1 - iiceform ) * ( zhnews2 - zdh1 ) ) * zta3 & … … 217 218 DO ji = kideb , kiut 218 219 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) 220 rdm_ice_1d(ji) = rdm_ice_1d(ji) + rhoic * dvlbq_1d(ji) 221 rdq_ice_1d(ji) = rdq_ice_1d(ji) + rcpic * dvlbq_1d(ji) * ( tfu_1d(ji) - rt0 ) ! heat content relative to rt0 220 222 END DO 221 223 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r3294 r3625 18 18 USE ice_2 19 19 USE limistate_2 20 USE cpl_oasis3, ONLY : lk_cpl 20 21 USE in_out_manager 21 22 USE lib_mpp ! MPP library 22 23 USE wrk_nemo ! work arrays 23 USE cpl_oasis3, ONLY : lk_cpl24 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 25 26 IMPLICIT NONE 26 27 PRIVATE … … 86 87 REAL(wp), POINTER, DIMENSION(:) :: zrcpdt ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 87 88 REAL(wp), POINTER, DIMENSION(:) :: zts_old ! previous surface temperature 88 REAL(wp), POINTER, DIMENSION(:) :: zidsn , z1midsn , zidsnic ! tempor y variables89 REAL(wp), POINTER, DIMENSION(:) :: zidsn , z1midsn , zidsnic ! temporary variables 89 90 REAL(wp), POINTER, DIMENSION(:) :: zfnet ! net heat flux at the top surface( incl. conductive heat flux) 90 91 REAL(wp), POINTER, DIMENSION(:) :: zsprecip ! snow accumulation … … 98 99 REAL(wp), POINTER, DIMENSION(:) :: zep ! internal temperature of the 2nd layer of the snow/ice system 99 100 REAL(wp), DIMENSION(3) :: & 100 zplediag & ! principle diagonal, subdiag. and supdiag. of the101 zplediag & ! principle diagonal, subdiag. and supdiag. of the 101 102 , zsubdiag & ! tri-diagonal matrix coming from the computation 102 103 , zsupdiag & ! of the temperatures inside the snow-ice system 103 104 , 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 & 105 REAL(wp) :: & 106 zhsu & ! thickness of surface layer 107 , zhe & ! effective thickness for compu. of equ. thermal conductivity 108 , zheshth & ! = zhe / thth 109 , zghe & ! correction factor of the thermal conductivity 110 , zumsb & ! parameter for numerical method to solve heat-diffusion eq. 111 , zkhsn & ! conductivity at the snow layer 112 , zkhic & ! conductivity at the ice layers 113 , zkint & ! equivalent conductivity at the snow-ice interface 114 , zkhsnint & ! = zkint*dt / (hsn*rhosn*cpsn) 115 , zkhicint & ! = 2*zkint*dt / (hic*rhoic*cpic) 116 , zpiv1, zpiv2 & ! temporary scalars used to solve the tri-diagonal system 117 , zb2, zd2 & ! temporary scalars used to solve the tri-diagonal system 118 , zb3, zd3 & ! temporary scalars used to solve the tri-diagonal system 117 119 , 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. increment120 REAL(wp) :: & 121 zexp & ! exponential function of the ice thickness 122 , zfsab & ! part of solar radiation stored in brine pockets 123 , zfts & ! value of energy balance function when the temp. equal surf. temp. 124 , zdfts & ! value of derivative of ztfs when the temp. equal surf. temp. 125 , zdts & ! surface temperature increment 126 , zqsnw_mlt & ! energy needed to melt snow 127 , zdhsmlt & ! change in snow thickness due to melt 128 , zhsn & ! snow thickness (previous+accumulation-melt) 129 , zqsn_mlt_rem & ! remaining heat coming from snow melting 130 , zqice_top_mlt &! energy used to melt ice at top surface 131 , zdhssub & ! change in snow thick. due to sublimation or evaporation 132 , zdhisub & ! change in ice thick. due to sublimation or evaporation 133 , zdhsn & ! snow ice thickness increment 134 , zdtsn & ! snow internal temp. increment 135 , zdtic & ! ice internal temp. increment 134 136 , 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 137 REAL(wp) :: & 138 ztbot & ! temperature at the bottom surface 139 , zfcbot & ! conductive heat flux at bottom surface 140 , zqice_bot & ! energy used for bottom melting/growing 141 , zqice_bot_mlt &! energy used for bottom melting 142 , zqstbif_bot & ! part of energy stored in brine pockets used for bottom melting 143 , zqstbif_old & ! temporary var. for zqstbif_bot 144 , zdhicmlt & ! change in ice thickness due to bottom melting 145 , zdhicm & ! change in ice thickness var. 146 , zdhsnm & ! change in snow thickness var. 147 , zhsnfi & ! snow thickness var. 148 , zc1, zpc1 & ! temporary variables 149 , zc2, zpc2 & ! temporary variables 150 , zp1, zp2 & ! temporary variables 151 , ztb2, ztb3 ! temporary variables 152 REAL(wp) :: & 153 zdrmh & ! change in snow/ice thick. after snow-ice formation 154 , zhicnew & ! new ice thickness 155 , zhsnnew & ! new snow thickness 156 , zquot & 157 , ztneq & ! temporary temp. variables 158 , zqice & 159 , zqicetot & ! total heat inside the snow/ice system 160 , zdfrl & ! change in ice concentration 161 , zdvsnvol & ! change in snow volume 162 , zdrfrl1, zdrfrl2, zihsn, zidhb, zihic & ! temporary scalars 163 , zihe, zihq, ziexp, ziqf, zihnf & ! temporary scalars 164 , zibmlt, ziqr, zihgnew, zind, ztmp ! temporary scalars 158 165 !!---------------------------------------------------------------------- 159 166 CALL wrk_alloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax ) … … 169 176 170 177 DO ji = kideb , kiut 178 ! do nothing if the snow (ice) thickness falls below its minimum thickness 171 179 zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) ) 172 180 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 181 !--energy required to bring snow to its melting point (rt0_snow) 182 zqcmlts(ji) = ( MAX ( zzero , rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 183 !--energy required to bring ice to its melting point (rt0_ice) 184 zqcmltb(ji) = ( MAX( zzero , rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 185 & + MAX( zzero , rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 186 & ) * ( 1.0 - zihic ) 187 !--limitation of snow/ice system internal temperature 183 188 tbif_1d(ji,1) = MIN( rt0_snow, tbif_1d(ji,1) ) 184 189 tbif_1d(ji,2) = MIN( rt0_ice , tbif_1d(ji,2) ) … … 480 485 dvsbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) ) 481 486 dvsbq_1d(ji) = MIN( zzero , dvsbq_1d(ji) ) 482 rdmsnif_1d(ji) = rhosn * dvsbq_1d(ji) 487 ztmp = rhosn * dvsbq_1d(ji) 488 rdm_snw_1d(ji) = ztmp 489 !--heat content of the water provided to the ocean (referenced to rt0) 490 rdq_snw_1d(ji) = cpic * ztmp * ( rt0_snow - rt0 ) 483 491 !-- If the snow is completely melted the remaining heat is used to melt ice 484 492 zqsn_mlt_rem = MAX( zzero , -zhsn ) * xlsn … … 623 631 !---updating new ice thickness and computing the newly formed ice mass 624 632 zhicnew = zihgnew * zhicnew 625 rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic 633 ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic 634 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 635 !---heat content of the water provided to the ocean (referenced to rt0) 636 ! use of rt0_ice is OK for melting ice; in the case of freezing, tfu_1d should be used. 637 ! This is done in 9.5 section (see below) 638 rdq_ice_1d(ji) = cpic * ztmp * ( rt0_ice - rt0 ) 626 639 !---updating new snow thickness and computing the newly formed snow mass 627 640 zhsnfi = zhsn + zdhsnm 628 641 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 642 ztmp = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn 643 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 644 !---updating the heat content of the water provided to the ocean (referenced to rt0) 645 rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 ) 630 646 !--remaining energy in case of total ablation 631 647 zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) ) … … 659 675 tbif_1d(ji,3) = zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji) 660 676 h_ice_1d(ji) = zhicnew 677 ! update the ice heat content given to the ocean in freezing case 678 ! (part due to difference between rt0_ice and tfu_1d) 679 ztmp = ( 1. - zidhb ) * rhoic * dvbbq_1d(ji) 680 rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0_ice ) 661 681 END DO 662 682 … … 700 720 dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn 701 721 !--- 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 722 ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d (ji) ) * rhoic 723 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 724 rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0 ) 725 !!gm BUG ?? snow ==> only needed for nn_ice_embd == 0 (standard levitating sea-ice) 726 ztmp = ( 1.0 - frld_1d(ji) ) * ( zhsnnew - h_snow_1d(ji) ) * rhosn 727 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 728 rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 ) 704 729 705 730 !--- Actualize new snow and ice thickness. … … 748 773 !--variation of ice volume and ice mass 749 774 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 775 ztmp = dvlbq_1d(ji) * rhoic 776 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 777 !!gm 778 !!gm This should be split in two parts: 779 !!gm 1- heat required to bring sea-ice to tfu : this part should be added to the heat flux taken from the ocean 780 !!gm cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0_ice ) 781 !!gm 2- heat content of lateral ablation referenced to rt0 : this part only put in rdq_ice_1d 782 !!gm cpic * ztmp * ( rt0_ice - rt0 ) 783 !!gm Currently we put all the heat in rdq_ice_1d 784 rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0 ) 785 ! 751 786 !--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 787 zdvsnvol = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji) 788 ztmp = zdvsnvol * rhosn 789 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 790 !!gm 791 !!gm This should be split in two parts: 792 !!gm 1- heat required to bring snow to tfu : this part should be added to the heat flux taken from the ocean 793 !!gm cpic * ztmp * ( tbif_1d(ji,1) - rt0_snow ) 794 !!gm 2- heat content of lateral ablation referenced to rt0 : this part only put in rdq_snw_1d 795 !!gm cpic * ztmp * ( rt0_snow - rt0 ) 796 !!gm Currently we put all the heat in rdq_snw_1d 797 rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( tbif_1d(ji,1) - rt0 ) 798 754 799 h_snow_1d(ji) = ziqf * h_snow_1d(ji) 755 800 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r3294 r3625 13 13 !!---------------------------------------------------------------------- 14 14 !!---------------------------------------------------------------------- 15 !! lim_wri_2 : write of the diagnostics variables in ouput file16 !! lim_wri_init_2 : initialization and namelist read15 !! lim_wri_2 : write of the diagnostics variables in ouput file 16 !! lim_wri_init_2 : initialization and namelist read 17 17 !! lim_wri_state_2 : write for initial state or/and abandon: 18 18 !! > output.init.nc (if ninist = 1 in namelist) … … 26 26 USE ice_2 27 27 28 USE dianam ! build name of file (routine)28 USE dianam ! build name of file (routine) 29 29 USE lbclnk 30 30 USE in_out_manager 31 USE lib_mpp ! MPP library32 USE wrk_nemo ! work arrays31 USE lib_mpp ! MPP library 32 USE wrk_nemo ! work arrays 33 33 USE iom 34 34 USE ioipsl 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 35 36 36 37 IMPLICIT NONE … … 173 174 zcmo(ji,jj,13) = qns(ji,jj) 174 175 ! See thersf for the coefficient 175 zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce !!gm ???176 zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce !!gm ??? 176 177 zcmo(ji,jj,15) = utau_ice(ji,jj) 177 178 zcmo(ji,jj,16) = vtau_ice(ji,jj) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r3294 r3625 118 118 zcmo(ji,jj,13) = qns(ji,jj) 119 119 ! See thersf for the coefficient 120 zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce120 zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 121 121 zcmo(ji,jj,15) = utau_ice(ji,jj) 122 122 zcmo(ji,jj,16) = vtau_ice(ji,jj) … … 161 161 rcmoy(ji,jj,13) = qns(ji,jj) 162 162 ! See thersf for the coefficient 163 rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce163 rcmoy(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 164 164 rcmoy(ji,jj,15) = utau_ice(ji,jj) 165 165 rcmoy(ji,jj,16) = vtau_ice(ji,jj) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
r2715 r3625 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_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
r2777 r3625 9 9 USE par_ice ! LIM-3 parameter 10 10 USE in_out_manager ! I/O manager 11 USE lib_mpp ! MPP library 11 USE lib_mpp ! MPP library 12 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 12 13 13 14 IMPLICIT NONE … … 30 31 31 32 !!---------------------------------------------------------------------- 32 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)33 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 33 34 !! $Id$ 34 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r2777 r3625 9 9 #if defined key_lim3 10 10 !!---------------------------------------------------------------------- 11 !! 'key_lim3' : LIM3 sea-ice model12 !!---------------------------------------------------------------------- 13 USE par_ice 14 USE in_out_manager 15 USE lib_mpp 11 !! 'key_lim3' LIM-3 sea-ice model 12 !!---------------------------------------------------------------------- 13 USE par_ice ! LIM sea-ice parameters 14 USE in_out_manager ! I/O manager 15 USE lib_mpp ! MPP library 16 16 17 17 IMPLICIT NONE … … 158 158 !! * Share Module variables 159 159 !!-------------------------------------------------------------------------- 160 INTEGER , PUBLIC :: nstart !: iteration number of the begining of the run 161 INTEGER , PUBLIC :: nlast !: iteration number of the end of the run 162 INTEGER , PUBLIC :: nitrun !: number of iteration 163 INTEGER , PUBLIC :: numit !: iteration number 164 REAL(wp), PUBLIC :: rdt_ice !: ice time step 160 INTEGER , PUBLIC :: nstart !: iteration number of the begining of the run 161 INTEGER , PUBLIC :: nlast !: iteration number of the end of the run 162 INTEGER , PUBLIC :: nitrun !: number of iteration 163 INTEGER , PUBLIC :: numit !: iteration number 164 REAL(wp), PUBLIC :: rdt_ice !: ice time step 165 REAL(wp), PUBLIC :: r1_rdtice !: = 1. / rdt_ice 165 166 166 167 ! !!** ice-dynamic namelist (namicedyn) ** … … 201 202 ! !!** ice-salinity namelist (namicesal) ** 202 203 INTEGER , PUBLIC :: num_sal = 1 !: salinity configuration used in the model 203 ! ! 1 - s constant inspace and time204 ! ! 1 - constant salinity in both space and time 204 205 ! ! 2 - prognostic salinity (s(z,t)) 205 206 ! ! 3 - salinity profile, constant in time 206 ! ! 4 - salinity variations affect only ice thermodynamics207 207 INTEGER , PUBLIC :: sal_prof = 1 !: salinity profile or not 208 208 INTEGER , PUBLIC :: thcon_i_swi = 1 !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) … … 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 … … 276 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qfvbq !: store energy in case of total lateral ablation (?) 277 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dmgwi !: Variation of the mass of snow ice 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsalt_res !: Residual salt flux due to correction of ice thickness279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsbri !: Salt flux due to brine rejection280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsalt_rpo !: Salt flux associated with porous ridged ice formation281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_rpo !: Heat flux associated with porous ridged ice formation280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_thd !: salt flux due to ice growth/melt [PSU/m2/s] 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [PSU/m2/s] 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_mec !: salt flux due to porous ridged ice formation [PSU/m2/s] 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: residual salt flux due to correction of ice thickness [PSU/m2/s] 282 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhbri !: heat flux due to brine rejection 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f mmec !: Mass flux due to snow loss during compression284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f seqv !: Equivalent salt flux due to ice growth/melt285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f hmec !: Heat flux due to snow loss during compression286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fh eat_res !: Residual heat flux due to correction of ice thickness285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_mec !: heat flux associated with porous ridged ice formation [???] 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_res !: residual heat flux due to correction of ice thickness 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmec !: mass flux due to snow loss during compression [Kg/m2/s] 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhmec !: heat flux due to snow loss during compression 287 289 288 290 ! temporary arrays for dummy version of the code … … 415 417 416 418 !!---------------------------------------------------------------------- 417 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2010)419 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 418 420 !! $Id$ 419 421 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 444 446 445 447 ii = ii + 1 446 ALLOCATE( firic (jpi,jpj) , fcsic (jpi,jpj) , fleic (jpi,jpj) , qlatic (jpi,jpj) , & 447 & rdvosif (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif (jpi,jpj) , rdvonif (jpi,jpj) , & 448 & sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , hicifp (jpi,jpj) , & 449 & 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) , & 451 & fdtcn (jpi,jpj) , qdtcn (jpi,jpj) , fstric (jpi,jpj) , fscmbq (jpi,jpj) , & 452 & ffltbif (jpi,jpj) , fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) , & 453 & fsalt_res(jpi,jpj) , fsbri (jpi,jpj) , fsalt_rpo(jpi,jpj) , fheat_rpo(jpi,jpj) , & 454 & fhbri (jpi,jpj) , fmmec (jpi,jpj) , fseqv (jpi,jpj) , fhmec (jpi,jpj) , & 455 & fheat_res(jpi,jpj) , STAT=ierr(ii) ) 448 ALLOCATE( firic (jpi,jpj) , fcsic (jpi,jpj) , fleic (jpi,jpj) , qlatic (jpi,jpj) , & 449 & rdvosif (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif (jpi,jpj) , & 450 & sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , hicifp (jpi,jpj) , & 451 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , fbif (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) , & 454 & fdtcn (jpi,jpj) , qdtcn (jpi,jpj) , fstric (jpi,jpj) , fscmbq (jpi,jpj) , & 455 & ffltbif (jpi,jpj) , fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) , & 456 & sfx_res (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) , & 457 & fhbri (jpi,jpj) , fmmec (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec (jpi,jpj) , & 458 & fheat_res(jpi,jpj) , STAT=ierr(ii) ) 456 459 457 460 ii = ii + 1 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r3294 r3625 10 10 #if defined key_lim3 11 11 !!---------------------------------------------------------------------- 12 !! 'key_lim3' : LIM sea-ice model 13 !!---------------------------------------------------------------------- 14 !! ice_init : sea-ice model initialization 15 !!---------------------------------------------------------------------- 16 USE phycst ! physical constants 17 USE dom_oce ! ocean domain 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbc_ice ! Surface boundary condition: ice fields 20 USE ice ! LIM variables 21 USE par_ice ! LIM parameters 22 USE dom_ice ! LIM domain 23 USE thd_ice ! LIM thermodynamical variables 24 USE limitd_me ! LIM ice thickness distribution 25 USE limmsh ! LIM mesh 26 USE limistate ! LIM initial state 27 USE limrst ! LIM restart 28 USE limthd ! LIM ice thermodynamics 29 USE limthd_sal ! LIM ice thermodynamics: salinity 30 USE limvar ! LIM variables 31 USE limsbc ! LIM surface boundary condition 32 USE in_out_manager ! I/O manager 33 USE lib_mpp ! MPP library 12 !! 'key_lim3' LIM sea-ice model 13 !!---------------------------------------------------------------------- 14 !! ice_init : sea-ice model initialization 15 !!---------------------------------------------------------------------- 16 USE phycst ! physical constants 17 USE dom_oce ! ocean domain 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbc_ice ! Surface boundary condition: ice fields 20 USE ice ! LIM variables 21 USE par_ice ! LIM parameters 22 USE dom_ice ! LIM domain 23 USE thd_ice ! LIM thermodynamical variables 24 USE limitd_me ! LIM ice thickness distribution 25 USE limmsh ! LIM mesh 26 USE limistate ! LIM initial state 27 USE limrst ! LIM restart 28 USE limthd ! LIM ice thermodynamics 29 USE limthd_sal ! LIM ice thermodynamics: salinity 30 USE limvar ! LIM variables 31 USE limsbc ! LIM surface boundary condition 32 USE in_out_manager ! I/O manager 33 USE lib_mpp ! MPP library 34 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 34 35 35 36 IMPLICIT NONE … … 39 40 40 41 !!---------------------------------------------------------------------- 41 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)42 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 42 43 !! $Id$ 43 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 79 80 CALL lim_thd_sal_init ! set ice salinity parameters 80 81 ! 81 rdt_ice = nn_fsbc * rdttra(1) ! sea-ice timestep 82 rdt_ice = nn_fsbc * rdttra(1) ! sea-ice timestep 83 r1_rdtice = 1._wp / rdt_ice ! sea-ice timestep inverse 82 84 ! 83 85 CALL lim_msh ! ice mesh initialization -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r3294 r3625 15 15 !! lim_adv_y : advection of sea ice on y axis 16 16 !!---------------------------------------------------------------------- 17 USE dom_oce ! ocean domain 18 USE dom_ice ! LIM-3 domain 19 USE ice ! LIM-3 variables 20 USE lbclnk ! lateral boundary condition - MPP exchanges 21 USE in_out_manager ! I/O manager 22 USE prtctl ! Print control 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays 17 USE dom_oce ! ocean domain 18 USE ice ! LIM-3 variables 19 USE dom_ice ! LIM-3 domain 20 USE lbclnk ! lateral boundary condition - MPP exchanges 21 USE in_out_manager ! I/O manager 22 USE prtctl ! Print control 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 26 26 27 IMPLICIT NONE … … 37 38 # include "vectopt_loop_substitute.h90" 38 39 !!---------------------------------------------------------------------- 39 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)40 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 40 41 !! $Id$ 41 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 88 89 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 89 90 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) ) 90 zin0 = ( 1.0 - MAX( rzero, sign( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask91 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 91 92 92 93 ps0 (ji,jj) = zslpmax … … 273 274 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 274 275 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 275 zin0 = ( 1.0 - MAX( rzero, sign( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask276 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 276 277 ! 277 278 ps0 (ji,jj) = zslpmax -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r2777 r3625 10 10 #if defined key_lim3 11 11 !!---------------------------------------------------------------------- 12 !! 'key_lim3' : LIM3 sea-ice model12 !! 'key_lim3' LIM-3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! lim_cons : checks whether energy, mass and salt are conserved14 !! lim_cons : checks whether energy, mass and salt are conserved 15 15 !!---------------------------------------------------------------------- 16 USE par_ice ! LIM-3 parameter 17 USE ice ! LIM-3 variables 18 USE dom_ice ! LIM-3 domain 19 USE dom_oce ! ocean domain 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! MPP library 16 USE par_ice ! LIM-3 parameter 17 USE ice ! LIM-3 variables 18 USE dom_ice ! LIM-3 domain 19 USE dom_oce ! ocean domain 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! MPP library 22 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 22 23 23 24 IMPLICIT NONE … … 29 30 30 31 !!---------------------------------------------------------------------- 31 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)32 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 32 33 !! $Id$ 33 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90
r2715 r3625 11 11 !! 'key_lim3' LIM3 sea-ice model 12 12 !!---------------------------------------------------------------------- 13 !! lim_dia : computation and output of the time evolution of keys variables 14 !! lim_dia_init : initialization and namelist read 15 !!---------------------------------------------------------------------- 16 USE ice ! LIM-3: sea-ice variable 17 USE par_ice ! LIM-3: ice parameters 18 USE dom_ice ! LIM-3: sea-ice domain 19 USE dom_oce ! ocean domain 20 USE sbc_oce ! surface boundary condition: ocean fields 21 USE daymod ! model calendar 22 USE phycst ! physical constant 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 13 !! lim_dia : computation and output of the time evolution of keys variables 14 !! lim_dia_init : initialization and namelist read 15 !!---------------------------------------------------------------------- 16 USE ice ! LIM-3: sea-ice variable 17 USE par_ice ! LIM-3: ice parameters 18 USE dom_ice ! LIM-3: sea-ice domain 19 USE dom_oce ! ocean domain 20 USE sbc_oce ! surface boundary condition: ocean fields 21 USE daymod ! model calendar 22 USE phycst ! physical constant 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 26 27 IMPLICIT NONE 27 28 PRIVATE … … 70 71 !! the temporal evolution of some key variables 71 72 !!------------------------------------------------------------------- 72 INTEGER :: jv, ji, jj, jl ! dummy loop indices 73 REAL(wp) :: zshift_date ! date from the minimum ice extent 74 REAL(wp) :: zday, zday_min ! current day, day of minimum extent 75 REAL(wp) :: zafy, zamy ! temporary area of fy and my ice 73 INTEGER :: jv, ji, jj, jl ! dummy loop indices 74 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integer 75 REAL(wp) :: zshift_date ! date from the minimum ice extent 76 REAL(wp) :: zday, zday_min ! current day, day of minimum extent 77 REAL(wp) :: zafy, zamy ! temporary area of fy and my ice 76 78 REAL(wp) :: zindb 77 REAL(wp), DIMENSION(jpinfmx) :: vinfor ! temporary workingspace79 REAL(wp), DIMENSION(jpinfmx) :: vinfor ! 1D workspace 78 80 !!------------------------------------------------------------------- 79 81 … … 105 107 IF( tms(ji,jj) == 1 ) THEN 106 108 vinfor(3) = vinfor(3) + at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice area 107 IF ( at_i(ji,jj).GT.0.15)vinfor(5) = vinfor(5) + aire(ji,jj) * 1.e-12_wp !ice extent109 IF ( at_i(ji,jj) > 0.15 ) vinfor(5) = vinfor(5) + aire(ji,jj) * 1.e-12_wp !ice extent 108 110 vinfor(7) = vinfor(7) + vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice volume 109 111 vinfor(9) = vinfor(9) + vt_s(ji,jj)*aire(ji,jj) * 1.e-12_wp !snow volume … … 111 113 vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean salinity 112 114 ! the computation of this diagnostic is not reliable 113 vinfor(31) = vinfor(31) + vt_i(ji,jj) *( u_ice(ji,jj)*u_ice(ji,jj) +&114 v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12115 vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) * 1.e-12_wp !salt flux116 vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp !brine drainage flux117 vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp !equivalent salt flux115 vinfor(31) = vinfor(31) + vt_i(ji,jj) * ( u_ice(ji,jj)*u_ice(ji,jj) & 116 & + v_ice(ji,jj)*v_ice(ji,jj) ) * aire(ji,jj) * 1.e-12 117 vinfor(53) = vinfor(53) + sfx (ji,jj)*aire(ji,jj) * 1.e-12_wp !salt flux 118 vinfor(55) = vinfor(55) + sfx_bri(ji,jj)*aire(ji,jj) * 1.e-12_wp !brine drainage flux 119 vinfor(57) = vinfor(57) + sfx_thd(ji,jj)*aire(ji,jj) * 1.e-12_wp !equivalent salt flux 118 120 vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !SST 119 121 vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !SSS … … 180 182 vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 181 183 vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp 182 vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice! volume acc in OW184 vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp * r1_rdtice ! volume acc in OW 183 185 ENDIF 184 186 END DO … … 231 233 vinfor(51) = zindb*vinfor(51) / MAX(vinfor(27),epsi06) 232 234 233 !! Fram Strait Export 234 !! 83 = area export 235 !! 84 = volume export 236 !! Fram strait in ORCA2 = 5 points 237 !! export = -v_ice*e1t*ddtb*at_i or -v_ice*e1t*ddtb*at_i*h_i 238 jj = 136 ! C grid 239 vinfor(83) = 0.0 240 vinfor(84) = 0.0 241 DO ji = 134, 138 242 vinfor(83) = vinfor(83) - v_ice(ji,jj) * & 243 e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp 244 vinfor(84) = vinfor(84) - v_ice(ji,jj) * & 245 e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp 246 END DO 235 IF( cp_cfg == "orca" ) THEN !* ORCA configuration : Fram Strait Export 236 SELECT CASE ( jp_cfg ) 237 CASE ( 2 ) ! ORCA_R2 238 ij0 = 136 ; ij1 = 136 ! Fram strait : 83 = area export 239 ii0 = 134 ; ii1 = 138 ! 84 = volume export 240 DO jj = mj0(ij0),mj1(ij1) 241 DO ji = mi0(ii0),mi1(ii1) 242 vinfor(83) = vinfor(83) - v_ice(ji,jj) * e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp 243 vinfor(84) = vinfor(84) - v_ice(ji,jj) * e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp 244 END DO 245 END DO 246 END SELECT 247 !!gm just above, this is NOT the correct way of evaluating the transport ! 248 !!gm mass of snow is missing and v_ice should be the mean between jj and jj+1 249 !!gm Other ORCA configurations should be added 250 ENDIF 247 251 248 252 !!------------------------------------------------------------------- … … 264 268 vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 265 269 v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 266 vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Total salt flux267 vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Brine drainage salt flux268 vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Equivalent salt flux270 vinfor(54) = vinfor(54) + sfx (ji,jj)*aire(ji,jj) * 1.e-12_wp ! Total salt flux 271 vinfor(56) = vinfor(56) + sfx_bri(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Brine drainage salt flux 272 vinfor(58) = vinfor(58) + sfx_thd(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Equivalent salt flux 269 273 vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !SST 270 274 vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !SSS … … 331 335 vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 332 336 vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp 333 vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice! volume acc in OW337 vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp * r1_rdtice ! volume acc in OW 334 338 ENDIF 335 339 END DO … … 345 349 END DO 346 350 END DO 347 zindb = 1. 0 - MAX(0.0,SIGN(1.0,-vinfor(4)))!348 vinfor(64) = zindb * vinfor(64) / MAX( vinfor(4),epsi06)! divide by ice extt351 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -vinfor(4) ) ) ! 352 vinfor(64) = zindb * vinfor(64) / MAX( vinfor(4) , epsi06 ) ! divide by ice extt 349 353 !! 2.2) Diagnostics dependent on age 350 354 !!------------------------------------ … … 368 372 ENDIF 369 373 END DO ! jl 370 IF ( (at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN374 IF ( at_i(ji,jj) > 0.15 .AND. zafy > zamy ) THEN 371 375 vinfor(22) = vinfor(22) + aire(ji,jj) * 1.e-12_wp ! Seasonal ice extent 372 376 ENDIF 373 IF ( (at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN377 IF ( at_i(ji,jj) > 0.15 .AND. zafy <= zamy ) THEN 374 378 vinfor(24) = vinfor(24) + aire(ji,jj) * 1.e-12_wp ! Perennial ice extent 375 379 ENDIF … … 377 381 END DO ! jj 378 382 END DO ! ji 379 zindb = 1.0 - MAX( 0.0,SIGN(1.0,-vinfor(26)))!=0 if no multiyear ice 1 if yes380 vinfor(50) = zindb *vinfor(50) / MAX(vinfor(26),epsi06)381 zindb = 1.0 - MAX( 0.0,SIGN(1.0,-vinfor(28))) !=0 if no multiyear ice 1 if yes382 vinfor(52) = zindb *vinfor(52) / MAX(vinfor(28),epsi06)383 zindb = 1.0 - MAX( 0.0,SIGN( 1._wp , -vinfor(26) ) ) !=0 if no multiyear ice 1 if yes 384 vinfor(50) = zindb * vinfor(50) / MAX( vinfor(26) , epsi06 ) 385 zindb = 1.0 - MAX( 0._wp , SIGN( 1._wp , -vinfor(28) ) ) !=0 if no multiyear ice 1 if yes 386 vinfor(52) = zindb * vinfor(52) / MAX( vinfor(28) , epsi06 ) 383 387 384 388 ! Accumulation before averaging -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r3294 r3625 15 15 !! lim_dyn_init : initialization and namelist read 16 16 !!---------------------------------------------------------------------- 17 USE phycst ! physical constants 18 USE dom_oce ! ocean space and time domain 19 USE sbc_oce ! Surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: ice fields 21 USE ice ! LIM-3 variables 22 USE par_ice ! LIM-3 parameters 23 USE dom_ice ! LIM-3 domain 24 USE limrhg ! LIM-3 rheology 25 USE lbclnk ! lateral boundary conditions - MPP exchanges 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays 28 USE in_out_manager ! I/O manager 29 USE prtctl ! Print control 17 USE phycst ! physical constants 18 USE dom_oce ! ocean space and time domain 19 USE sbc_oce ! Surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: ice fields 21 USE ice ! LIM-3 variables 22 USE par_ice ! LIM-3 parameters 23 USE dom_ice ! LIM-3 domain 24 USE limrhg ! LIM-3 rheology 25 USE lbclnk ! lateral boundary conditions - MPP exchanges 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays 28 USE in_out_manager ! I/O manager 29 USE prtctl ! Print control 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 31 31 32 IMPLICIT NONE … … 37 38 # include "vectopt_loop_substitute.h90" 38 39 !!---------------------------------------------------------------------- 39 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)40 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 40 41 !! $Id$ 41 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r3294 r3625 12 12 !! 'key_lim3' LIM3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! lim_hdf : diffusion trend on sea-ice variable14 !! lim_hdf : diffusion trend on sea-ice variable 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce ! ocean domain 17 USE ice ! LIM-3: ice variables 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! work arrays 21 USE prtctl ! Print control 22 USE in_out_manager ! I/O manager 16 USE dom_oce ! ocean domain 17 USE ice ! LIM-3: ice variables 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! work arrays 21 USE prtctl ! Print control 22 USE in_out_manager ! I/O manager 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 23 24 24 25 IMPLICIT NONE … … 34 35 # include "vectopt_loop_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2010)37 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 37 38 !! $Id$ 38 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r3610 r3625 26 26 USE lib_mpp ! MPP library 27 27 USE wrk_nemo ! work arrays 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 29 29 30 IMPLICIT NONE … … 48 49 49 50 !!---------------------------------------------------------------------- 50 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)51 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 51 52 !! $Id$ 52 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r3294 r3625 10 10 #if defined key_lim3 11 11 !!---------------------------------------------------------------------- 12 !! 'key_lim3' : LIM3 sea-ice model12 !! 'key_lim3' LIM-3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 USE par_oce ! ocean parameters 15 USE dom_oce ! ocean domain 16 USE phycst ! physical constants (ocean directory) 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE thd_ice ! LIM thermodynamics 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters 21 USE dom_ice ! LIM domain 22 USE limthd_lac ! LIM 23 USE limvar ! LIM 24 USE limcons ! LIM 25 USE in_out_manager ! I/O manager 26 USE lbclnk ! lateral boundary condition - MPP exchanges 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! work arrays 29 USE prtctl ! Print control 14 USE par_oce ! ocean parameters 15 USE dom_oce ! ocean domain 16 USE phycst ! physical constants (ocean directory) 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE thd_ice ! LIM thermodynamics 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters 21 USE dom_ice ! LIM domain 22 USE limthd_lac ! LIM 23 USE limvar ! LIM 24 USE limcons ! LIM 25 USE in_out_manager ! I/O manager 26 USE lbclnk ! lateral boundary condition - MPP exchanges 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! work arrays 29 USE prtctl ! Print control 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 31 31 32 IMPLICIT NONE … … 38 39 PUBLIC lim_itd_me_alloc ! called by iceini.F90 39 40 40 REAL(wp) 41 REAL(wp) 42 REAL(wp) 41 REAL(wp) :: epsi11 = 1.e-11_wp ! constant values 42 REAL(wp) :: epsi10 = 1.e-10_wp ! constant values 43 REAL(wp) :: epsi06 = 1.e-06_wp ! constant values 43 44 44 45 !----------------------------------------------------------------------- … … 47 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: asum ! sum of total ice and open water area 48 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: aksum ! ratio of area removed to area ridged 49 50 ! 50 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: athorn ! participation function; fraction of ridging/ 51 52 ! ! closing associated w/ category n 52 53 ! 53 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmin ! minimum ridge thickness 54 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmax ! maximum ridge thickness … … 70 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dvirdgdt ! rate of ice volume ridged (m/s) 71 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: opening ! rate of opening due to divergence/shear (1/s) 73 ! 72 74 !!---------------------------------------------------------------------- 73 75 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) … … 126 128 INTEGER :: ji, jj, jk, jl ! dummy loop index 127 129 INTEGER :: niter, nitermax = 20 ! local integer 128 LOGICAL :: asum_error 129 INTEGER :: iterate_ridging 130 REAL(wp) :: w1, tmpfac , dti! local scalar130 LOGICAL :: asum_error ! flag for asum .ne. 1 131 INTEGER :: iterate_ridging ! if true, repeat the ridging 132 REAL(wp) :: w1, tmpfac ! local scalar 131 133 CHARACTER (len = 15) :: fieldid 132 134 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s) … … 152 154 ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 153 155 !-----------------------------------------------------------------------------! 154 ! Set hi_max(ncat) to a big value to ensure that all ridged ice 155 ! is thinner than hi_max(ncat). 156 ! Set hi_max(ncat) to a big value to ensure that all ridged ice is thinner than hi_max(ncat). 156 157 157 158 hi_max(jpl) = 999.99 158 159 159 Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0 ! proport const for PE 160 CALL lim_itd_me_ridgeprep ! prepare ridging 161 160 Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0 ! proport const for PE 161 ! 162 CALL lim_itd_me_ridgeprep ! prepare ridging 163 ! 162 164 IF( con_i) CALL lim_column_sum( jpl, v_i, vt_i_init ) ! conservation check 163 165 … … 166 168 msnow_mlt(ji,jj) = 0._wp 167 169 esnow_mlt(ji,jj) = 0._wp 168 dardg1dt (ji,jj) 169 dardg2dt (ji,jj) 170 dvirdgdt (ji,jj) 171 opening (ji,jj) 170 dardg1dt (ji,jj) = 0._wp 171 dardg2dt (ji,jj) = 0._wp 172 dvirdgdt (ji,jj) = 0._wp 173 opening (ji,jj) = 0._wp 172 174 173 175 !-----------------------------------------------------------------------------! … … 201 203 ! to give asum = 1.0 after ridging. 202 204 203 divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) / rdt_ice ! asum found in ridgeprep205 divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice ! asum found in ridgeprep 204 206 205 207 IF( divu_adv(ji,jj) < 0._wp ) closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) ) … … 207 209 ! 2.3 opning 208 210 !------------ 209 ! Compute the (non-negative) opening rate that will give 210 ! asum = 1.0 after ridging. 211 ! Compute the (non-negative) opening rate that will give asum = 1.0 after ridging. 211 212 opning(ji,jj) = closing_net(ji,jj) + divu_adv(ji,jj) 212 213 END DO … … 257 258 IF ( a_i(ji,jj,jl) > epsi11 .AND. athorn(ji,jj,jl) > 0._wp )THEN 258 259 w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 259 IF ( w1 >a_i(ji,jj,jl) ) THEN260 IF ( w1 > a_i(ji,jj,jl) ) THEN 260 261 tmpfac = a_i(ji,jj,jl) / w1 261 262 closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac … … 291 292 ELSE 292 293 iterate_ridging = 1 293 divu_adv (ji,jj) = (1._wp - asum(ji,jj)) / rdt_ice294 divu_adv (ji,jj) = (1._wp - asum(ji,jj)) * r1_rdtice 294 295 closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) ) 295 296 opning (ji,jj) = MAX( 0._wp, divu_adv(ji,jj) ) … … 308 309 309 310 IF( iterate_ridging == 1 ) THEN 310 IF( niter .GT.nitermax ) THEN311 IF( niter > nitermax ) THEN 311 312 WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 312 313 WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging … … 323 324 ! Update fresh water and heat fluxes due to snow melt. 324 325 325 dti = 1._wp / rdt_ice326 327 326 asum_error = .false. 328 327 … … 330 329 DO ji = 1, jpi 331 330 332 IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11)asum_error = .true.333 334 dardg1dt(ji,jj) = dardg1dt(ji,jj) * dti335 dardg2dt(ji,jj) = dardg2dt(ji,jj) * dti336 dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * dti337 opening (ji,jj) = opening (ji,jj) * dti331 IF( ABS( asum(ji,jj) - 1.0 ) > epsi11 ) asum_error = .true. 332 333 dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice 334 dardg2dt(ji,jj) = dardg2dt(ji,jj) * r1_rdtice 335 dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * r1_rdtice 336 opening (ji,jj) = opening (ji,jj) * r1_rdtice 338 337 339 338 !-----------------------------------------------------------------------------! 340 339 ! 5) Heat, salt and freshwater fluxes 341 340 !-----------------------------------------------------------------------------! 342 fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * dti! fresh water source for ocean343 fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * dti! heat sink for ocean341 fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean 342 fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice ! heat sink for ocean 344 343 345 344 END DO … … 349 348 DO jj = 1, jpj 350 349 DO ji = 1, jpi 351 IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) THEN! there is a bug350 IF( ABS( asum(ji,jj) - 1._wp ) > epsi11 ) THEN ! there is a bug 352 351 WRITE(numout,*) ' ' 353 352 WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) … … 391 390 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 392 391 d_smv_i_trp(:,:,:) = 0._wp 393 IF( num_sal == 2 .OR. num_sal == 4) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)392 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 394 393 395 394 IF(ln_ctl) THEN ! Control print … … 430 429 431 430 ! update of fields will be made later in lim update 432 u_ice(:,:) 433 v_ice(:,:) 434 a_i(:,:,:) 435 v_s(:,:,:) 436 v_i(:,:,:) 437 e_s(:,:,:,:) 438 e_i(:,:,:,:) 439 oa_i(:,:,:) 440 IF( num_sal == 2 .OR. num_sal == 4 ) smv_i(:,:,:)= old_smv_i(:,:,:)431 u_ice(:,:) = old_u_ice(:,:) 432 v_ice(:,:) = old_v_ice(:,:) 433 a_i(:,:,:) = old_a_i(:,:,:) 434 v_s(:,:,:) = old_v_s(:,:,:) 435 v_i(:,:,:) = old_v_i(:,:,:) 436 e_s(:,:,:,:) = old_e_s(:,:,:,:) 437 e_i(:,:,:,:) = old_e_i(:,:,:,:) 438 oa_i(:,:,:) = old_oa_i(:,:,:) 439 IF( num_sal == 2 ) smv_i(:,:,:) = old_smv_i(:,:,:) 441 440 442 441 !----------------------------------------------------! … … 465 464 DO jj = 1, jpj 466 465 DO ji = 1, jpi 467 IF ( ( old_v_i(ji,jj,jl) < epsi06 ).AND. &468 ( d_v_i_trp(ji,jj,jl) > epsi06 )) THEN469 old_v_i (ji,jj,jl)= d_v_i_trp(ji,jj,jl)470 d_v_i_trp (ji,jj,jl) = 0._wp471 old_a_i (ji,jj,jl)= d_a_i_trp(ji,jj,jl)472 d_a_i_trp (ji,jj,jl) = 0._wp473 old_v_s (ji,jj,jl)= d_v_s_trp(ji,jj,jl)474 d_v_s_trp (ji,jj,jl) = 0._wp475 old_e_s (ji,jj,1,jl)= d_e_s_trp(ji,jj,1,jl)476 d_e_s_trp (ji,jj,1,jl) = 0._wp477 old_oa_i (ji,jj,jl)= d_oa_i_trp(ji,jj,jl)478 d_oa_i_trp(ji,jj,jl) = 0._wp479 IF( num_sal == 2 .OR. num_sal == 4 ) old_smv_i(ji,jj,jl)= d_smv_i_trp(ji,jj,jl)480 d_smv_i_trp(ji,jj,jl) = 0._wp466 IF( old_v_i (ji,jj,jl) < epsi06 .AND. & 467 d_v_i_trp(ji,jj,jl) > epsi06 ) THEN 468 old_v_i (ji,jj,jl) = d_v_i_trp(ji,jj,jl) 469 d_v_i_trp (ji,jj,jl) = 0._wp 470 old_a_i (ji,jj,jl) = d_a_i_trp(ji,jj,jl) 471 d_a_i_trp (ji,jj,jl) = 0._wp 472 old_v_s (ji,jj,jl) = d_v_s_trp(ji,jj,jl) 473 d_v_s_trp (ji,jj,jl) = 0._wp 474 old_e_s (ji,jj,1,jl) = d_e_s_trp(ji,jj,1,jl) 475 d_e_s_trp (ji,jj,1,jl) = 0._wp 476 old_oa_i (ji,jj,jl) = d_oa_i_trp(ji,jj,jl) 477 d_oa_i_trp(ji,jj,jl) = 0._wp 478 IF( num_sal == 2 ) old_smv_i(ji,jj,jl) = d_smv_i_trp(ji,jj,jl) 479 d_smv_i_trp(ji,jj,jl) = 0._wp 481 480 ENDIF 482 481 END DO 483 482 END DO 484 483 END DO 485 484 ! 486 485 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 487 486 ! … … 612 611 ! present 613 612 zworka(ji,jj) = 4.0 * strength(ji,jj) & 614 + strength(ji-1,jj) * tms(ji-1,jj) &615 + strength(ji+1,jj) * tms(ji+1,jj) &616 + strength(ji,jj-1) * tms(ji,jj-1) &617 + strength(ji,jj+1) * tms(ji,jj+1)613 & + strength(ji-1,jj) * tms(ji-1,jj) & 614 & + strength(ji+1,jj) * tms(ji+1,jj) & 615 & + strength(ji,jj-1) * tms(ji,jj-1) & 616 & + strength(ji,jj+1) * tms(ji,jj+1) 618 617 619 618 zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1) 620 619 zworka(ji,jj) = zworka(ji,jj) / zw1 621 620 ELSE 622 zworka(ji,jj) = 0. 0621 zworka(ji,jj) = 0._wp 623 622 ENDIF 624 623 END DO … … 1048 1047 DO jj = 1, jpj 1049 1048 DO ji = 1, jpi 1050 IF (aicen_init(ji,jj,jl1) .GT. epsi11 .AND. athorn(ji,jj,jl1) .GT. 0.0&1051 .AND. closing_gross(ji,jj) > 0. 0) THEN1049 IF( aicen_init(ji,jj,jl1) > epsi11 .AND. athorn(ji,jj,jl1) > 0._wp & 1050 .AND. closing_gross(ji,jj) > 0._wp ) THEN 1052 1051 icells = icells + 1 1053 1052 indxi(icells) = ji … … 1130 1129 ! Salinity 1131 1130 !------------- 1132 smsw(ji,jj) = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0 ! salt content of water frozen in voids1131 smsw(ji,jj) = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0 ! salt content of seawater frozen in voids 1133 1132 1134 1133 zsrdg2 = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge … … 1137 1136 1138 1137 ! ! excess of salt is flushed into the ocean 1139 fsalt_rpo(ji,jj) = fsalt_rpo(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic / rdt_ice 1140 1138 sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 1139 1140 rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic / rau0 ! increase in ice volume du to seawater frozen in voids 1141 1141 1142 !------------------------------------ 1142 1143 ! 3.6 Increment ridging diagnostics … … 1148 1149 dardg1dt (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 1149 1150 dardg2dt (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj) 1150 diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) / rdt_ice1151 opening (ji,jj) = opening (ji,jj) + opning(ji,jj) *rdt_ice1151 diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) * r1_rdtice 1152 opening (ji,jj) = opening (ji,jj) + opning(ji,jj) * rdt_ice 1152 1153 1153 1154 IF( con_i ) vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj) … … 1156 1157 ! 3.7 Put the snow somewhere in the ocean 1157 1158 !------------------------------------------ 1158 1159 1159 ! Place part of the snow lost by ridging into the ocean. 1160 1160 ! Note that esnow_mlt < 0; the ocean must cool to melt snow. … … 1179 1179 ! ij looping 1-icells 1180 1180 1181 dhr (ji,jj)= hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1)1181 dhr (ji,jj) = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) 1182 1182 dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) 1183 1184 1183 1185 1184 END DO ! ij … … 1211 1210 1212 1211 ! heat flux 1213 fheat_ rpo(ji,jj) = fheat_rpo(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) / rdt_ice1212 fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 1214 1213 1215 1214 ! Correct dimensions to avoid big values … … 1275 1274 ! Transfer area, volume, and energy accordingly. 1276 1275 1277 IF (hrmin(ji,jj,jl1) .GE. hi_max(jl2).OR. &1278 hrmax(ji,jj,jl1) .LE. hi_max(jl2-1)) THEN1279 hL = 0. 01280 hR = 0. 01276 IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. & 1277 hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN 1278 hL = 0._wp 1279 hR = 0._wp 1281 1280 ELSE 1282 hL = MAX (hrmin(ji,jj,jl1), hi_max(jl2-1))1283 hR = MIN (hrmax(ji,jj,jl1), hi_max(jl2))1281 hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) ) 1282 hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2) ) 1284 1283 ENDIF 1285 1284 1286 1285 ! fraction of ridged ice area and volume going to n2 1287 farea = ( hR-hL) / dhr(ji,jj)1288 fvol(ji,jj) = ( hR*hR - hL*hL) / dhr2(ji,jj)1289 1290 a_i (ji,jj ,jl2) = a_i (ji,jj,jl2)+ ardg2 (ji,jj) * farea1291 v_i (ji,jj ,jl2) = v_i (ji,jj,jl2)+ vrdg2 (ji,jj) * fvol(ji,jj)1292 v_s (ji,jj ,jl2) = v_s (ji,jj,jl2)+ vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg1286 farea = ( hR - hL ) / dhr(ji,jj) 1287 fvol(ji,jj) = ( hR*hR - hL*hL ) / dhr2(ji,jj) 1288 1289 a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + ardg2 (ji,jj) * farea 1290 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj) 1291 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 1293 1292 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 1294 smv_i(ji,jj ,jl2) = smv_i(ji,jj,jl2)+ srdg2 (ji,jj) * fvol(ji,jj)1295 oa_i (ji,jj ,jl2) = oa_i (ji,jj,jl2)+ oirdg2(ji,jj) * farea1293 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 1294 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirdg2(ji,jj) * farea 1296 1295 1297 1296 END DO ! ij … … 1317 1316 ! Compute the fraction of rafted ice area and volume going to 1318 1317 ! thickness category jl2, transfer area, volume, and energy accordingly. 1319 1320 IF (hraft(ji,jj,jl1) .LE. hi_max(jl2).AND. &1321 hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN1322 a_i (ji,jj,jl2) = a_i(ji,jj,jl2) + arft2(ji,jj)1323 v_i (ji,jj,jl2) = v_i(ji,jj,jl2) + virft(ji,jj)1324 v_s (ji,jj,jl2) = v_s(ji,jj,jl2) + vsrft(ji,jj)*fsnowrft1325 e_s (ji,jj,1,jl2) = e_s(ji,jj,1,jl2) + esrft(ji,jj)*fsnowrft1326 smv_i(ji,jj ,jl2) = smv_i(ji,jj,jl2) + smrft(ji,jj)1327 oa_i (ji,jj,jl2) = oa_i(ji,jj,jl2)+ oirft2(ji,jj)1318 ! 1319 IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. & 1320 hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN 1321 a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + arft2 (ji,jj) 1322 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + virft (ji,jj) 1323 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrft (ji,jj) * fsnowrft 1324 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * fsnowrft 1325 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + smrft (ji,jj) 1326 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj) 1328 1327 ENDIF ! hraft 1329 1328 ! 1330 1329 END DO ! ij 1331 1330 … … 1336 1335 ji = indxi(ij) 1337 1336 jj = indxj(ij) 1338 IF (hraft(ji,jj,jl1) .LE. hi_max(jl2).AND. &1339 hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN1337 IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. & 1338 hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN 1340 1339 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 1341 1340 ENDIF … … 1504 1503 DO jj = 1 , jpj 1505 1504 DO ji = 1 , jpi 1506 !!gm xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice1505 !!gm xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 1507 1506 !!gm xtmp = xtmp * unit_fac 1508 1507 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp … … 1524 1523 ! fluxes are positive to the ocean 1525 1524 ! here the flux has to be negative for the ocean 1526 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice1525 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice 1527 1526 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1528 1527 1529 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB ???????1528 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB ??????? 1530 1529 1531 1530 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) ) … … 1536 1535 1537 1536 ! xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 1538 ! fresh(i,j) = fresh(i,j) + xtmp 1539 ! fresh_hist(i,j) = fresh_hist(i,j) + xtmp 1540 1541 ! fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_m(ji,jj) ) * & 1542 ! rhosn * v_s(ji,jj,jl) / rdt_ice 1543 1544 ! fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * & 1545 ! rhoic * v_i(ji,jj,jl) / rdt_ice 1546 1547 ! emps(i,j) = emps(i,j) + xtmp 1548 ! fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 1537 ! sfx_res(ji,jj) = sfx_res(ji,jj) + ( sss_m(ji,jj) ) & 1538 ! * rhosn * v_s(ji,jj,jl) * r1_rdtice 1539 ! sfx_res(ji,jj) = sfx_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) & 1540 ! * rhoic * v_i(ji,jj,jl) * r1_rdtice 1541 ! sfx (i,j) = sfx (i,j) + xtmp 1549 1542 1550 1543 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r3294 r3625 2 2 !!====================================================================== 3 3 !! *** MODULE limitd_th *** 4 !! Thermodynamics of ice thickness distribution 5 !! computation of changes in g(h) 4 !! LIM3 ice model : ice thickness distribution: Thermodynamics 6 5 !!====================================================================== 7 6 !! History : - ! (W. H. Lipscomb and E.C. Hunke) CICE (c) original code … … 20 19 !! lim_itd_shiftice : 21 20 !!---------------------------------------------------------------------- 22 USE dom_ice ! LIM-3 domain 23 USE par_oce ! ocean parameters 24 USE dom_oce ! ocean domain 25 USE phycst ! physical constants (ocean directory) 26 USE thd_ice ! LIM-3 thermodynamic variables 27 USE ice ! LIM-3 variables 28 USE par_ice ! LIM-3 parameters 29 USE limthd_lac ! LIM-3 lateral accretion 30 USE limvar ! LIM-3 variables 31 USE limcons ! LIM-3 conservation 32 USE prtctl ! Print control 33 USE in_out_manager ! I/O manager 34 USE lib_mpp ! MPP library 35 USE wrk_nemo ! work arrays 21 USE par_oce ! ocean parameters 22 USE dom_oce ! ocean domain 23 USE phycst ! physical constants (ocean directory) 24 USE ice ! LIM-3 variables 25 USE par_ice ! LIM-3 parameters 26 USE dom_ice ! LIM-3 domain 27 USE thd_ice ! LIM-3 thermodynamic variables 28 USE limthd_lac ! LIM-3 lateral accretion 29 USE limvar ! LIM-3 variables 30 USE limcons ! LIM-3 conservation 31 USE prtctl ! Print control 32 USE in_out_manager ! I/O manager 33 USE lib_mpp ! MPP library 34 USE wrk_nemo ! work arrays 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 36 36 37 37 IMPLICIT NONE … … 49 49 50 50 !!---------------------------------------------------------------------- 51 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2010)51 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 52 52 !! $Id$ 53 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 101 101 102 102 !- Trend terms 103 d_a_i_thd (:,:,:)= a_i(:,:,:) - old_a_i(:,:,:)104 d_v_s_thd (:,:,:)= v_s(:,:,:) - old_v_s(:,:,:)105 d_v_i_thd (:,:,:)= v_i(:,:,:) - old_v_i(:,:,:)103 d_a_i_thd(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:) 104 d_v_s_thd(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:) 105 d_v_i_thd(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:) 106 106 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 107 107 d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 108 108 109 109 d_smv_i_thd(:,:,:) = 0._wp 110 IF( num_sal == 2 .OR. num_sal == 4) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)110 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 111 111 112 112 IF(ln_ctl) THEN ! Control print … … 143 143 144 144 !- Recover Old values 145 a_i(:,:,:) = old_a_i 146 v_s(:,:,:) = old_v_s 147 v_i(:,:,:) = old_v_i 148 e_s(:,:,:,:) = old_e_s 149 e_i(:,:,:,:) = old_e_i 150 ! 151 IF( num_sal == 2 .OR. num_sal == 4 ) smv_i(:,:,:) = old_smv_i(:,:,:)145 a_i(:,:,:) = old_a_i(:,:,:) 146 v_s(:,:,:) = old_v_s(:,:,:) 147 v_i(:,:,:) = old_v_i(:,:,:) 148 e_s(:,:,:,:) = old_e_s(:,:,:,:) 149 e_i(:,:,:,:) = old_e_i(:,:,:,:) 150 ! 151 IF( num_sal == 2 ) smv_i(:,:,:) = old_smv_i(:,:,:) 152 152 ! 153 153 END SUBROUTINE lim_itd_th -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
r2715 r3625 10 10 !! 'key_lim3' LIM3 sea-ice model 11 11 !!---------------------------------------------------------------------- 12 !! lim_msh : definition of the ice mesh12 !! lim_msh : definition of the ice mesh 13 13 !!---------------------------------------------------------------------- 14 14 USE phycst ! physical constants … … 18 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 19 USE lib_mpp ! MPP library 20 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 20 21 21 22 IMPLICIT NONE … … 25 26 26 27 !!---------------------------------------------------------------------- 27 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)28 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 28 29 !! $Id$ 29 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r3294 r3625 15 15 !! 'key_lim2' AND NOT 'key_lim2_vp' EVP LIM-2 sea-ice model 16 16 !!---------------------------------------------------------------------- 17 !! lim_rhg : computes ice velocities17 !! lim_rhg : computes ice velocities 18 18 !!---------------------------------------------------------------------- 19 USE phycst ! Physical constant 20 USE par_oce ! Ocean parameters 21 USE dom_oce ! Ocean domain 22 USE sbc_oce ! Surface boundary condition: ocean fields 23 USE sbc_ice ! Surface boundary condition: ice fields 24 USE lbclnk ! Lateral Boundary Condition / MPP link 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! work arrays 27 USE in_out_manager ! I/O manager 28 USE prtctl ! Print control 19 USE phycst ! Physical constant 20 USE oce , ONLY : snwice_mass, snwice_mass_b 21 USE par_oce ! Ocean parameters 22 USE dom_oce ! Ocean domain 23 USE sbc_oce ! Surface boundary condition: ocean fields 24 USE sbc_ice ! Surface boundary condition: ice fields 29 25 #if defined key_lim3 30 USE ice 31 USE dom_ice 32 USE limitd_me 26 USE ice ! LIM-3: ice variables 27 USE dom_ice ! LIM-3: ice domain 28 USE limitd_me ! LIM-3: 33 29 #else 34 USE ice_2 ! LIM2: ice variables35 USE dom_ice_2 ! LIM2: ice domain30 USE ice_2 ! LIM-2: ice variables 31 USE dom_ice_2 ! LIM-2: ice domain 36 32 #endif 33 USE lbclnk ! Lateral Boundary Condition / MPP link 34 USE lib_mpp ! MPP library 35 USE wrk_nemo ! work arrays 36 USE in_out_manager ! I/O manager 37 USE prtctl ! Print control 38 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 37 39 38 40 IMPLICIT NONE … … 47 49 # include "vectopt_loop_substitute.h90" 48 50 !!---------------------------------------------------------------------- 49 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)51 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 50 52 !! $Id$ 51 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 124 126 REAL(wp) :: zindb ! ice (1) or not (0) 125 127 REAL(wp) :: zdummy ! dummy argument 128 REAL(wp) :: zintb, zintn ! dummy argument 126 129 127 130 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength … … 144 147 REAL(wp), POINTER, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs12 145 148 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity 149 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 150 ! ocean surface (ssh_m) if ice is not embedded 151 ! ice top surface if ice is embedded 146 152 147 153 !!------------------------------------------------------------------- … … 150 156 CALL wrk_alloc( jpi,jpj, zc1 , u_oce1, u_oce2, u_ice2, zusw , v_oce1 , v_oce2, v_ice1 ) 151 157 CALL wrk_alloc( jpi,jpj, zf1 , deltat, zu_ice, zf2 , deltac, zv_ice , zdd , zdt , zds ) 152 CALL wrk_alloc( jpi,jpj, zdd , zdt , zds , zs1 , zs2 , zs12 , zresr 158 CALL wrk_alloc( jpi,jpj, zdd , zdt , zds , zs1 , zs2 , zs12 , zresr , zpice ) 153 159 154 160 #if defined key_lim2 && ! defined key_lim2_vp … … 231 237 ! v_oce2: ocean v component on v points 232 238 239 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! 240 ! 241 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 242 ! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 243 zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 244 ! 245 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 246 ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 247 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 248 ! 249 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 250 ! 251 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 252 zpice(:,:) = ssh_m(:,:) 253 ENDIF 254 233 255 DO jj = k_j1+1, k_jpj-1 234 256 DO ji = fs_2, fs_jpim1 … … 273 295 ! include it later 274 296 275 zdsshx = ( ssh_m(ji+1,jj) - ssh_m(ji,jj) ) / e1u(ji,jj)276 zdsshy = ( ssh_m(ji,jj+1) - ssh_m(ji,jj) ) / e2v(ji,jj)297 zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 298 zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 277 299 278 300 za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx … … 746 768 CALL wrk_dealloc( jpi,jpj, zc1 , u_oce1, u_oce2, u_ice2, zusw , v_oce1 , v_oce2, v_ice1 ) 747 769 CALL wrk_dealloc( jpi,jpj, zf1 , deltat, zu_ice, zf2 , deltac, zv_ice , zdd , zdt , zds ) 748 CALL wrk_dealloc( jpi,jpj, zdd , zdt , zds , zs1 , zs2 , zs12 , zresr 770 CALL wrk_dealloc( jpi,jpj, zdd , zdt , zds , zs1 , zs2 , zs12 , zresr , zpice ) 749 771 750 772 END SUBROUTINE lim_rhg -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r3294 r3625 12 12 !! 'key_lim3' : LIM sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! lim_rst_opn : open ice restart file 15 !! lim_rst_write : write of the restart file 16 !! lim_rst_read : read the restart file 17 !!---------------------------------------------------------------------- 18 USE ice ! sea-ice variables 19 USE par_ice ! sea-ice parameters 20 USE dom_oce ! ocean domain 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE in_out_manager ! I/O manager 24 USE iom ! I/O library 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! work arrays 14 !! lim_rst_opn : open ice restart file 15 !! lim_rst_write : write of the restart file 16 !! lim_rst_read : read the restart file 17 !!---------------------------------------------------------------------- 18 USE ice ! sea-ice variables 19 USE par_ice ! sea-ice parameters 20 USE dom_oce ! ocean domain 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE in_out_manager ! I/O manager 24 USE iom ! I/O library 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! work arrays 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 28 28 29 IMPLICIT NONE … … 37 38 38 39 !!---------------------------------------------------------------------- 39 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)40 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 40 41 !! $Id$ 41 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 402 403 zsmax = 4.5_wp 403 404 zsmin = 3.5_wp 404 IF( sm_i(ji,jj,jl) .LT.zsmin ) THEN405 IF( sm_i(ji,jj,jl) < zsmin ) THEN 405 406 zalpha = 1._wp 406 ELSEIF( sm_i(ji,jj,jl) .LT.zsmax ) THEN407 ELSEIF( sm_i(ji,jj,jl) < zsmax ) THEN 407 408 zalpha = sm_i(ji,jj,jl) / ( zsmin - zsmax ) + zsmax / ( zsmax - zsmin ) 408 409 ELSE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r3294 r3625 9 9 !! 3.3 ! 2010-05 (G. Madec) decrease ocean & ice reference salinities in the Baltic sea 10 10 !! ! + simplification of the ice-ocean stress calculation 11 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 11 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 12 !! 3.5 ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_lim3 … … 34 35 USE prtctl ! Print control 35 36 USE cpl_oasis3, ONLY : lk_cpl 37 USE oce, ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass, sshu_b, sshv_b, sshu_n, sshv_n, sshf_n 38 USE dom_ice, ONLY : tms 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 36 40 37 41 IMPLICIT NONE … … 42 46 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 43 47 44 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice45 48 REAL(wp) :: epsi16 = 1.e-16_wp ! constant values 46 49 REAL(wp) :: rzero = 0._wp … … 54 57 # include "vectopt_loop_substitute.h90" 55 58 !!---------------------------------------------------------------------- 56 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)59 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 57 60 !! $Id$ 58 61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 86 89 !! - qns : sea heat flux: non solar 87 90 !! - emp : freshwater budget: volume flux 88 !! - emps : freshwater budget: concentration/dillution91 !! - sfx : salt flux 89 92 !! - fr_i : ice fraction 90 93 !! - tn_ice : sea-ice surface temperature … … 97 100 ! 98 101 INTEGER :: ji, jj ! dummy loop indices 99 INTEGER :: ierr 100 INTEGER :: if vt, i1mfr, idfr ! some switches101 INTEGER :: iflt, ial, iadv, ifral, ifrdv102 REAL(wp) :: z inda, zfons, zpme ! local scalars103 REAL(wp) , POINTER, DIMENSION(:,:) :: zfcm1 , zfcm2 ! solar/non solar heat fluxes104 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace102 INTEGER :: ierr, ifvt, i1mfr, idfr ! local integer 103 INTEGER :: iflt, ial , iadv , ifral, ifrdv ! - - 104 REAL(wp) :: zinda, zemp, zemp_snow, zfmm ! local scalars 105 REAL(wp) :: zemp_snw ! - - 106 REAL(wp) :: zfcm1 , zfcm2 ! - - 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 105 108 !!--------------------------------------------------------------------- 106 109 107 CALL wrk_alloc( jpi, jpj, zfcm1 , zfcm2 )108 110 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 109 111 … … 139 141 140 142 ! computation the solar flux at ocean surface 141 zfcm1 (ji,jj) = pfrld(ji,jj) * qsr(ji,jj) + ( 1.- pfrld(ji,jj) ) * fstric(ji,jj)143 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) 142 144 ! fstric Solar flux transmitted trough the ice 143 145 ! qsr Net short wave heat flux on free ocean … … 146 148 147 149 ! computation the non solar heat flux at ocean surface 148 zfcm2(ji,jj) = - zfcm1(ji,jj) & 149 & + iflt * ( fscmbq(ji,jj) ) & ! total abl -> fscmbq is given to the ocean 150 ! fscmbq and ffltbif are obsolete 151 ! & + iflt * ffltbif(ji,jj) !!! only if one category is used 152 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 153 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 154 & + fhmec(ji,jj) & ! new contribution due to snow melt in ridging!! 155 & + fheat_rpo(ji,jj) & ! contribution from ridge formation 156 & + fheat_res(ji,jj) 157 ! fscmbq Part of the solar radiation transmitted through the ice and going to the ocean 158 ! computed in limthd_zdf.F90 159 ! ffltbif Total heat content of the ice (brine pockets+ice) / delta_t 150 zfcm2 = - zfcm1 & ! ??? 151 & + iflt * fscmbq(ji,jj) & ! total ablation: heat given to the ocean 152 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 153 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 154 & + fhmec(ji,jj) & ! snow melt when ridging 155 & + fheat_mec(ji,jj) & ! ridge formation 156 & + fheat_res(ji,jj) ! residual heat flux 160 157 ! qcmif Energy needed to bring the ocean surface layer until its freezing (ok) 161 158 ! qldif heat balance of the lead (or of the open ocean) 162 ! qfvbq i think this is wrong! 163 ! ---> Array used to store energy in case of total lateral ablation 164 ! qfvbq latent heat uptake/release after accretion/ablation 165 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 166 167 IF ( num_sal == 2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + & 168 fhbri(ji,jj) ! new contribution due to brine drainage 169 170 ! bottom radiative component is sent to the computation of the 171 ! oceanic heat flux 172 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) 159 ! qfvbq latent heat uptake/release after accretion/ablation 160 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 161 162 IF( num_sal == 2 ) zfcm2 = zfcm2 + fhbri(ji,jj) ! add contribution due to brine drainage 163 164 ! bottom radiative component is sent to the computation of the oceanic heat flux 165 fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj) 173 166 174 167 ! used to compute the oceanic heat flux at the next time step 175 qsr(ji,jj) = zfcm1 (ji,jj)! solar heat flux176 qns(ji,jj) = zfcm2 (ji,jj)- fdtcn(ji,jj) ! non solar heat flux168 qsr(ji,jj) = zfcm1 ! solar heat flux 169 qns(ji,jj) = zfcm2 - fdtcn(ji,jj) ! non solar heat flux 177 170 ! ! fdtcn : turbulent oceanic heat flux 178 171 179 172 !!gm this IF prevents the vertorisation of the whole loop 180 173 IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 181 174 WRITE(numout,*) ' lim_sbc : heat fluxes ' 182 175 WRITE(numout,*) ' qsr : ', qsr(jiindx,jjindx) 183 WRITE(numout,*) ' zfcm1 : ', zfcm1(jiindx,jjindx)184 176 WRITE(numout,*) ' pfrld : ', pfrld(jiindx,jjindx) 185 177 WRITE(numout,*) ' fstric : ', fstric (jiindx,jjindx) 186 178 WRITE(numout,*) 187 179 WRITE(numout,*) ' qns : ', qns(jiindx,jjindx) 188 WRITE(numout,*) ' zfcm2 : ', zfcm2(jiindx,jjindx) 189 WRITE(numout,*) ' zfcm1 : ', zfcm1(jiindx,jjindx) 180 WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx) 190 181 WRITE(numout,*) ' ifral : ', ifral 191 182 WRITE(numout,*) ' ial : ', ial … … 202 193 WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx) 203 194 WRITE(numout,*) ' fhmec : ', fhmec(jiindx,jjindx) 204 WRITE(numout,*) ' fheat_ rpo : ', fheat_rpo(jiindx,jjindx)195 WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 205 196 WRITE(numout,*) ' fhbri : ', fhbri(jiindx,jjindx) 206 197 WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 207 198 ENDIF 208 199 !!gm end 209 200 END DO 210 201 END DO … … 227 218 228 219 ! computing freshwater exchanges at the ice/ocean interface 229 zpme = - emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 230 & + tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 231 & - sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 232 & - rdmsnif(ji,jj) * r1_rdtice & ! freshwaterflux due to snow melting 233 & + fmmec(ji,jj) ! snow falling when ridging 234 235 236 ! computing salt exchanges at the ice/ocean interface 237 ! sice should be the same as computed with the ice model 238 zfons = ( soce_0(ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice 239 ! SOCE 240 zfons = ( sss_m (ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice 241 242 !CT useless ! salt flux for constant salinity 243 !CT useless fsalt(ji,jj) = zfons / ( sss_m(ji,jj) + epsi16 ) + fsalt_res(ji,jj) 244 ! salt flux for variable salinity 245 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 246 ! correcting brine and salt fluxes 247 fsbri(ji,jj) = zinda*fsbri(ji,jj) 248 ! converting the salt fluxes from ice to a freshwater flux from ocean 249 fsalt_res(ji,jj) = fsalt_res(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 250 fseqv(ji,jj) = fseqv(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 251 fsbri(ji,jj) = fsbri(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 252 fsalt_rpo(ji,jj) = fsalt_rpo(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 253 254 ! freshwater mass exchange (positive to the ice, negative for the ocean ?) 255 ! actually it's a salt flux (so it's minus freshwater flux) 256 ! if sea ice grows, zfons is positive, fsalt also 257 ! POSITIVE SALT FLUX FROM THE ICE TO THE OCEAN 258 ! POSITIVE FRESHWATER FLUX FROM THE OCEAN TO THE ICE [kg.m-2.s-1] 259 260 emp(ji,jj) = - zpme 220 zemp = emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 221 & - tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 222 & + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 223 & - fmmec(ji,jj) ! snow falling when ridging 224 225 ! mass flux at the ocean/ice interface (sea ice fraction) 226 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean 227 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus mesting 228 229 emp(ji,jj) = zemp + zemp_snw + zfmm ! mass flux + F/M mass flux (always ice/ocean mass exchange) 230 231 ! correcting brine salt fluxes (zinda = 1 if pfrld=1 , =0 otherwise) 232 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 233 sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj) 261 234 END DO 262 235 END DO 263 236 237 !------------------------------------------! 238 ! salt flux at the ocean surface ! 239 !------------------------------------------! 240 264 241 IF( num_sal == 2 ) THEN ! variable ice salinity: brine drainage included in the salt flux 265 emps(:,:) = fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:)242 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 266 243 ELSE ! constant ice salinity: 267 emps(:,:) = fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:) 244 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 245 ENDIF 246 !-----------------------------------------------! 247 ! mass of snow and ice per unit area ! 248 !-----------------------------------------------! 249 IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required) 250 snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step 251 ! ! new mass per unit area 252 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 253 ! ! time evolution of snow+ice mass 254 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 268 255 ENDIF 269 256 … … 285 272 IF(ln_ctl) THEN 286 273 CALL prt_ctl( tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ' ) 287 CALL prt_ctl( tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2= emps, clinfo2=' emps: ' )274 CALL prt_ctl( tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ' ) 288 275 CALL prt_ctl( tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ' ) 289 276 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 290 277 ENDIF 291 278 ! 292 CALL wrk_dealloc( jpi, jpj, zfcm1 , zfcm2 )293 279 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 294 280 ! … … 383 369 !!------------------------------------------------------------------- 384 370 ! 371 INTEGER :: ji, jj ! dummy loop indices 372 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 385 373 IF(lwp) WRITE(numout,*) 386 374 IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' … … 389 377 ! ! allocate lim_sbc array 390 378 IF( lim_sbc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 391 !392 r1_rdtice = 1. / rdt_ice393 379 ! 394 380 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case … … 402 388 END WHERE 403 389 ENDIF 390 ! ! embedded sea ice 391 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 392 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 393 snwice_mass_b(:,:) = snwice_mass(:,:) 394 ELSE 395 snwice_mass (:,:) = 0.0_wp ! no mass exchanges 396 snwice_mass_b(:,:) = 0.0_wp ! no mass exchanges 397 ENDIF 398 IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart 399 & .NOT. ln_rstart ) THEN ! deplete the initial ssh below sea-ice area 400 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 401 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 402 ! 403 ! Note: Changed the initial values of sshb and sshn=> need to recompute ssh[u,v,f]_[b,n] 404 ! which were previously set in domvvl 405 IF ( lk_vvl ) THEN ! Is this necessary? embd 2 should be restricted to vvl only??? 406 DO jj = 1, jpjm1 407 DO ji = 1, jpim1 ! caution: use of Vector Opt. not possible 408 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 409 zcoefv = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 410 zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 411 sshu_b(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 412 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 413 sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshb(ji,jj ) & 414 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 415 sshu_n(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshn(ji ,jj) & 416 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 417 sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshn(ji,jj ) & 418 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 419 END DO 420 END DO 421 CALL lbc_lnk( sshu_b, 'U', 1. ) ; CALL lbc_lnk( sshu_n, 'U', 1. ) 422 CALL lbc_lnk( sshv_b, 'V', 1. ) ; CALL lbc_lnk( sshv_n, 'V', 1. ) 423 DO jj = 1, jpjm1 424 DO ji = 1, jpim1 ! NO Vector Opt. 425 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 426 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 427 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 428 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 429 END DO 430 END DO 431 CALL lbc_lnk( sshf_n, 'F', 1. ) 432 ENDIF 433 ENDIF 404 434 ! 405 435 END SUBROUTINE lim_sbc_init -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90
r2715 r3625 2 2 !!====================================================================== 3 3 !! *** MODULE limtab *** 4 !! LIM : transform 1D (2D) array to a 2D (1D) table4 !! LIM ice model : transform 1D (2D) array to a 2D (1D) table 5 5 !!====================================================================== 6 6 #if defined key_lim3 … … 20 20 21 21 !!---------------------------------------------------------------------- 22 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2010)22 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 23 23 !! $Id$ 24 24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r3294 r3625 8 8 !! 3.0 ! 2005-11 (M. Vancoppenolle) LIM-3 : Multi-layer thermodynamics + salinity variations 9 9 !! - ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm snif10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw 11 11 !! 3.3 ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 12 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation … … 16 16 !! 'key_lim3' LIM3 sea-ice model 17 17 !!---------------------------------------------------------------------- 18 !! lim_thd 19 !! lim_thd_init 18 !! lim_thd : thermodynamic of sea ice 19 !! lim_thd_init : initialisation of sea-ice thermodynamic 20 20 !!---------------------------------------------------------------------- 21 USE phycst ! physical constants 22 USE dom_oce ! ocean space and time domain variables 23 USE ice ! LIM: sea-ice variables 24 USE par_ice ! LIM: sea-ice parameters 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE thd_ice ! LIM thermodynamic sea-ice variables 28 USE dom_ice ! LIM sea-ice domain 29 USE domvvl ! domain: variable volume level 30 USE limthd_dif ! LIM: thermodynamics, vertical diffusion 31 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation 32 USE limthd_sal ! LIM: thermodynamics, ice salinity 33 USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution 34 USE limtab ! LIM: 1D <==> 2D transformation 35 USE limvar ! LIM: sea-ice variables 36 USE lbclnk ! lateral boundary condition - MPP links 37 USE lib_mpp ! MPP library 38 USE wrk_nemo ! work arrays 39 USE in_out_manager ! I/O manager 40 USE prtctl ! Print control 21 USE phycst ! physical constants 22 USE dom_oce ! ocean space and time domain variables 23 USE ice ! LIM: sea-ice variables 24 USE par_ice ! LIM: sea-ice parameters 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE thd_ice ! LIM thermodynamic sea-ice variables 28 USE dom_ice ! LIM sea-ice domain 29 USE domvvl ! domain: variable volume level 30 USE limthd_dif ! LIM: thermodynamics, vertical diffusion 31 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation 32 USE limthd_sal ! LIM: thermodynamics, ice salinity 33 USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution 34 USE limtab ! LIM: 1D <==> 2D transformation 35 USE limvar ! LIM: sea-ice variables 36 USE lbclnk ! lateral boundary condition - MPP links 37 USE lib_mpp ! MPP library 38 USE wrk_nemo ! work arrays 39 USE in_out_manager ! I/O manager 40 USE prtctl ! Print control 41 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 41 42 42 43 IMPLICIT NONE … … 110 111 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi06 ) ) * nlay_i 111 112 !0 if no ice and 1 if yes 112 zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i(ji,jj,jl) ))113 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - ht_i(ji,jj,jl) ) ) 113 114 !convert units ! very important that this line is here 114 115 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb … … 122 123 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * nlay_s 123 124 !0 if no ice and 1 if yes 124 zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s(ji,jj,jl) ))125 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - ht_s(ji,jj,jl) ) ) 125 126 !convert units ! very important that this line is here 126 127 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb … … 140 141 ffltbif(:,:) = 0.e0 ! linked with fstric 141 142 qfvbq (:,:) = 0.e0 ! linked with fstric 142 rdm snif(:,:) = 0.e0 ! variation of snow mass per unit area143 rdm icif(:,:) = 0.e0 ! variation of ice mass per unit area143 rdm_snw(:,:) = 0.e0 ! variation of snow mass per unit area 144 rdm_ice(:,:) = 0.e0 ! variation of ice mass per unit area 144 145 hicifp (:,:) = 0.e0 ! daily thermodynamic ice production. 145 fsbri(:,:) = 0.e0 ! brine flux contribution to salt flux to the ocean146 sfx_bri(:,:) = 0.e0 ! brine flux contribution to salt flux to the ocean 146 147 fhbri (:,:) = 0.e0 ! brine flux contribution to heat flux to the ocean 147 fseqv(:,:) = 0.e0 ! equivalent salt flux to the ocean due to ice/growth decay148 sfx_thd(:,:) = 0.e0 ! equivalent salt flux to the ocean due to ice/growth decay 148 149 149 150 !----------------------------------- … … 273 274 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 274 275 CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 275 276 276 #if ! defined key_coupled 277 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) 278 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl) 277 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 278 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 279 279 #endif 280 281 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 282 CALL tab_2d_1d( nbpb, t_bo_b (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 283 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 284 CALL tab_2d_1d( nbpb, fbif_1d (1:nbpb), fbif , jpi, jpj, npb(1:nbpb) ) 285 CALL tab_2d_1d( nbpb, qldif_1d (1:nbpb), qldif , jpi, jpj, npb(1:nbpb) ) 286 CALL tab_2d_1d( nbpb, rdmicif_1d (1:nbpb), rdmicif , jpi, jpj, npb(1:nbpb) ) 287 CALL tab_2d_1d( nbpb, rdmsnif_1d (1:nbpb), rdmsnif , jpi, jpj, npb(1:nbpb) ) 288 CALL tab_2d_1d( nbpb, dmgwi_1d (1:nbpb), dmgwi , jpi, jpj, npb(1:nbpb) ) 289 CALL tab_2d_1d( nbpb, qlbbq_1d (1:nbpb), zqlbsbq , jpi, jpj, npb(1:nbpb) ) 290 291 CALL tab_2d_1d( nbpb, fseqv_1d (1:nbpb), fseqv , jpi, jpj, npb(1:nbpb) ) 292 CALL tab_2d_1d( nbpb, fsbri_1d (1:nbpb), fsbri , jpi, jpj, npb(1:nbpb) ) 293 CALL tab_2d_1d( nbpb, fhbri_1d (1:nbpb), fhbri , jpi, jpj, npb(1:nbpb) ) 294 CALL tab_2d_1d( nbpb, fstbif_1d (1:nbpb), fstric , jpi, jpj, npb(1:nbpb) ) 295 CALL tab_2d_1d( nbpb, qfvbq_1d (1:nbpb), qfvbq , jpi, jpj, npb(1:nbpb) ) 280 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 281 CALL tab_2d_1d( nbpb, t_bo_b (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 282 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 283 CALL tab_2d_1d( nbpb, fbif_1d (1:nbpb), fbif , jpi, jpj, npb(1:nbpb) ) 284 CALL tab_2d_1d( nbpb, qldif_1d (1:nbpb), qldif , jpi, jpj, npb(1:nbpb) ) 285 CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice , jpi, jpj, npb(1:nbpb) ) 286 CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw , jpi, jpj, npb(1:nbpb) ) 287 CALL tab_2d_1d( nbpb, dmgwi_1d (1:nbpb), dmgwi , jpi, jpj, npb(1:nbpb) ) 288 CALL tab_2d_1d( nbpb, qlbbq_1d (1:nbpb), zqlbsbq , jpi, jpj, npb(1:nbpb) ) 289 290 CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd , jpi, jpj, npb(1:nbpb) ) 291 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 292 CALL tab_2d_1d( nbpb, fhbri_1d (1:nbpb), fhbri , jpi, jpj, npb(1:nbpb) ) 293 CALL tab_2d_1d( nbpb, fstbif_1d (1:nbpb), fstric , jpi, jpj, npb(1:nbpb) ) 294 CALL tab_2d_1d( nbpb, qfvbq_1d (1:nbpb), qfvbq , jpi, jpj, npb(1:nbpb) ) 296 295 297 296 !-------------------------------- … … 331 330 !-------------------------------- 332 331 333 CALL tab_1d_2d( nbpb, at_i , npb, at_i_b(1:nbpb), jpi, jpj ) 334 CALL tab_1d_2d( nbpb, ht_i(:,:,jl), npb, ht_i_b(1:nbpb), jpi, jpj ) 335 CALL tab_1d_2d( nbpb, ht_s(:,:,jl), npb, ht_s_b(1:nbpb), jpi, jpj ) 336 CALL tab_1d_2d( nbpb, a_i (:,:,jl), npb, a_i_b(1:nbpb) , jpi, jpj ) 337 CALL tab_1d_2d( nbpb, t_su(:,:,jl), npb, t_su_b(1:nbpb), jpi, jpj ) 338 CALL tab_1d_2d( nbpb, sm_i(:,:,jl), npb, sm_i_b(1:nbpb), jpi, jpj ) 339 332 CALL tab_1d_2d( nbpb, at_i , npb, at_i_b (1:nbpb) , jpi, jpj ) 333 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_b (1:nbpb) , jpi, jpj ) 334 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_b (1:nbpb) , jpi, jpj ) 335 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_b (1:nbpb) , jpi, jpj ) 336 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_b (1:nbpb) , jpi, jpj ) 337 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_b (1:nbpb) , jpi, jpj ) 340 338 DO jk = 1, nlay_s 341 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b (1:nbpb,jk), jpi, jpj)342 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b (1:nbpb,jk), jpi, jpj)339 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b (1:nbpb,jk), jpi, jpj) 340 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b (1:nbpb,jk), jpi, jpj) 343 341 END DO 344 345 342 DO jk = 1, nlay_i 346 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b (1:nbpb,jk), jpi, jpj)347 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b (1:nbpb,jk), jpi, jpj)348 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b (1:nbpb,jk), jpi, jpj)343 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b (1:nbpb,jk), jpi, jpj) 344 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b (1:nbpb,jk), jpi, jpj) 345 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b (1:nbpb,jk), jpi, jpj) 349 346 END DO 350 351 CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb), jpi, jpj ) 352 CALL tab_1d_2d( nbpb, qldif , npb, qldif_1d (1:nbpb), jpi, jpj ) 353 CALL tab_1d_2d( nbpb, qfvbq , npb, qfvbq_1d (1:nbpb), jpi, jpj ) 354 CALL tab_1d_2d( nbpb, rdmicif, npb, rdmicif_1d(1:nbpb), jpi, jpj ) 355 CALL tab_1d_2d( nbpb, rdmsnif, npb, rdmsnif_1d(1:nbpb), jpi, jpj ) 356 CALL tab_1d_2d( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb), jpi, jpj ) 357 CALL tab_1d_2d( nbpb, rdvosif, npb, dvsbq_1d (1:nbpb), jpi, jpj ) 358 CALL tab_1d_2d( nbpb, rdvobif, npb, dvbbq_1d (1:nbpb), jpi, jpj ) 359 CALL tab_1d_2d( nbpb, fdvolif, npb, dvlbq_1d (1:nbpb), jpi, jpj ) 360 CALL tab_1d_2d( nbpb, rdvonif, npb, dvnbq_1d (1:nbpb), jpi, jpj ) 361 CALL tab_1d_2d( nbpb, fseqv , npb, fseqv_1d (1:nbpb), jpi, jpj ) 347 CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb) , jpi, jpj ) 348 CALL tab_1d_2d( nbpb, qldif , npb, qldif_1d (1:nbpb) , jpi, jpj ) 349 CALL tab_1d_2d( nbpb, qfvbq , npb, qfvbq_1d (1:nbpb) , jpi, jpj ) 350 CALL tab_1d_2d( nbpb, rdm_ice , npb, rdm_ice_1d(1:nbpb) , jpi, jpj ) 351 CALL tab_1d_2d( nbpb, rdm_snw , npb, rdm_snw_1d(1:nbpb) , jpi, jpj ) 352 CALL tab_1d_2d( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) 353 CALL tab_1d_2d( nbpb, rdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 354 CALL tab_1d_2d( nbpb, rdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 355 CALL tab_1d_2d( nbpb, fdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 356 CALL tab_1d_2d( nbpb, rdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 357 CALL tab_1d_2d( nbpb, sfx_thd , npb, sfx_thd_1d(1:nbpb) , jpi, jpj ) 362 358 ! 363 359 IF( num_sal == 2 ) THEN 364 CALL tab_1d_2d( nbpb, fsbri, npb, fsbri_1d(1:nbpb), jpi, jpj )365 CALL tab_1d_2d( nbpb, fhbri , npb, fhbri_1d(1:nbpb), jpi, jpj )360 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 361 CALL tab_1d_2d( nbpb, fhbri , npb, fhbri_1d (1:nbpb) , jpi, jpj ) 366 362 ENDIF 367 363 ! 368 !+++++ 369 !temporary stuff for a dummy version 364 !+++++ temporary stuff for a dummy version 370 365 CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb) , jpi, jpj ) 371 366 CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb) , jpi, jpj ) … … 389 384 ! 5.1) Ice heat content 390 385 !------------------------ 391 ! Enthalpies are global variables we have to readjust the units 386 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 392 387 zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 393 388 DO jl = 1, jpl 394 389 DO jk = 1, nlay_i 395 ! Multiply by volume, divide by nlayers so that heat content in 10^9 Joules396 390 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 397 391 END DO … … 401 395 ! 5.2) Snow heat content 402 396 !------------------------ 403 ! Enthalpies are global variables we have to readjust the units 397 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 404 398 zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 405 399 DO jl = 1, jpl 406 400 DO jk = 1, nlay_s 407 ! Multiply by volume, so that heat content in 10^9 Joules408 401 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 409 402 END DO … … 419 412 !-------------------------------------------- 420 413 d_v_i_thd(:,:,:) = v_i (:,:,:) - old_v_i(:,:,:) ! ice volumes 421 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) / rdt_ice * 86400.0414 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 422 415 423 416 IF( con_i ) fbif(:,:) = fbif(:,:) + zqlbsbq(:,:) … … 488 481 ! 489 482 IF(lwp) WRITE(numout,*) ' lim_thd_glohec ' 490 IF(lwp) WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) / rdt_ice491 IF(lwp) WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) / rdt_ice492 IF(lwp) WRITE(numout,*) ' qt_in : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) / rdt_ice483 IF(lwp) WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 484 IF(lwp) WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 485 IF(lwp) WRITE(numout,*) ' qt_in : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 493 486 ! 494 487 END SUBROUTINE lim_thd_glohec … … 538 531 !-------------------- 539 532 DO ji = kideb, kiut 540 cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) )533 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 541 534 END DO 542 535 … … 597 590 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 598 591 WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 599 WRITE(numout,*) ' dq_i : ', - dq_i(ji,jl) / rdt_ice592 WRITE(numout,*) ' dq_i : ', - dq_i(ji,jl) * r1_rdtice 600 593 WRITE(numout,*) ' Fdt : ', sum_fluxq(ji,jl) 601 594 WRITE(numout,*) … … 631 624 WRITE(numout,*) 632 625 WRITE(numout,*) ' Layer by layer ... ' 633 WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice626 WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 634 627 WRITE(numout,*) ' dfc_snow : ', fc_s(ji,1) - fc_s(ji,0) 635 628 DO jk = 1, nlay_i 636 629 WRITE(numout,*) ' layer : ', jk 637 WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) / rdt_ice630 WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice 638 631 WRITE(numout,*) ' radab : ', radab(ji,jk) 639 632 WRITE(numout,*) ' dfc_i : ', fc_i(ji,jk) - fc_i(ji,jk-1) … … 681 674 fatm (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji) ! total heat flux 682 675 sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(zji,zjj,jl) 683 cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) )676 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 684 677 END DO 685 678 … … 688 681 !-------------------- 689 682 DO ji = kideb, kiut 690 cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) )683 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 691 684 END DO 692 685 … … 722 715 WRITE(numout,*) ' * ' 723 716 WRITE(numout,*) ' Ftotal : ', sum_fluxq(ji,jl) 724 WRITE(numout,*) ' dq_t : ', - dq_i(ji,jl) / rdt_ice725 WRITE(numout,*) ' dq_i : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) / rdt_ice726 WRITE(numout,*) ' dq_s : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice717 WRITE(numout,*) ' dq_t : ', - dq_i(ji,jl) * r1_rdtice 718 WRITE(numout,*) ' dq_i : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 719 WRITE(numout,*) ' dq_s : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 727 720 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 728 721 WRITE(numout,*) ' * ' … … 734 727 WRITE(numout,*) ' * ' 735 728 WRITE(numout,*) ' Heat contents --- : ' 736 WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) / rdt_ice737 WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) / rdt_ice738 WRITE(numout,*) ' qt_in : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) / rdt_ice739 WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) / rdt_ice740 WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) / rdt_ice741 WRITE(numout,*) ' qt_fin : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) / rdt_ice729 WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) * r1_rdtice 730 WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) * r1_rdtice 731 WRITE(numout,*) ' qt_in : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 732 WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) * r1_rdtice 733 WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) * r1_rdtice 734 WRITE(numout,*) ' qt_fin : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 742 735 WRITE(numout,*) ' * ' 743 736 WRITE(numout,*) ' Ice variables --- : ' -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r3294 r3625 7 7 !! ! 2005-06 (M. Vancoppenolle) 3D version 8 8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdmsnif & rdmicif 9 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 10 !! 3.5 ! 2012-10 (G. Madec & co) salt flux + bug fixes 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_lim3 … … 13 14 !! 'key_lim3' LIM3 sea-ice model 14 15 !!---------------------------------------------------------------------- 15 !! lim_thd_dh : vertical accr./abl. and lateral ablation of sea ice 16 !!---------------------------------------------------------------------- 17 USE par_oce ! ocean parameters 18 USE phycst ! physical constants (OCE directory) 19 USE sbc_oce ! Surface boundary condition: ocean fields 20 USE ice ! LIM variables 21 USE par_ice ! LIM parameters 22 USE thd_ice ! LIM thermodynamics 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays 16 !! lim_thd_dh : vertical accr./abl. and lateral ablation of sea ice 17 !!---------------------------------------------------------------------- 18 USE par_oce ! ocean parameters 19 USE phycst ! physical constants (OCE directory) 20 USE sbc_oce ! Surface boundary condition: ocean fields 21 USE ice ! LIM variables 22 USE par_ice ! LIM parameters 23 USE thd_ice ! LIM thermodynamics 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! work arrays 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 28 27 29 IMPLICIT NONE … … 37 39 38 40 !!---------------------------------------------------------------------- 39 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)41 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 40 42 !! $Id$ 41 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 71 73 !! 72 74 INTEGER :: ji , jk ! dummy loop indices 73 INTEGER :: zji, zjj ! 2D corresponding indices to ji75 INTEGER :: ii, ij ! 2D corresponding indices to ji 74 76 INTEGER :: isnow ! switch for presence (1) or absence (0) of snow 75 77 INTEGER :: isnowic ! snow ice formation not … … 102 104 REAL(wp), POINTER, DIMENSION(:) :: zfmass_i ! 103 105 104 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel 105 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre 106 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_sub 107 REAL(wp), POINTER, DIMENSION(:) :: z fsalt_melt ! salt flux due to ice melt106 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt 107 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre ! snow precipitation 108 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_sub ! snow sublimation 109 REAL(wp), POINTER, DIMENSION(:) :: zsfx_melt ! salt flux due to ice melt 108 110 109 111 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah … … 126 128 127 129 CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 128 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, z fsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy )130 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zsfx_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 129 131 CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 130 132 CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 131 133 132 z fsalt_melt(:)= 0._wp133 ftotal_fin(:) 134 zfdt_init (:)= 0._wp135 zfdt_final(:) 134 zsfx_melt (:) = 0._wp 135 ftotal_fin(:) = 0._wp 136 zfdt_init (:) = 0._wp 137 zfdt_final(:) = 0._wp 136 138 137 139 DO ji = kideb, kiut … … 145 147 ! 146 148 DO ji = kideb, kiut 147 isnow = INT( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ))148 ztfs (ji)= isnow * rtt + ( 1.0 - isnow ) * rtt149 z_f_surf (ji)= qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)150 z_f_surf (ji) = MAX( zzero , z_f_surf(ji) ) * MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ))149 isnow = INT( 1.0 - MAX( 0.0 , SIGN( 1.0 , - ht_s_b(ji) ) ) ) 150 ztfs (ji) = isnow * rtt + ( 1.0 - isnow ) * rtt 151 z_f_surf (ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 152 z_f_surf (ji) = MAX( zzero , z_f_surf(ji) ) * MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 151 153 zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice 152 154 END DO ! ji … … 240 242 zhsnew = ht_s_b(ji) + dh_s_tot(ji) 241 243 ! If snow is still present zhn = 1, else zhn = 0 242 zhn = 1.0 - MAX( zzero , SIGN( zone , - zhsnew ))244 zhn = 1.0 - MAX( zzero , SIGN( zone , - zhsnew ) ) 243 245 ht_s_b(ji) = MAX( zzero , zhsnew ) 244 246 ! Volume and mass variations of snow 245 dvsbq_1d (ji) = a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_ mel(ji) )247 dvsbq_1d (ji) = a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 246 248 dvsbq_1d (ji) = MIN( zzero, dvsbq_1d(ji) ) 247 rdm snif_1d(ji) = rdmsnif_1d(ji) + rhosn * dvsbq_1d(ji)249 rdm_snw_1d(ji) = rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 248 250 END DO ! ji 249 251 … … 253 255 DO ji = kideb, kiut 254 256 dh_i_surf(ji) = 0._wp 255 z_f_surf (ji) = zqfont_su(ji) / rdt_ice! heat conservation test257 z_f_surf (ji) = zqfont_su(ji) * r1_rdtice ! heat conservation test 256 258 zdq_i (ji) = 0._wp 257 259 END DO ! ji … … 262 264 zdeltah (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk) 263 265 ! ! recompute heat available 264 zqfont_su(ji )= MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk)266 zqfont_su(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 265 267 ! ! melt of layer jk cannot be higher than its thickness 266 268 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 267 269 ! ! update surface melt 268 dh_i_surf(ji )= dh_i_surf(ji) + zdeltah(ji,jk)270 dh_i_surf(ji ) = dh_i_surf(ji) + zdeltah(ji,jk) 269 271 ! ! for energy conservation 270 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice272 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 271 273 ! 272 ! contribution to ice-ocean salt flux 273 zji = MOD( npb(ji) - 1 , jpi ) + 1 274 zjj = ( npb(ji) - 1 ) / jpi + 1 275 zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji) ) * a_i_b(ji) & 276 & * MIN( zdeltah(ji,jk) , 0.e0 ) * rhoic / rdt_ice 274 ! ! contribution to ice-ocean salt flux 275 zsfx_melt(ji) = zsfx_melt(ji) - sm_i_b(ji) * a_i_b(ji) * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 277 276 END DO 278 277 END DO … … 290 289 IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN! 291 290 WRITE(numout,*) ' ALERTE heat loss for surface melt ' 292 WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl291 WRITE(numout,*) ' ii, ij, jl :', ii, ij, jl 293 292 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 294 293 WRITE(numout,*) ' z_f_surf : ', z_f_surf(ji) … … 299 298 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 300 299 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 301 WRITE(numout,*) ' sss_m : ', sss_m( zji,zjj)300 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij) 302 301 ENDIF 303 302 END DO … … 338 337 DO ji = kideb, kiut 339 338 ! In case of disparition of the snow, we have to update the snow temperatures 340 zhisn = MAX( zzero , SIGN( zone, - ht_s_b(ji) ))339 zhisn = MAX( zzero , SIGN( zone, - ht_s_b(ji) ) ) 341 340 t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 342 341 q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) … … 358 357 ! 4.1 Basal growth - (a) salinity not varying in time 359 358 !----------------------------------------------------- 360 IF( num_sal /= 2 .AND. num_sal /= 4 ) THEN361 DO ji = kideb, kiut 362 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0. 0) THEN359 IF( num_sal /= 2 ) THEN ! ice salinity constant in time 360 DO ji = kideb, kiut 361 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0._wp ) THEN 363 362 s_i_new(ji) = sm_i_b(ji) 364 363 ! Melting point in K … … 371 370 & - rcp * ( ztmelts - rtt ) ) 372 371 ! Basal growth rate = - F*dt / q 373 dh_i_bott(ji) = - rdt_ice *( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)372 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 374 373 ENDIF 375 374 END DO … … 379 378 ! 4.1 Basal growth - (b) salinity varying in time 380 379 !------------------------------------------------- 381 IF( num_sal == 2 .OR. num_sal == 4 ) THEN 382 ! the growth rate (dh_i_bott) is function of the new ice 383 ! heat content (q_i_b(nlay_i+1)). q_i_b depends on the new ice 384 ! salinity (snewice). snewice depends on dh_i_bott 385 ! it converges quickly, so, no problem 380 IF( num_sal == 2 ) THEN 381 ! the growth rate (dh_i_bott) is function of the new ice heat content (q_i_b(nlay_i+1)). 382 ! q_i_b depends on the new ice salinity (snewice). 383 ! snewice depends on dh_i_bott ; it converges quickly, so, no problem 386 384 ! See Vancoppenolle et al., OM08 for more info on this 387 385 … … 394 392 DO ji = kideb, kiut 395 393 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0 ) THEN 396 zji = MOD( npb(ji) - 1, jpi ) + 1397 zjj = ( npb(ji) - 1 ) / jpi + 1394 ii = MOD( npb(ji) - 1, jpi ) + 1 395 ij = ( npb(ji) - 1 ) / jpi + 1 398 396 ! Melting point in K 399 397 ztmelts = - tmut * s_i_new(ji) + rtt … … 408 406 ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8 409 407 ! zswi1 (1) if dh_i_bott/rdt .LT. 2.0e-8 410 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) / rdt_ice , epsi13 ) )408 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi13 ) ) 411 409 zswi2 = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) ) 412 410 zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) … … 414 412 zfracs = zswi1 * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) & 415 413 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) 416 zds = zfracs * sss_m( zji,zjj) - s_i_new(ji)417 s_i_new(ji) = zfracs * sss_m( zji,zjj)414 zds = zfracs * sss_m(ii,ij) - s_i_new(ji) 415 s_i_new(ji) = zfracs * sss_m(ii,ij) 418 416 ENDIF ! fc_bo_i 419 417 END DO ! ji … … 432 430 & - rcp * ( ztmelts - rtt ) ) 433 431 ! Basal growth rate = - F*dt / q 434 dh_i_bott(ji) = - rdt_ice *( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)432 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 435 433 ! Salinity update 436 434 ! entrapment during bottom growth … … 453 451 s_i_new(ji) = s_i_b(ji,nlay_i) 454 452 zqfont_bo(ji) = rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 455 zfbase(ji) = zqfont_bo(ji) / rdt_ice ! heat conservation test453 zfbase(ji) = zqfont_bo(ji) * r1_rdtice ! heat conservation test 456 454 zdq_i(ji) = 0._wp 457 455 dh_i_bott(ji) = 0._wp … … 461 459 DO jk = nlay_i, 1, -1 462 460 DO ji = kideb, kiut 463 IF ( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .GE. 0.0 ) THEN 464 ztmelts = - tmut * s_i_b(ji,jk) + rtt 465 IF( t_i_b(ji,jk) >= ztmelts ) THEN 466 zdeltah(ji,jk) = - zh_i(ji) 467 dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) 468 zinnermelt(ji) = 1._wp 469 ELSE ! normal ablation 470 zdeltah(ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 471 zqfont_bo(ji) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 472 zdeltah(ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 473 dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) 474 zdq_i(ji) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice 475 ! contribution to salt flux 476 zji = MOD( npb(ji) - 1, jpi ) + 1 477 zjj = ( npb(ji) - 1 ) / jpi + 1 478 zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji) ) * a_i_b(ji) & 479 & * MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice 461 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN 462 ztmelts = - tmut * s_i_b(ji,jk) + rtt 463 IF( t_i_b(ji,jk) >= ztmelts ) THEN !!gm : a comment is needed 464 zdeltah (ji,jk) = - zh_i(ji) 465 dh_i_bott (ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 466 zinnermelt(ji ) = 1._wp 467 ELSE ! normal ablation 468 zdeltah (ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 469 zqfont_bo(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 470 zdeltah (ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 471 dh_i_bott(ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 472 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 480 473 ENDIF 474 ! contribution to salt flux 475 zsfx_melt(ji) = zsfx_melt(ji) - sm_i_b(ji) * a_i_b(ji) * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 481 476 ENDIF 482 477 END DO ! ji … … 493 488 ENDIF 494 489 IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN 495 WRITE(numout,*) ' ALERTE heat loss for basal melt : zji, zjj, jl :', zji, zjj, jl490 WRITE(numout,*) ' ALERTE heat loss for basal melt : ii, ij, jl :', ii, ij, jl 496 491 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 497 492 WRITE(numout,*) ' zfbase : ', zfbase(ji) … … 502 497 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 503 498 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 504 WRITE(numout,*) ' sss_m : ', sss_m( zji,zjj)499 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij) 505 500 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 506 501 WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) ) … … 531 526 ! ! excessive energy is sent to lateral ablation 532 527 fsup (ji) = rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi13 ) & 533 & * ( zdhbf - dh_i_bott(ji) ) / rdt_ice528 & * ( zdhbf - dh_i_bott(ji) ) * r1_rdtice 534 529 dh_i_bott(ji) = zdhbf 535 530 ! !since ice volume is only used for outputs, we keep it global for all categories … … 538 533 zhgnew (ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 539 534 ! ! diagnostic ( bottom ice growth ) 540 zji = MOD( npb(ji) - 1, jpi ) + 1541 zjj = ( npb(ji) - 1 ) / jpi + 1542 diag_bot_gr( zji,zjj) = diag_bot_gr(zji,zjj) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice543 diag_sur_me( zji,zjj) = diag_sur_me(zji,zjj) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) / rdt_ice544 diag_bot_me( zji,zjj) = diag_bot_me(zji,zjj) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice535 ii = MOD( npb(ji) - 1, jpi ) + 1 536 ij = ( npb(ji) - 1 ) / jpi + 1 537 diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 538 diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 539 diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 545 540 END DO 546 541 … … 548 543 ! 5.2 More than available ice melts 549 544 !----------------------------------- 550 ! then heat applied minus heat content at previous time step 551 ! should equal heat remaining 545 ! then heat applied minus heat content at previous time step should equal heat remaining 552 546 ! 553 547 DO ji = kideb, kiut 554 548 ! Adapt the remaining energy if too much ice melts 555 549 !-------------------------------------------------- 556 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice550 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) ! =1 if ice 557 551 ! 0 if no more ice 558 552 zhgnew (ji) = zihgnew * zhgnew(ji) ! ice thickness is put to 0 … … 562 556 ! If snow remains, energy is used to melt snow 563 557 zhni = ht_s_b(ji) ! snow depth at previous time step 564 zihg = MAX( zzero , SIGN ( zone , - ht_s_b(ji) ) ) !0 if snow558 zihg = MAX( zzero , SIGN ( zone , - ht_s_b(ji) ) ) ! =0 if snow 565 559 566 560 ! energy of melting of remaining snow 567 561 zqt_s(ji) = ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi13 ) 568 562 zdhnm = - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 ) 569 zhnfi 563 zhnfi = zhni + zdhnm 570 564 zfdt_final(ji) = MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 571 565 ht_s_b(ji) = MAX( zzero , zhnfi ) … … 581 575 ! 582 576 ! ! mass variation cumulated over category 583 rdm snif_1d(ji) = rdmsnif_1d(ji) + zzfmass_s ! snow584 rdm icif_1d(ji) = rdmicif_1d(ji) + zzfmass_i ! ice577 rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s ! snow 578 rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i ! ice 585 579 586 580 ! Remaining heat to the ocean 587 581 !--------------------------------- 588 focea(ji) = - zfdt_final(ji) / rdt_ice ! focea is in W.m-2 * dt589 590 END DO 591 592 ftotal_fin (:) = zfdt_final(:) / rdt_ice582 focea(ji) = - zfdt_final(ji) * r1_rdtice ! focea is in W.m-2 * dt 583 584 END DO 585 586 ftotal_fin (:) = zfdt_final(:) * r1_rdtice 593 587 594 588 !--------------------------- … … 596 590 !--------------------------- 597 591 DO ji = kideb, kiut 598 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) ! 1 if ice599 592 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) ! =1 if ice 593 ! 600 594 ! Salt flux 601 zji = MOD( npb(ji) - 1, jpi ) + 1 602 zjj = ( npb(ji) - 1 ) / jpi + 1 603 ! new lines 604 IF( num_sal == 4 ) THEN 605 fseqv_1d(ji) = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) & 606 & + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - bulk_sal ) / rdt_ice 607 ELSE 608 fseqv_1d(ji) = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) & 609 & + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 610 ENDIF 595 sfx_thd_1d(ji) = sfx_thd_1d(ji) + zihgnew * zsfx_melt(ji) & 596 & - (1.0 - zihgnew) * zfmass_i (ji) * sm_i_b(ji) * r1_rdtice 597 ! 611 598 ! Heat flux 612 599 ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 613 ! excessive total ablation energy (focea) sent to the ocean600 ! excessive total ablation energy (focea) sent to the ocean 614 601 qfvbq_1d(ji) = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice 615 602 616 zihic = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) ) 617 ! equals 0 if ht_i = 0, 1 if ht_i gt 0 603 zihic = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) ) ! equals 0 if ht_i = 0, 1 if ht_i gt 0 618 604 fscbq_1d(ji) = a_i_b(ji) * fstbif_1d(ji) 619 qldif_1d(ji) = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea (ji)* a_i_b(ji) * rdt_ice &605 qldif_1d(ji) = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea (ji) * a_i_b(ji) * rdt_ice & 620 606 & + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice 621 607 END DO ! ji … … 656 642 dmgwi_1d (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 657 643 658 rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic 659 rdmsnif_1d(ji) = rdmsnif_1d(ji) + a_i_b(ji) * ( zhnnew - ht_s_b(ji) ) * rhosn 644 ! All snow is thrown in the ocean, and seawater is taken to replace the volume 645 rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic * ( 1. - rhosn / rhoic ) 646 rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew - ht_s_b(ji) ) * rhosn 660 647 661 648 ! Equivalent salt flux (1) Snow-ice formation component 662 649 ! ----------------------------------------------------- 663 zji = MOD( npb(ji) - 1, jpi ) + 1664 zjj = ( npb(ji) - 1 ) / jpi + 1665 666 IF( num_sal /= 2 ) THEN ; zsm_snowice = sm_i_b(ji)667 ELSE ; zsm_snowice = ( rhoic - rhosn ) / rhoic * sss_m(zji,zjj)650 ii = MOD( npb(ji) - 1, jpi ) + 1 651 ij = ( npb(ji) - 1 ) / jpi + 1 652 653 IF( num_sal == 2 ) THEN ; zsm_snowice = sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic 654 ELSE ; zsm_snowice = sm_i_b(ji) 668 655 ENDIF 669 IF( num_sal == 4 ) THEN 670 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal ) * a_i_b(ji) & 671 & * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 672 ELSE 673 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - zsm_snowice ) * a_i_b(ji) & 674 & * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 675 ENDIF 656 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 657 ! 676 658 ! entrapment during snow ice formation 677 659 i_ice_switch = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - ht_i_b(ji) + 1.0e-6 ) ) 678 660 isnowic = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - dh_snowice(ji) ) ) * i_ice_switch 679 IF( num_sal == 2 .OR. num_sal == 4) &680 dsm_i_si_1d(ji) = ( zsm_snowice*dh_snowice(ji)&681 & + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13) &682 & - sm_i_b(ji)) * isnowic661 IF( num_sal == 2 ) & 662 dsm_i_si_1d(ji) = ( zsm_snowice * dh_snowice(ji) & 663 & + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13 ) & 664 & - sm_i_b(ji) ) * isnowic 683 665 684 666 ! Actualize new snow and ice thickness. … … 690 672 691 673 ! diagnostic ( snow ice growth ) 692 zji = MOD( npb(ji) - 1, jpi ) + 1693 zjj = ( npb(ji) - 1 ) / jpi + 1694 diag_sni_gr( zji,zjj) = diag_sni_gr(zji,zjj) + dh_snowice(ji)*a_i_b(ji) / rdt_ice674 ii = MOD( npb(ji) - 1, jpi ) + 1 675 ij = ( npb(ji) - 1 ) / jpi + 1 676 diag_sni_gr(ii,ij) = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice 695 677 ! 696 678 END DO !ji 697 679 ! 698 680 CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 699 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, z fsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy )681 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zsfx_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 700 682 CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 701 683 CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r3610 r3625 15 15 !! 'key_lim3' LIM3 sea-ice model 16 16 !!---------------------------------------------------------------------- 17 USE par_oce ! ocean parameters 18 USE phycst ! physical constants (ocean directory) 19 USE ice ! LIM-3 variables 20 USE par_ice ! LIM-3 parameters 21 USE thd_ice ! LIM-3: thermodynamics 22 USE in_out_manager ! I/O manager 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays 17 USE par_oce ! ocean parameters 18 USE phycst ! physical constants (ocean directory) 19 USE ice ! LIM-3 variables 20 USE par_ice ! LIM-3 parameters 21 USE thd_ice ! LIM-3: thermodynamics 22 USE in_out_manager ! I/O manager 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 26 26 27 IMPLICIT NONE … … 33 34 34 35 !!---------------------------------------------------------------------- 35 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)36 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 36 37 !! $Id$ 37 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 147 148 REAL(wp), DIMENSION(kiut,jkmax+2) :: zdiagbis 148 149 REAL(wp), DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 149 !!------------------------------------------------------------------ 150 150 !!------------------------------------------------------------------ 151 151 ! 152 152 !------------------------------------------------------------------------------! … … 156 156 DO ji = kideb , kiut 157 157 ! is there snow or not 158 isnow(ji)= INT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) )) )158 isnow(ji)= INT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) ) ) 159 159 ! surface temperature of fusion 160 160 !!gm ??? ztfs(ji) = rtt !!!???? … … 201 201 DO ji = kideb , kiut 202 202 ! switches 203 isnow(ji) = INT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) )) )203 isnow(ji) = INT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) ) 204 204 ! hs > 0, isnow = 1 205 205 zhsu (ji) = hnzst ! threshold for the computation of i0 … … 262 262 ! just to check energy conservation 263 263 DO ji = kideb, kiut 264 ii = MOD( npb(ji) - 1, jpi ) + 1265 ij =( npb(ji) - 1 ) / jpi + 1264 ii = MOD( npb(ji) - 1 , jpi ) + 1 265 ij = ( npb(ji) - 1 ) / jpi + 1 266 266 fstroc(ii,ij,jl) = zradtr_i(ji,nlay_i) 267 267 END DO … … 273 273 END DO 274 274 END DO 275 276 275 277 276 ! … … 662 661 663 662 ! surface temperature 664 isnow(ji) = INT( 1.0-max(0.0,sign(1.0,-ht_s_b(ji))))663 isnow(ji) = INT( 1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) ) ) ) 665 664 ztsuoldit(ji) = t_su_b(ji) 666 IF (t_su_b(ji) .LT. ztfs(ji))&665 IF( t_su_b(ji) < ztfs(ji) ) & 667 666 t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( isnow(ji)*t_s_b(ji,1) & 668 667 & + (1.0-isnow(ji))*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji)) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r3294 r3625 16 16 !! 'key_lim3' LIM3 sea-ice model 17 17 !!---------------------------------------------------------------------- 18 !! lim_thd_ent : ice redistribution of enthalpy18 !! lim_thd_ent : ice redistribution of enthalpy 19 19 !!---------------------------------------------------------------------- 20 USE par_oce ! ocean parameters 21 USE dom_oce ! domain variables 22 USE domain ! 23 USE phycst ! physical constants 24 USE ice ! LIM variables 25 USE par_ice ! LIM parameters 26 USE thd_ice ! LIM thermodynamics 27 USE limvar ! LIM variables 28 USE in_out_manager ! I/O manager 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays 20 USE par_oce ! ocean parameters 21 USE dom_oce ! domain variables 22 USE domain ! 23 USE phycst ! physical constants 24 USE ice ! LIM variables 25 USE par_ice ! LIM parameters 26 USE thd_ice ! LIM thermodynamics 27 USE limvar ! LIM variables 28 USE in_out_manager ! I/O manager 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 32 32 33 IMPLICIT NONE … … 43 44 44 45 !!---------------------------------------------------------------------- 45 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)46 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 46 47 !! $Id$ 47 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 408 409 IF ( con_i ) THEN 409 410 DO ji = kideb, kiut 410 IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice .GT.1.0e-6 ) THEN411 IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 411 412 zji = MOD( npb(ji) - 1, jpi ) + 1 412 413 zjj = ( npb(ji) - 1 ) / jpi + 1 413 414 WRITE(numout,*) ' violation of heat conservation : ', & 414 ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice415 ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 415 416 WRITE(numout,*) ' ji, jj : ', zji, zjj 416 417 WRITE(numout,*) ' ht_s_b : ', ht_s_b(ji) 417 WRITE(numout,*) ' zqts_in : ', zqts_in (ji) / rdt_ice418 WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) / rdt_ice418 WRITE(numout,*) ' zqts_in : ', zqts_in (ji) * r1_rdtice 419 WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) * r1_rdtice 419 420 WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 420 421 WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) … … 526 527 ! bottom formation temperature 527 528 ztform = t_i_b(ji,nlay_i) 528 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) )ztform = t_bo_b(ji)529 IF( num_sal == 2 ) ztform = t_bo_b(ji) 529 530 qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji)) & ! case of melting ice 530 531 & + icboswi(ji) * rhoic * ( cpic*(ztmelts-ztform) & ! case of forming ice … … 622 623 ! 623 624 DO ji = kideb, kiut 624 IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice .GT.1.0e-6 ) THEN625 IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 625 626 zji = MOD( npb(ji) - 1, jpi ) + 1 626 627 zjj = ( npb(ji) - 1 ) / jpi + 1 627 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice628 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 628 629 WRITE(numout,*) ' ji, jj : ', zji, zjj 629 630 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 630 WRITE(numout,*) ' zqti_in : ', zqti_in (ji) / rdt_ice631 WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) / rdt_ice631 WRITE(numout,*) ' zqti_in : ', zqti_in (ji) * r1_rdtice 632 WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 632 633 WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 633 634 WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r3294 r3625 13 13 !! 'key_lim3' LIM3 sea-ice model 14 14 !!---------------------------------------------------------------------- 15 !! lim_lat_acr : lateral accretion of ice 16 !!---------------------------------------------------------------------- 17 USE par_oce ! ocean parameters 18 USE dom_oce ! domain variables 19 USE phycst ! physical constants 20 USE sbc_oce ! Surface boundary condition: ocean fields 21 USE sbc_ice ! Surface boundary condition: ice fields 22 USE thd_ice ! LIM thermodynamics 23 USE dom_ice ! LIM domain 24 USE par_ice ! LIM parameters 25 USE ice ! LIM variables 26 USE limtab ! LIM 2D <==> 1D 27 USE limcons ! LIM conservation 28 USE in_out_manager ! I/O manager 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays 15 !! lim_lat_acr : lateral accretion of ice 16 !!---------------------------------------------------------------------- 17 USE par_oce ! ocean parameters 18 USE dom_oce ! domain variables 19 USE phycst ! physical constants 20 USE sbc_oce ! Surface boundary condition: ocean fields 21 USE sbc_ice ! Surface boundary condition: ice fields 22 USE thd_ice ! LIM thermodynamics 23 USE dom_ice ! LIM domain 24 USE par_ice ! LIM parameters 25 USE ice ! LIM variables 26 USE limtab ! LIM 2D <==> 1D 27 USE limcons ! LIM conservation 28 USE in_out_manager ! I/O manager 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 32 32 33 IMPLICIT NONE … … 45 46 46 47 !!---------------------------------------------------------------------- 47 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)48 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 48 49 !! $Id$ 49 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 77 78 !! update ht_s_b, ht_i_b and tbif_1d(:,:) 78 79 !!------------------------------------------------------------------------ 79 INTEGER :: ji,jj,jk,jl,jm ! dummy loop indices80 INTEGER :: layer, nbpac ! local integers81 INTEGER :: zji, zjj, iter ! - -82 REAL(wp) :: ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zde! local scalars80 INTEGER :: ji,jj,jk,jl,jm ! dummy loop indices 81 INTEGER :: layer, nbpac ! local integers 82 INTEGER :: zji, zjj, iter ! - - 83 REAL(wp) :: ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zde ! local scalars 83 84 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new ! - - 84 85 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - 86 REAL(wp) :: zcoef ! - - 85 87 LOGICAL :: iterate_frazil ! iterate frazil ice collection thickness 86 88 CHARACTER (len = 15) :: fieldid … … 143 145 ! 1) Conservation check and changes in each ice category 144 146 !------------------------------------------------------------------------------! 145 IF 146 CALL lim_column_sum (jpl, v_i, vt_i_init)147 CALL lim_column_sum (jpl, v_s, vt_s_init)148 CALL lim_column_sum_energy ( jpl, nlay_i, e_i, et_i_init)149 CALL lim_column_sum (jpl,e_s(:,:,1,:) , et_s_init)147 IF( con_i ) THEN 148 CALL lim_column_sum ( jpl, v_i , vt_i_init) 149 CALL lim_column_sum ( jpl, v_s , vt_s_init) 150 CALL lim_column_sum_energy ( jpl, nlay_i , e_i , et_i_init) 151 CALL lim_column_sum ( jpl, e_s(:,:,1,:) , et_s_init) 150 152 ENDIF 151 153 … … 158 160 DO ji = 1, jpi 159 161 !Energy of melting q(S,T) [J.m-3] 160 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / & 161 MAX( area(ji,jj) * v_i(ji,jj,jl) , epsi10 ) * & 162 nlay_i 163 zindb = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) !0 if no ice and 1 if yes 164 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl)*unit_fac*zindb 162 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) , epsi10 ) * nlay_i 163 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) ) ) !0 if no ice and 1 if yes 164 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 165 165 END DO 166 166 END DO … … 182 182 ! 183 183 184 zvrel(:,:) = 0. 0184 zvrel(:,:) = 0._wp 185 185 186 186 ! Default new ice thickness 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 hicol(ji,jj) = hiccrit(1) 190 END DO 191 END DO 192 193 IF (fraz_swi.eq.1.0) THEN 187 hicol(:,:) = hiccrit(1) 188 189 IF( fraz_swi == 1._wp ) THEN 194 190 195 191 !-------------------- 196 192 ! Physical constants 197 193 !-------------------- 198 hicol(:,:) = 0. 0194 hicol(:,:) = 0._wp 199 195 200 196 zhicrit = 0.04 ! frazil ice thickness … … 211 207 !------------- 212 208 ! C-grid wind stress components 213 ztaux = ( utau_ice(ji-1,jj ) * tmu(ji-1,jj ) &214 & + utau_ice(ji ,jj ) * tmu(ji ,jj ) ) / 2.0215 ztauy = ( vtau_ice(ji ,jj-1) * tmv(ji ,jj-1) &216 & + vtau_ice(ji ,jj ) * tmv(ji ,jj ) ) / 2.0209 ztaux = ( utau_ice(ji-1,jj ) * tmu(ji-1,jj ) & 210 & + utau_ice(ji ,jj ) * tmu(ji ,jj ) ) * 0.5_wp 211 ztauy = ( vtau_ice(ji ,jj-1) * tmv(ji ,jj-1) & 212 & + vtau_ice(ji ,jj ) * tmv(ji ,jj ) ) * 0.5_wp 217 213 ! Square root of wind stress 218 214 ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) … … 228 224 !------------------- 229 225 ! C-grid ice velocity 230 zindb = MAX( 0.0, SIGN(1.0, at_i(ji,jj) ))231 zvgx = zindb * ( u_ice(ji-1,jj ) * tmu(ji-1,jj )&232 + u_ice(ji,jj ) * tmu(ji ,jj ) ) / 2.0233 zvgy = zindb * ( v_ice(ji ,jj-1) * tmv(ji ,jj-1)&234 + v_ice(ji,jj ) * tmv(ji ,jj ) ) / 2.0226 zindb = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) ) ) 227 zvgx = zindb * ( u_ice(ji-1,jj ) * tmu(ji-1,jj ) & 228 & + u_ice(ji,jj ) * tmu(ji ,jj ) ) * 0.5_wp 229 zvgy = zindb * ( v_ice(ji ,jj-1) * tmv(ji ,jj-1) & 230 & + v_ice(ji,jj ) * tmv(ji ,jj ) ) * 0.5_wp 235 231 236 232 !----------------------------------- … … 238 234 !----------------------------------- 239 235 ! absolute relative velocity 240 zvrel2 = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) + & 241 ( zvfry - zvgy ) * ( zvfry - zvgy ) & 242 , 0.15 * 0.15 ) 243 zvrel(ji,jj) = SQRT(zvrel2) 236 zvrel2 = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) & 237 & + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) 238 zvrel(ji,jj) = SQRT( zvrel2 ) 244 239 245 240 !--------------------- … … 247 242 !--------------------- 248 243 hicol(ji,jj) = zhicrit + 0.1 249 hicol(ji,jj) = zhicrit + hicol(ji,jj) / & 250 ( hicol(ji,jj) * hicol(ji,jj) - & 251 zhicrit * zhicrit ) * ztwogp * zvrel2 244 hicol(ji,jj) = zhicrit + hicol(ji,jj) & 245 & / ( hicol(ji,jj) * hicol(ji,jj) - zhicrit * zhicrit ) * ztwogp * zvrel2 246 247 !!gm better coding: above: hicol(ji,jj) * hicol(ji,jj) = (zhicrit + 0.1)*(zhicrit + 0.1) 248 !!gm = zhicrit**2 + 0.2*zhicrit +0.01 249 !!gm therefore the 2 lines with hicol can be replaced by 1 line: 250 !!gm hicol(ji,jj) = zhicrit + (zhicrit + 0.1) / ( 0.2 * zhicrit + 0.01 ) * ztwogp * zvrel2 251 !!gm further more (zhicrit + 0.1)/(0.2 * zhicrit + 0.01 )*ztwogp can be computed one for all outside the DO loop 252 252 253 253 iter = 1 … … 284 284 DO jj = 1, jpj 285 285 DO ji = 1, jpi 286 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0) THEN286 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0._wp ) THEN 287 287 nbpac = nbpac + 1 288 288 npac( nbpac ) = (jj - 1) * jpi + ji 289 IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 290 jiindex_1d = nbpac 291 ENDIF 289 IF( ji == jiindx .AND. jj == jjindx ) jiindex_1d = nbpac 292 290 ENDIF 293 291 END DO 294 292 END DO 295 293 296 IF( ln_nicep ) THEN 297 WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 298 ENDIF 294 IF( ln_nicep ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 299 295 300 296 !------------------------------ … … 306 302 IF ( nbpac > 0 ) THEN 307 303 308 CALL tab_2d_1d( nbpac, zat_i_ac (1:nbpac) , at_i , & 309 jpi, jpj, npac(1:nbpac) ) 304 CALL tab_2d_1d( nbpac, zat_i_ac (1:nbpac) , at_i , jpi, jpj, npac(1:nbpac) ) 310 305 DO jl = 1, jpl 311 CALL tab_2d_1d( nbpac, za_i_ac(1:nbpac,jl) , a_i(:,:,jl) , & 312 jpi, jpj, npac(1:nbpac) ) 313 CALL tab_2d_1d( nbpac, zv_i_ac(1:nbpac,jl) , v_i(:,:,jl) , & 314 jpi, jpj, npac(1:nbpac) ) 315 CALL tab_2d_1d( nbpac, zoa_i_ac(1:nbpac,jl) , oa_i(:,:,jl) , & 316 jpi, jpj, npac(1:nbpac) ) 317 CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl), & 318 jpi, jpj, npac(1:nbpac) ) 306 CALL tab_2d_1d( nbpac, za_i_ac (1:nbpac,jl), a_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 307 CALL tab_2d_1d( nbpac, zv_i_ac (1:nbpac,jl), v_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 308 CALL tab_2d_1d( nbpac, zoa_i_ac (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 309 CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 319 310 DO jk = 1, nlay_i 320 CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , & 321 jpi, jpj, npac(1:nbpac) ) 311 CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 322 312 END DO ! jk 323 313 END DO ! jl 324 314 325 CALL tab_2d_1d( nbpac, qldif_1d (1:nbpac) , qldif , & 326 jpi, jpj, npac(1:nbpac) ) 327 CALL tab_2d_1d( nbpac, qcmif_1d (1:nbpac) , qcmif , & 328 jpi, jpj, npac(1:nbpac) ) 329 CALL tab_2d_1d( nbpac, t_bo_b (1:nbpac) , t_bo , & 330 jpi, jpj, npac(1:nbpac) ) 331 CALL tab_2d_1d( nbpac, fseqv_1d (1:nbpac) , fseqv , & 332 jpi, jpj, npac(1:nbpac) ) 333 CALL tab_2d_1d( nbpac, hicol_b (1:nbpac) , hicol , & 334 jpi, jpj, npac(1:nbpac) ) 335 CALL tab_2d_1d( nbpac, zvrel_ac (1:nbpac) , zvrel , & 336 jpi, jpj, npac(1:nbpac) ) 315 CALL tab_2d_1d( nbpac, qldif_1d (1:nbpac) , qldif , jpi, jpj, npac(1:nbpac) ) 316 CALL tab_2d_1d( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) ) 317 CALL tab_2d_1d( nbpac, t_bo_b (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 318 CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac) , sfx_thd, jpi, jpj, npac(1:nbpac) ) 319 CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac) , rdm_ice, jpi, jpj, npac(1:nbpac) ) 320 CALL tab_2d_1d( nbpac, hicol_b (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 321 CALL tab_2d_1d( nbpac, zvrel_ac (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 337 322 338 323 !------------------------------------------------------------------------------! … … 344 329 !---------------------- 345 330 DO ji = 1, nbpac 346 zh_newice(ji) 347 END DO 348 IF ( fraz_swi .EQ. 1.0 )zh_newice(:) = hicol_b(:)331 zh_newice(ji) = hiccrit(1) 332 END DO 333 IF( fraz_swi == 1.0 ) zh_newice(:) = hicol_b(:) 349 334 350 335 !---------------------- … … 352 337 !---------------------- 353 338 354 IF ( num_sal .EQ. 1 ) THEN 355 zs_newice(:) = bulk_sal 356 ENDIF ! num_sal 357 358 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 359 360 DO ji = 1, nbpac 361 zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max ) 362 zji = MOD( npac(ji) - 1, jpi ) + 1 363 zjj = ( npac(ji) - 1 ) / jpi + 1 364 zs_newice(ji) = MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) ) 365 END DO ! jl 366 367 ENDIF ! num_sal 368 369 IF ( num_sal .EQ. 3 ) THEN 370 zs_newice(:) = 2.3 371 ENDIF ! num_sal 339 SELECT CASE ( num_sal ) 340 CASE ( 1 ) ! Sice = constant 341 zs_newice(:) = bulk_sal 342 CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)] 343 DO ji = 1, nbpac 344 zji = MOD( npac(ji) - 1 , jpi ) + 1 345 zjj = ( npac(ji) - 1 ) / jpi + 1 346 zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(zji,zjj) ) 347 END DO 348 CASE ( 3 ) ! Sice = F(z) [multiyear ice] 349 zs_newice(:) = 2.3 350 END SELECT 351 372 352 373 353 !------------------------- … … 376 356 ! We assume that new ice is formed at the seawater freezing point 377 357 DO ji = 1, nbpac 378 ztmelts = - tmut * zs_newice(ji) + rtt ! Melting point (K) 379 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 380 + lfus * ( 1.0 - ( ztmelts - rtt ) & 381 / ( t_bo_b(ji) - rtt ) ) & 382 - rcp * ( ztmelts-rtt ) ) 383 ze_newice(ji) = MAX( ze_newice(ji) , 0.0 ) + & 384 MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) ) & 385 * rhoic * lfus 358 ztmelts = - tmut * zs_newice(ji) + rtt ! Melting point (K) 359 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 360 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 361 & - rcp * ( ztmelts - rtt ) ) 362 ze_newice(ji) = MAX( ze_newice(ji) , 0._wp ) & 363 & + MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) ) * rhoic * lfus 386 364 END DO ! ji 387 365 !---------------- … … 389 367 !---------------- 390 368 DO ji = 1, nbpac 391 zo_newice(ji) = 0.0369 zo_newice(ji) = 0._wp 392 370 END DO ! ji 393 371 … … 396 374 !-------------------------- 397 375 DO ji = 1, nbpac 398 zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)!<0376 zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji) !<0 399 377 END DO ! ji 400 378 … … 403 381 !------------------- 404 382 DO ji = 1, nbpac 405 zv_newice(ji) 383 zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 406 384 407 385 ! A fraction zfrazb of frazil ice is accreted at the ice bottom 408 zfrazb = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) & 409 + 1.0 ) / 2.0 * maxfrazb 410 zdh_frazb(ji) = zfrazb*zv_newice(ji) 386 zfrazb = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 387 zdh_frazb(ji) = zfrazb * zv_newice(ji) 411 388 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 412 389 END DO … … 415 392 ! Salt flux due to new ice growth 416 393 !--------------------------------- 417 IF ( ( num_sal .EQ. 4 ) ) THEN 418 DO ji = 1, nbpac 419 zji = MOD( npac(ji) - 1, jpi ) + 1 420 zjj = ( npac(ji) - 1 ) / jpi + 1 421 fseqv_1d(ji) = fseqv_1d(ji) + & 422 ( sss_m(zji,zjj) - bulk_sal ) * rhoic * & 423 zv_newice(ji) / rdt_ice 424 END DO 425 ELSE 426 DO ji = 1, nbpac 427 zji = MOD( npac(ji) - 1, jpi ) + 1 428 zjj = ( npac(ji) - 1 ) / jpi + 1 429 fseqv_1d(ji) = fseqv_1d(ji) + & 430 ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic * & 431 zv_newice(ji) / rdt_ice 432 END DO ! ji 433 ENDIF 394 ! note that for constant salinity zs_newice() = bulk_sal (see top of the subroutine) 395 DO ji = 1, nbpac 396 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zs_newice(ji) * rhoic * zv_newice(ji) * r1_rdtice 397 rdm_ice_1d(ji) = rdm_ice_1d(ji) + rhoic * zv_newice(ji) 398 END DO ! ji 434 399 435 400 !------------------------------------ … … 437 402 !------------------------------------ 438 403 DO ji = 1, nbpac 439 ! Volume440 zj i = MOD( npac(ji) - 1, jpi )+ 1441 zjj = ( npac(ji) - 1 ) / jpi + 1442 vt_i_init(zji,zjj) = vt_i_init(zji,zjj) +zv_newice(ji)443 ! Energy444 zde = ze_newice(ji) / unit_fac445 zde = zde * area(zji,zjj) * zv_newice(ji)446 et_i_init(zji,zjj) = et_i_init(zji,zjj) + zde 404 zji = MOD( npac(ji) - 1 , jpi ) + 1 405 zjj = ( npac(ji) - 1 ) / jpi + 1 406 ! 407 zde = ze_newice(ji) / unit_fac * area(zji,zjj) * zv_newice(ji) 408 ! 409 vt_i_init(zji,zjj) = vt_i_init(zji,zjj) + zv_newice(ji) ! volume 410 et_i_init(zji,zjj) = et_i_init(zji,zjj) + zde ! Energy 411 447 412 END DO 448 413 449 414 ! keep new ice volume in memory 450 CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , & 451 jpi, jpj ) 415 CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj ) 452 416 453 417 !----------------- … … 455 419 !----------------- 456 420 DO ji = 1, nbpac 457 za_newice(ji) = zv_newice(ji) / zh_newice(ji) 458 ! diagnostic 459 zji = MOD( npac(ji) - 1, jpi ) + 1 460 zjj = ( npac(ji) - 1 ) / jpi + 1 461 diag_lat_gr(zji,zjj) = zv_newice(ji) / rdt_ice 421 zji = MOD( npac(ji) - 1 , jpi ) + 1 422 zjj = ( npac(ji) - 1 ) / jpi + 1 423 za_newice(ji) = zv_newice(ji) / zh_newice(ji) 424 diag_lat_gr(zji,zjj) = zv_newice(ji) * r1_rdtice 462 425 END DO !ji 463 426 … … 476 439 !------------------------------------------- 477 440 ! If lateral ice growth gives an ice concentration gt 1, then 478 ! we keep the excessive volume in memory and attribute it later 479 ! to bottom accretion 480 DO ji = 1, nbpac 481 ! vectorize 482 IF ( za_newice(ji) .GT. ( 1.0 - zat_i_ac(ji) ) ) THEN 483 zda_res(ji) = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 484 zdv_res(ji) = zda_res(ji) * zh_newice(ji) 485 za_newice(ji) = za_newice(ji) - zda_res(ji) 486 zv_newice(ji) = zv_newice(ji) - zdv_res(ji) 441 ! we keep the excessive volume in memory and attribute it later to bottom accretion 442 DO ji = 1, nbpac 443 IF ( za_newice(ji) > ( 1._wp - zat_i_ac(ji) ) ) THEN 444 zda_res(ji) = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 445 zdv_res(ji) = zda_res (ji) * zh_newice(ji) 446 za_newice(ji) = za_newice(ji) - zda_res (ji) 447 zv_newice(ji) = zv_newice(ji) - zdv_res (ji) 487 448 ELSE 488 zda_res(ji) = 0. 0489 zdv_res(ji) = 0. 0449 zda_res(ji) = 0._wp 450 zdv_res(ji) = 0._wp 490 451 ENDIF 491 452 END DO ! ji … … 497 458 DO jl = 1, jpl 498 459 DO ji = 1, nbpac 499 IF( hi_max (jl-1) < zh_newice(ji) .AND. &500 & zh_newice(ji) <= hi_max (jl) ) THEN460 IF( hi_max (jl-1) < zh_newice(ji) .AND. & 461 & zh_newice(ji) <= hi_max (jl) ) THEN 501 462 za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 502 463 zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) … … 504 465 zcatac (ji) = jl 505 466 ENDIF 506 END DO ! ji507 END DO ! jl467 END DO 468 END DO 508 469 509 470 !---------------------------------- … … 521 482 DO ji = 1, nbpac 522 483 jl = zcatac(ji) 523 zqold = ze_i_ac(ji,jk,jl) ! [ J.m-3 ]484 zqold = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 524 485 zalphai = MIN( zhice_old(ji,jl) * jk / nlay_i , zh_newice(ji) ) & 525 486 & - MIN( zhice_old(ji,jl) * ( jk - 1 ) / nlay_i , zh_newice(ji) ) … … 527 488 + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl) * zqold * zhice_old(ji,jl) / nlay_i & 528 489 + za_newice(ji) * ze_newice(ji) * zalphai & 529 + za_newice(ji) * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( ( zv_i_ac(ji,jl)) / nlay_i )490 + za_newice(ji) * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( zv_i_ac(ji,jl) / nlay_i ) 530 491 END DO 531 492 END DO … … 567 528 zdhicbot (ji,jl) = zdv_res(ji) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb & 568 529 & + zindb * zdh_frazb(ji) ! frazil ice may coalesce 569 zdummy(ji,jl) = zv_i_ac(ji,jl) /MAX(za_i_ac(ji,jl),epsi10)*zindb ! thickness of residual ice530 zdummy(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb ! thickness of residual ice 570 531 END DO 571 532 END DO … … 628 589 ! Update salinity 629 590 !----------------- 630 IF( num_sal == 2 .OR. num_sal == 4 ) THEN591 IF( num_sal == 2 ) THEN ! Sice = F(z,t) 631 592 DO jl = 1, jpl 632 593 DO ji = 1, nbpac 633 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) ) ! 0 if no ice and 1 if yes594 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) ) ! 0 if no ice and 1 if yes 634 595 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl) 635 596 zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * zindb … … 645 606 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 646 607 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 647 IF ( num_sal == 2 .OR. num_sal == 4) &608 IF ( num_sal == 2 ) & 648 609 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 649 610 DO jk = 1, nlay_i … … 651 612 END DO 652 613 END DO 653 CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d (1:nbpac) , jpi, jpj ) 614 CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 615 CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 654 616 ! 655 617 ENDIF ! nbpac > 0 … … 660 622 DO jl = 1, jpl 661 623 DO jk = 1, nlay_i ! heat content in 10^9 Joules 662 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i 624 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i / unit_fac 663 625 END DO 664 626 END DO -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r3294 r3625 12 12 !! 'key_lim3' LIM-3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! lim_thd_sal : salinity variations in the ice 15 !!---------------------------------------------------------------------- 16 USE par_oce ! ocean parameters 17 USE phycst ! physical constants (ocean directory) 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters 21 USE thd_ice ! LIM thermodynamics 22 USE limvar ! LIM variables 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays 14 !! lim_thd_sal : salinity variations in the ice 15 !!---------------------------------------------------------------------- 16 USE par_oce ! ocean parameters 17 USE phycst ! physical constants (ocean directory) 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters 21 USE thd_ice ! LIM thermodynamics 22 USE limvar ! LIM variables 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 27 27 28 IMPLICIT NONE … … 32 33 33 34 !!---------------------------------------------------------------------- 34 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)35 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 35 36 !! $Id$ 36 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 44 45 !! ** Purpose : computes new salinities in the ice 45 46 !! 46 !! ** Method : 4 possibilities 47 !! -> num_sal = 1 -> constant salinity for z,t 48 !! -> num_sal = 2 -> S = S(z,t) [simple Vancoppenolle et al 2005] 49 !! -> num_sal = 3 -> S = S(z) [multiyear ice] 50 !! -> num_sal = 4 -> S = S(h) [Cox and Weeks 74] 47 !! ** Method : 3 possibilities 48 !! -> num_sal = 1 -> Sice = cst [ice salinity constant in both time & space] 49 !! -> num_sal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005] 50 !! -> num_sal = 3 -> Sice = S(z) [multiyear ice] 51 51 !!--------------------------------------------------------------------- 52 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index52 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index 53 53 ! 54 54 INTEGER :: ji, jk ! dummy loop indices 55 INTEGER :: zji, zjj ! local integers56 55 REAL(wp) :: zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars 57 56 REAL(wp) :: zaaa, zbbb, zccc, zdiscrim ! local scalars … … 64 63 ! 1) Constant salinity, constant in time | 65 64 !------------------------------------------------------------------------------| 66 !!gm comment: if num_sal = 1 s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 67 IF( num_sal == 1 ) THEN 68 ! 69 DO jk = 1, nlay_i 70 DO ji = kideb, kiut 71 s_i_b(ji,jk) = bulk_sal 72 END DO ! ji 73 END DO ! jk 74 ! 75 DO ji = kideb, kiut 76 sm_i_b(ji) = bulk_sal 77 END DO ! ji 78 ! 65 !!gm comment: if num_sal = 1 s_i_new, s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 66 !!gm ===>>> simplification of almost all test on num_sal value 67 IF( num_sal == 1 ) THEN 68 s_i_b (kideb:kiut,1:nlay_i) = bulk_sal 69 sm_i_b (kideb:kiut) = bulk_sal 70 s_i_new(kideb:kiut) = bulk_sal 79 71 ENDIF 80 72 … … 83 75 !------------------------------------------------------------------------------| 84 76 85 IF( num_sal == 2 .OR. num_sal == 4) THEN77 IF( num_sal == 2 ) THEN 86 78 87 79 !--------------------------------- … … 118 110 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 119 111 ! ! drainage by flushing 120 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice112 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 121 113 122 114 !----------------- … … 133 125 END DO ! ji 134 126 135 ! Salinity profile136 CALL lim_var_salprof1d( kideb, kiut ) 127 CALL lim_var_salprof1d( kideb, kiut ) ! Salinity profile 128 137 129 138 130 !---------------------------- … … 143 135 !!gm useless 144 136 ! iflush : 1 if summer 145 iflush = MAX( 0._wp , SIGN ( 1._wp , t_su_b(ji) - rtt ))137 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_b(ji) - rtt ) ) 146 138 ! igravdr : 1 if t_su lt t_bo 147 igravdr = MAX( 0._wp , SIGN ( 1._wp , t_bo_b(ji) - t_su_b(ji) ))139 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_b(ji) - t_su_b(ji) ) ) 148 140 ! iaccrbo : 1 if bottom accretion 149 iaccrbo = MAX( 0._wp , SIGN ( 1._wp , dh_i_bott(ji) ))141 iaccrbo = MAX( 0._wp , SIGN( 1._wp , dh_i_bott(ji) ) ) 150 142 !!gm end useless 151 143 ! … … 157 149 !---------------------------- 158 150 DO ji = kideb, kiut 159 i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 160 fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) & 161 & * ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice 162 IF( num_sal == 4 ) fsbri_1d(ji) = 0._wp 163 END DO ! ji 151 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 152 sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) & 153 & * ( MAX( dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji) , sm_i_b(ji) - zsiold(ji) ) ) * r1_rdtice 154 END DO 164 155 165 156 ! Only necessary for conservation check since salinity is modified … … 179 170 END DO 180 171 ! 181 ENDIF ! num_sal .EQ. 2172 ENDIF 182 173 183 174 !------------------------------------------------------------------------------| … … 185 176 !------------------------------------------------------------------------------| 186 177 187 IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 188 189 !------------------------------------------------------------------------------| 190 ! Module 4 : Constant salinity varying in time | 191 !------------------------------------------------------------------------------| 192 193 IF( num_sal == 5 ) THEN ! Cox and Weeks, 1974 194 ! 195 DO ji = kideb, kiut 196 zsold = sm_i_b(ji) 197 IF( ht_i_b(ji) < 0.4 ) THEN 198 sm_i_b(ji) = 14.24 - 19.39 * ht_i_b(ji) 199 ELSE 200 sm_i_b(ji) = 7.88 - 1.59 * ht_i_b(ji) 201 sm_i_b(ji) = MIN( sm_i_b(ji) , zsold ) 202 ENDIF 203 IF( ht_i_b(ji) > 3.06918239 ) THEN 204 sm_i_b(ji) = 3._wp 205 ENDIF 206 DO jk = 1, nlay_i 207 s_i_b(ji,jk) = sm_i_b(ji) 208 END DO 209 END DO 210 ! 211 ENDIF ! num_sal 178 IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 179 212 180 213 181 !------------------------------------------------------------------------------| 214 182 ! 5) Computation of salt flux due to Bottom growth 215 183 !------------------------------------------------------------------------------| 216 217 IF ( num_sal == 4 ) THEN 218 DO ji = kideb, kiut 219 zji = MOD( npb(ji) - 1 , jpi ) + 1 220 zjj = ( npb(ji) - 1 ) / jpi + 1 221 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal ) & 222 & * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 223 END DO 224 ELSE 225 DO ji = kideb, kiut 226 zji = MOD( npb(ji) - 1 , jpi ) + 1 227 zjj = ( npb(ji) - 1 ) / jpi + 1 228 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - s_i_new(ji) ) & 229 & * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 230 END DO 231 ENDIF 184 ! note: s_i_new = bulk_sal in constant salinity case 185 DO ji = kideb, kiut 186 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0._wp ) * r1_rdtice 187 END DO 232 188 ! 233 189 CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r3294 r3625 14 14 !! lim_trp : advection/diffusion process of sea ice 15 15 !!---------------------------------------------------------------------- 16 USE phycst ! physical constant 17 USE dom_oce ! ocean domain 18 USE sbc_oce ! ocean surface boundary condition 19 USE par_ice ! LIM-3 parameter 20 USE dom_ice ! LIM-3 domain 21 USE ice ! LIM-3 variables 22 USE limadv ! LIM-3 advection 23 USE limhdf ! LIM-3 horizontal diffusion 24 USE in_out_manager ! I/O manager 25 USE lbclnk ! lateral boundary conditions -- MPP exchanges 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays 28 USE prtctl ! Print control 16 USE phycst ! physical constant 17 USE dom_oce ! ocean domain 18 USE sbc_oce ! ocean surface boundary condition 19 USE par_ice ! ice parameter 20 USE dom_ice ! ice domain 21 USE ice ! ice variables 22 USE limadv ! ice advection 23 USE limhdf ! ice horizontal diffusion 24 USE in_out_manager ! I/O manager 25 USE lbclnk ! lateral boundary conditions -- MPP exchanges 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays 28 USE prtctl ! Print control 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 29 30 30 31 IMPLICIT NONE … … 45 46 # include "vectopt_loop_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)48 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 48 49 !! $Id$ 49 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 128 129 zusnit = 1.0 / REAL( initad ) 129 130 IF( zcfl > 0.5 .AND. lwp ) & 130 WRITE(numout,*) 'lim_trp _2: CFL violation at day ', nday, ', cfl = ', zcfl, &131 WRITE(numout,*) 'lim_trp : CFL violation at day ', nday, ', cfl = ', zcfl, & 131 132 & ': the ice time stepping is split in two' 132 133 … … 174 175 ELSE 175 176 DO jk = 1, initad 176 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area177 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 177 178 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 178 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0ow (:,:), sxopw(:,:), &179 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), & 179 180 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 180 181 DO jl = 1, jpl 181 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---182 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 182 183 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 183 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &184 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 184 185 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 185 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---186 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 186 187 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 187 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &188 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 188 189 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 189 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---190 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 190 191 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 191 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &192 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 192 193 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 193 194 194 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---195 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 195 196 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 196 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &197 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 197 198 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 198 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---199 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 199 200 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 200 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0a (:,:,jl), sxa (:,:,jl), &201 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 201 202 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 202 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---203 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 203 204 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 204 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &205 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 205 206 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 206 207 DO layer = 1, nlay_i !--- ice heat contents --- 207 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &208 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 208 209 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 209 210 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 210 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &211 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 211 212 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 212 213 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) … … 392 393 393 394 ! Ice salinity and age 394 zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj) , & 395 zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 396 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 397 smv_i(ji,jj,jl) = zindic*zsal + (1.0-zindic)*0.0 398 399 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / & 400 MAX( a_i(ji,jj,jl), epsi16 ) ), 0.0 ) * a_i(ji,jj,jl) 401 oa_i (ji,jj,jl) = zindic*zage 395 zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj) , & 396 & zusvoic * zs0sm(ji,jj,jl) ) , s_i_min ) * v_i(ji,jj,jl) 397 IF( num_sal == 2 ) smv_i(ji,jj,jl) = zindic * zsal + (1.0-zindic) * 0._wp 398 399 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp ) * a_i(ji,jj,jl) 400 oa_i (ji,jj,jl) = zindic * zage 402 401 403 402 ! Snow heat content -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90
r3294 r3625 12 12 !! lim_update : computes update of sea-ice global variables from trend terms 13 13 !!---------------------------------------------------------------------- 14 USE limrhg ! ice rheology15 16 USE dom_oce17 USE oce ! dynamics and tracers variables18 USE in_out_manager19 USE sbc_oce ! Surface boundary condition: ocean fields20 USE sbc_ice ! Surface boundary condition: ice fields21 USE dom_ice22 USE phycst ! physical constants23 USE ice24 USE limdyn 25 USE limtrp 26 USE limthd 27 USE limsbc 28 USE limdia 29 USE limwri 30 USE limrst 31 USE thd_ice ! LIM thermodynamic sea-ice variables32 USE par_ice33 USE limitd_th34 USE limvar35 USE prtctl ! Print control36 USE lbclnk ! lateral boundary condition - MPP exchanges37 USE wrk_nemo ! work arrays14 USE dom_oce ! ocean domain 15 USE oce ! dynamics and tracers variables 16 USE sbc_oce ! Surface boundary condition: ocean fields 17 USE sbc_ice ! Surface boundary condition: ice fields 18 USE phycst ! physical constants 19 USE ice ! ice variables 20 USE par_ice ! ice parameters 21 USE thd_ice ! ice thermodynamic variables 22 USE dom_ice ! ice domain 23 USE limrhg ! ice rheology 24 USE limdyn ! ice dynamics 25 USE limtrp ! ice transport 26 USE limthd ! ice thermodynamics 27 USE limsbc ! ice-oce surface boundary conditions 28 USE limdia ! ice diagnostics 29 USE limwri ! ice outputs 30 USE limrst ! ice restart 31 USE limitd_th ! ice thickness distribution (thermodynamics) 32 USE limvar ! ice variables 33 USE prtctl ! Print control 34 USE in_out_manager ! I/O manager 35 USE lbclnk ! lateral boundary condition - MPP exchanges 36 USE wrk_nemo ! work arrays 37 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 38 39 39 IMPLICIT NONE … … 54 54 # include "vectopt_loop_substitute.h90" 55 55 !!---------------------------------------------------------------------- 56 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)56 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 57 57 !! $Id$ 58 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 190 190 191 191 ! is there any ice left ? 192 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )192 zindic = MAX( rzero , SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 193 193 !=1 if hi > 1e-3 and 0 if not 194 zdvres = MAX(0.0,-v_i(ji,jj,jl)) !residual volume if too much ice was molten194 zdvres = MAX( 0.0 , -v_i(ji,jj,jl) ) !residual volume if too much ice was molten 195 195 !this quantity is positive 196 v_i(ji,jj,jl) = zindic *v_i(ji,jj,jl) !ice volume cannot be negative196 v_i(ji,jj,jl) = zindic * v_i(ji,jj,jl) !ice volume cannot be negative 197 197 !correct thermodynamic ablation 198 d_v_i_thd(ji,jj,jl) 198 d_v_i_thd(ji,jj,jl) = zindic * d_v_i_thd(ji,jj,jl) + (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl)) 199 199 ! THIS IS NEW 200 d_a_i_thd(ji,jj,jl) = zindic * d_a_i_thd(ji,jj,jl) + & 201 (1.0-zindic) * (-old_a_i(ji,jj,jl)) 200 d_a_i_thd(ji,jj,jl) = zindic * d_a_i_thd(ji,jj,jl) + (1.0-zindic) * (-old_a_i(ji,jj,jl)) 202 201 203 202 !residual salt flux if ice is over-molten 204 fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * & 205 ( rhoic * zdvres / rdt_ice ) 206 ! fheat_res(ji,jj) = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice 203 sfx_res(ji,jj) = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres * r1_rdtice ) 204 ! fheat_res(ji,jj) = fheat_res(ji,jj) + rhoic * lfus * zdvres * r1_rdtice 207 205 208 206 ! is there any snow left ? 209 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ))210 zvsold 211 zdvres = MAX(0.0,-v_s(ji,jj,jl))!residual volume if too much ice was molten207 zindsn = MAX( rzero, SIGN( rone , v_s(ji,jj,jl) - epsi10 ) ) 208 zvsold = v_s(ji,jj,jl) 209 zdvres = MAX( 0.0 , -v_s(ji,jj,jl) ) !residual volume if too much ice was molten 212 210 !this quantity is positive 213 211 v_s(ji,jj,jl) = zindsn*v_s(ji,jj,jl) !snow volume cannot be negative … … 215 213 d_v_s_thd(ji,jj,jl) = zindsn * d_v_s_thd(ji,jj,jl) + & 216 214 (1.0-zindsn) * (-zvsold - d_v_s_trp(ji,jj,jl)) 217 !unsure correction on salt flux.... maybe future will tell it was not that right 218 219 !residual salt flux if snow is over-molten 220 fsalt_res(ji,jj) = fsalt_res(ji,jj) + sss_m(ji,jj) * ( rhosn * zdvres / rdt_ice ) 221 !this flux will be positive if snow was over-molten 222 ! fheat_res(ji,jj) = fheat_res(ji,jj) + rhosn * lfus * zdvres / rdt_ice 215 216 !no salt flux when snow is over-molten 217 ! fheat_res(ji,jj) = fheat_res(ji,jj) + rhosn * lfus * zdvres * r1_rdtice 223 218 ENDIF 224 219 END DO !ji … … 229 224 DO jj = 1, jpj 230 225 DO ji = 1, jpi 231 IF ( ABS(fsalt_res(ji,jj)) .GT. 1.0 ) THEN 232 WRITE(numout,*) ' ALERTE 1000 : residual salt flux of -> ', & 233 fsalt_res(ji,jj) 234 WRITE(numout,*) ' ji, jj : ', ji, jj, ' gphit, glamt : ', & 235 gphit(ji,jj), glamt(ji,jj) 226 IF( ABS( sfx_res(ji,jj) ) > 1._wp ) THEN 227 WRITE(numout,*) ' ALERTE 1000 : residual salt flux of -> ', sfx_res(ji,jj) 228 WRITE(numout,*) ' ji, jj : ', ji, jj, ' gphit, glamt : ', gphit(ji,jj), glamt(ji,jj) 236 229 ENDIF 237 230 END DO … … 277 270 ENDIF 278 271 279 at_i(:,:) = 0._wp280 DO jl = 1, jpl281 at_i(:,:) = a _i(:,:,jl) + at_i(:,:)272 at_i(:,:) = a_i(:,:,1) 273 DO jl = 2, jpl 274 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 282 275 END DO 283 276 … … 306 299 !-------------- 307 300 308 IF( num_sal == 2 .OR. num_sal == 4 ) THEN ! general case301 IF( num_sal == 2 ) THEN ! Prognostic salinity [Sice=F(z,t)] 309 302 ! 310 303 IF( ln_nicep ) THEN … … 317 310 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 318 311 ENDIF 319 312 ! 320 313 smv_i(:,:,:) = smv_i(:,:,:) + d_smv_i_thd(:,:,:) + d_smv_i_trp(:,:,:) 321 314 ! … … 352 345 .AND.( ( v_i(ji,jj,1)/MAX(a_i(ji,jj,1),epsi10)*zindb).GT.zhimax ) & 353 346 .AND.( zat_i_old.LT.zacrith ) ) THEN ! new line 354 z_prescr_hi = hi_max(1) / 2.0355 a_i(ji,jj,1) 347 z_prescr_hi = hi_max(1) * 0.5_wp 348 a_i(ji,jj,1) = v_i(ji,jj,1) / z_prescr_hi 356 349 ENDIF 357 350 END DO … … 412 405 ENDIF 413 406 414 at_i(:,:) = 0._wp415 DO jl = 1, jpl416 at_i(:,:) = a _i(:,:,jl) + at_i(:,:)407 at_i(:,:) = a_i(:,:,1) 408 DO jl = 2, jpl 409 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 417 410 END DO 418 411 … … 452 445 ENDIF 453 446 454 at_i(:,:) = 0._wp455 DO jl = 1, jpl456 at_i(:,:) = a _i(:,:,jl) + at_i(:,:)447 at_i(:,:) = a_i(:,:,1) 448 DO jl = 2, jpl 449 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 457 450 END DO 458 451 … … 616 609 DO ji = 1, jpi 617 610 IF ( internal_melt(ji,jj,jl) == 1 ) THEN 618 v_s(ji,jj,jl) = 0. 0619 e_s(ji,jj,1,jl) = 0. 0611 v_s(ji,jj,jl) = 0._wp 612 e_s(ji,jj,1,jl) = 0._wp 620 613 ! ! release heat 621 fheat_res(ji,jj) = fheat_res(ji,jj) & 622 + ze_s * v_s(ji,jj,jl) / rdt_ice 614 fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * v_s(ji,jj,jl) * r1_rdtice 623 615 ! release mass 624 rdm snif(ji,jj) = rdmsnif(ji,jj) + rhosn * v_s(ji,jj,jl)616 rdm_snw (ji,jj) = rdm_snw (ji,jj) + rhosn * v_s(ji,jj,jl) 625 617 ENDIF 626 618 END DO … … 648 640 ! ENDIF 649 641 IF ((oa_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 650 oa_i(ji,jj,jl) = rdt_ice *numit/86400.0*a_i(ji,jj,jl)642 oa_i(ji,jj,jl) = rdt_ice * numit / 86400.0 * a_i(ji,jj,jl) 651 643 ENDIF 652 644 oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) … … 657 649 ! v_s(ji,jj,jl) = MAX( zindb * v_s(ji,jj,jl), 0.0) 658 650 ! snow thickness cannot be smaller than 1e-6 659 v_s(ji,jj,jl) = zindsn *v_s(ji,jj,jl)*zindb651 v_s(ji,jj,jl) = zindsn * v_s(ji,jj,jl) * zindb 660 652 v_s(ji,jj,jl) = v_s(ji,jj,jl) * MAX( 0.0 , SIGN( 1.0 , v_s(ji,jj,jl) - epsi06 ) ) 661 653 … … 737 729 !--------------------- 738 730 739 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN ! general case740 731 IF( num_sal == 2 ) THEN ! Prognostic salinity [Sice=F(z,t)] 732 ! 741 733 DO jl = 1, jpl 742 734 DO jk = 1, nlay_i 743 735 DO jj = 1, jpj 744 DO ji = 1, jpi 745 ! salinity stays in bounds 746 smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), & 747 0.1 * v_i(ji,jj,jl) ) 736 DO ji = 1, jpi ! salinity stays in bounds 737 smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), 0.1 * v_i(ji,jj,jl) ) 748 738 i_ice_switch = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 749 smv_i(ji,jj,jl) = i_ice_switch*smv_i(ji,jj,jl) + & 750 0.1*(1.0-i_ice_switch)*v_i(ji,jj,jl) 739 smv_i(ji,jj,jl) = i_ice_switch*smv_i(ji,jj,jl) + 0.1*(1.0-i_ice_switch)*v_i(ji,jj,jl) 751 740 END DO ! ji 752 741 END DO ! jj 753 742 END DO !jk 754 743 END DO !jl 755 744 ! 756 745 ENDIF 757 746 … … 796 785 !----------------------------------------------------- 797 786 zamax = amax 798 ! 2.13.1) individual concentrations cannot exceed zamax 799 !------------------------------------------------------ 800 801 at_i(:,:) = 0.0 802 DO jl = 1, jpl 803 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 804 END DO 805 806 ! 2.13.2) Total ice concentration cannot exceed zamax 807 !---------------------------------------------------- 787 ! 2.13.1) total (and thus individual) concentrations cannot exceed zamax 788 !----------------------------------------------------------------------- 789 808 790 at_i(:,:) = a_i(:,:,1) 809 791 DO jl = 2, jpl 810 at_i(:,:) = a _i(:,:,jl) + at_i(:,:)792 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 811 793 END DO 812 794 … … 815 797 816 798 ! 0) Excessive area ? 817 z_da_ex = MAX( at_i(ji,jj) - zamax , 0. 0)799 z_da_ex = MAX( at_i(ji,jj) - zamax , 0._wp ) 818 800 819 801 ! 1) Count the number of existing categories 820 802 DO jl = 1, jpl 803 !!cr : comment the second line of zindb definition, and use epsi04 in the 1st one 821 804 zindb = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi03 ) ) 822 805 zindb = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) ) ) … … 839 822 at_i(:,:) = a_i(:,:,1) 840 823 DO jl = 2, jpl 841 at_i(:,:) = a _i(:,:,jl) + at_i(:,:)824 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 842 825 END DO 843 826 … … 894 877 at_i(:,:) = a_i(:,:,1) 895 878 DO jl = 2, jpl 896 at_i(:,:) = a _i(:,:,jl) + at_i(:,:)879 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 897 880 END DO 898 881 … … 902 885 ! Ice drift 903 886 !------------ 887 !!gm BUG ? I don't understand this : it may have a wrong impact on the ice edge advection 888 !!gm and any way there is much faster way to code that... 904 889 DO jj = 2, jpjm1 905 890 DO ji = fs_2, fs_jpim1 … … 913 898 END DO 914 899 !mask velocities 900 !!gm BUG ? here the mask are the one of the beginning of the time step, no? 901 !!gm whereas at this level they should have been updated... To be checked 915 902 u_ice(:,:) = u_ice(:,:) * tmu(:,:) 916 903 v_ice(:,:) = v_ice(:,:) * tmv(:,:) … … 1021 1008 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ') 1022 1009 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 1023 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_ rpo , clinfo2= ' fheat_rpo: ')1010 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 1024 1011 1025 1012 CALL prt_ctl_info(' ') -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r3294 r3625 43 43 !! lim_var_bv : 44 44 !!---------------------------------------------------------------------- 45 USE par_oce ! ocean parameters 46 USE phycst ! physical constants (ocean directory) 47 USE sbc_oce ! Surface boundary condition: ocean fields 48 USE ice ! LIM variables 49 USE par_ice ! LIM parameters 50 USE dom_ice ! LIM domain 51 USE thd_ice ! LIM thermodynamics 52 USE in_out_manager ! I/O manager 53 USE lib_mpp ! MPP library 54 USE wrk_nemo ! work arrays 45 USE par_oce ! ocean parameters 46 USE phycst ! physical constants (ocean directory) 47 USE sbc_oce ! Surface boundary condition: ocean fields 48 USE ice ! ice variables 49 USE par_ice ! ice parameters 50 USE thd_ice ! ice variables (thermodynamics) 51 USE dom_ice ! ice domain 52 USE in_out_manager ! I/O manager 53 USE lib_mpp ! MPP library 54 USE wrk_nemo ! work arrays 55 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 55 56 56 57 IMPLICIT NONE … … 73 74 74 75 !!---------------------------------------------------------------------- 75 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)76 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 76 77 !! $Id$ 77 78 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 182 183 END DO 183 184 184 IF( num_sal == 2 .OR. num_sal == 4)THEN185 IF( num_sal == 2 )THEN 185 186 DO jl = 1, jpl 186 187 DO jj = 1, jpj … … 309 310 ! Vertically constant, constant in time 310 311 !--------------------------------------- 311 IF( num_sal == 1) s_i(:,:,:,:) = bulk_sal312 IF( num_sal == 1 ) s_i(:,:,:,:) = bulk_sal 312 313 313 314 !----------------------------------- 314 315 ! Salinity profile, varying in time 315 316 !----------------------------------- 316 317 IF( num_sal == 2 .OR. num_sal == 4 ) THEN 317 IF( num_sal == 2 ) THEN 318 318 ! 319 319 DO jk = 1, nlay_i … … 331 331 dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) ! Weighting factor between zs_zero and zs_inf 332 332 dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 333 333 ! 334 334 zalpha(:,:,:) = 0._wp 335 335 DO jl = 1, jpl … … 347 347 END DO 348 348 END DO 349 349 ! 350 350 dummy_fac = 1._wp / nlay_i ! Computation of the profile 351 351 DO jl = 1, jpl … … 361 361 END DO ! jk 362 362 END DO ! jl 363 363 ! 364 364 ENDIF ! num_sal 365 365 … … 368 368 !------------------------------------------------------- 369 369 370 IF( num_sal == 3) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)370 IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 371 371 ! 372 372 sm_i(:,:,:) = 2.30_wp … … 380 380 END DO 381 381 END DO 382 382 ! 383 383 ENDIF ! num_sal 384 384 ! … … 447 447 !------------------------------------------------------ 448 448 449 IF( num_sal == 2 .OR. num_sal == 4) THEN449 IF( num_sal == 2 ) THEN 450 450 ! 451 451 DO ji = kideb, kiut ! Slope of the linear profile zs_zero -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r3294 r3625 25 25 USE wrk_nemo ! work arrays 26 26 USE par_ice 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 28 28 29 IMPLICIT NONE … … 51 52 REAL(wp) :: zone = 1._wp 52 53 !!---------------------------------------------------------------------- 53 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)54 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 54 55 !! $Id$ 55 56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 245 246 zcmo(ji,jj,25) = et_i(ji,jj) 246 247 zcmo(ji,jj,26) = et_s(ji,jj) 247 zcmo(ji,jj,28) = fsbri(ji,jj)248 zcmo(ji,jj,29) = fseqv(ji,jj)248 zcmo(ji,jj,28) = sfx_bri(ji,jj) 249 zcmo(ji,jj,29) = sfx_thd(ji,jj) 249 250 250 251 zcmo(ji,jj,30) = bv_i(ji,jj) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
r2715 r3625 111 111 zcmo(ji,jj,13) = qns(ji,jj) 112 112 ! See thersf for the coefficient 113 zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce113 zcmo(ji,jj,14) = - sfx (ji,jj) * rday ! converted in Kg/m2/day = mm/day 114 114 zcmo(ji,jj,15) = utau_ice(ji,jj) 115 115 zcmo(ji,jj,16) = vtau_ice(ji,jj) … … 154 154 rcmoy(ji,jj,13) = qns(ji,jj) 155 155 ! See thersf for the coefficient 156 rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce156 rcmoy(ji,jj,14) = - sfx (ji,jj) * rday ! converted in mm/day 157 157 rcmoy(ji,jj,15) = utau_ice(ji,jj) 158 158 rcmoy(ji,jj,16) = vtau_ice(ji,jj) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r2715 r3625 8 8 USE par_ice ! LIM-3 parameters 9 9 USE in_out_manager ! I/O manager 10 USE lib_mpp 10 USE lib_mpp ! MPP library 11 11 12 12 IMPLICIT NONE … … 66 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_b !: <==> the 2D frld 67 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fbif_1d !: <==> the 2D fbif 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm icif_1d !: <==> the 2D rdmicif69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm snif_1d !: <==> the 2D rdmsnif68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_ice_1d !: <==> the 2D rdm_ice 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_snw_1d !: <==> the 2D rdm_snw 70 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlbbq_1d !: <==> the 2D qlbsbq 71 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dmgwi_1d !: <==> the 2D dmgwi … … 83 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 84 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_i_b !: Ice thickness at the beginnning of the time step [m] 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::old_ht_s_b !: Snow thickness at the beginning of the time step [m]86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fsbri_1d !: Salt flux due to brine drainage85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_s_b !: Snow thickness at the beginning of the time step [m] 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d !: <==> the 2D sfx_bri 87 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhbri_1d !: Heat flux due to brine drainage 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fseqv_1d !: Equivalent Salt flux due to ice growth/decay88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_thd_1d !: <==> the 2D sfx_thd 89 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing 90 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage … … 138 138 139 139 !!---------------------------------------------------------------------- 140 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)140 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 141 141 !! $Id$ 142 142 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 160 160 ! 161 161 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_b (jpij) , & 162 & fbif_1d (jpij) , rdm icif_1d (jpij) , rdmsnif_1d (jpij) , &162 & fbif_1d (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) , & 163 163 & qlbbq_1d (jpij) , dmgwi_1d (jpij) , dvsbq_1d (jpij) , & 164 164 & dvbbq_1d (jpij) , dvlbq_1d (jpij) , dvnbq_1d (jpij) , & … … 166 166 & tatm_ice_1d(jpij) , fsup (jpij) , focea (jpij) , & 167 167 & i0 (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) , & 168 & fsbri_1d (jpij) , fhbri_1d (jpij) , fseqv_1d(jpij) , &168 & sfx_bri_1d (jpij) , fhbri_1d (jpij) , sfx_thd_1d (jpij) , & 169 169 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 170 170 & dsm_i_si_1d(jpij) , hicol_b (jpij) , STAT=ierr(2) ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r3294 r3625 52 52 LOGICAL :: ln_degrad = .false. !: degradation option enabled or not 53 53 54 INTEGER , PARAMETER :: jpfld = 19 ! maximum number of files to read54 INTEGER , PARAMETER :: jpfld = 20 ! maximum number of fields to read 55 55 INTEGER , SAVE :: jf_tem ! index of temperature 56 56 INTEGER , SAVE :: jf_sal ! index of salinity … … 72 72 INTEGER , SAVE :: jf_eiv ! index of v-eiv 73 73 INTEGER , SAVE :: jf_eiw ! index of w-eiv 74 INTEGER , SAVE :: jf_sfx ! index of downward salt flux 74 75 75 76 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn ! structure of input fields (file informations, fields read) … … 250 251 un (:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:) ! u-velocity 251 252 vn (:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:) ! v-velocity 252 IF( .NOT.ln_dynwzv ) & 253 IF( .NOT.ln_dynwzv ) & ! w-velocity read in file 253 254 wn (:,:,:) = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:) 254 255 hmld(:,:) = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1) ! mixed layer depht 255 256 wndm(:,:) = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1) ! wind speed - needed for gas exchange 256 257 emp (:,:) = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1) ! E-P 257 emps(:,:) = emp(:,:) 258 fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction 258 sfx (:,:) = 0.0_wp ! enable testing with old inputs ! downward salt flux 259 ! sfx (:,:) = sf_dyn(jf_sfx)%fnow(:,:,1) * tmask(:,:,1) ! downward salt flux (v3.5+) 260 fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction 259 261 qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation 260 262 … … 302 304 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 ) 303 305 CALL prt_ctl(tab2d_1=hmld , clinfo1=' hmld - : ', mask1=tmask, ovlap=1 ) 304 CALL prt_ctl(tab2d_1= emps , clinfo1=' emps- : ', mask1=tmask, ovlap=1 )306 CALL prt_ctl(tab2d_1=sfx , clinfo1=' sfx - : ', mask1=tmask, ovlap=1 ) 305 307 CALL prt_ctl(tab2d_1=wndm , clinfo1=' wspd - : ', mask1=tmask, ovlap=1 ) 306 308 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1 ) … … 330 332 TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd ! informations about the fields to be read 331 333 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl ! " " 332 TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw 334 TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_sfx ! " " 333 335 ! 334 336 NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, & 335 337 & sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, & 336 338 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, & 337 & sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw 339 & sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_sfx 338 340 339 341 !!---------------------------------------------------------------------- … … 348 350 sn_mld = FLD_N( 'dyna_grid_T' , 120 , 'somixght' , .true. , .true. , 'yearly' , '' , '' ) 349 351 sn_emp = FLD_N( 'dyna_grid_T' , 120 , 'sowaflcd' , .true. , .true. , 'yearly' , '' , '' ) 352 !! sn_emp = FLD_N( 'dyna_grid_T' , 120 , 'sowaflup' , .true. , .true. , 'yearly' , '' , '' ) ! v3.5+ 353 sn_sfx = FLD_N( 'dyna_grid_T' , 120 , 'sosfldow' , .true. , .true. , 'yearly' , '' , '' ) ! v3.5+ 350 354 sn_ice = FLD_N( 'dyna_grid_T' , 120 , 'soicecov' , .true. , .true. , 'yearly' , '' , '' ) 351 355 sn_qsr = FLD_N( 'dyna_grid_T' , 120 , 'soshfldo' , .true. , .true. , 'yearly' , '' , '' ) … … 426 430 ENDIF 427 431 ENDIF 432 ! Salt flux and concntration/dilution terms (new from v3.5) !! disabled to allow testing with old input files 433 !! jf_sfx = jfld + 1 ; jfld = jfld + 1 434 !! slf_d(jf_sfx) = sn_sfx 428 435 429 436 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90
r3294 r3625 213 213 ! ! Output trajectory fields 214 214 CALL iom_rstput( it, it, inum, 'emp' , emp ) 215 CALL iom_rstput( it, it, inum, ' emps' , emps)215 CALL iom_rstput( it, it, inum, 'sfx' , sfx ) 216 216 CALL iom_rstput( it, it, inum, 'un' , un ) 217 217 CALL iom_rstput( it, it, inum, 'vn' , vn ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r3294 r3625 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_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r3609 r3625 400 400 CALL histdef( nid_T, "sossheig", "Sea Surface Height" , "m" , & ! ssh 401 401 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 402 !!$#if defined key_lim3 || defined key_lim2403 !!$ ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to404 !!$ ! internal damping to Levitus that can be diagnosed from others405 !!$ ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup406 !!$ CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater" , "kg/m2/s", & ! fsalt407 !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )408 !!$ CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater" , "kg/m2/s", & ! fmass409 !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )410 !!$#endif411 402 CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux" , "Kg/m2/s", & ! (emp-rnf) 412 403 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 413 !!$ CALL histdef( nid_T, "sorunoff", "Runoffs" , "Kg/m2/s", & ! runoffs 414 !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 415 CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux" , "kg/m2/s", & ! (emps-rnf) 416 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 417 CALL histdef( nid_T, "sosalflx", "Surface Salt Flux" , "Kg/m2/s", & ! (emps-rnf) * sn 418 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 404 CALL histdef( nid_T, "sosfldow", "downward salt flux" , "PSU/m2/s", & ! sfx 405 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 406 #if ! defined key_vvl 407 CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature" & ! emp * tsn(:,:,1,jp_tem) 408 & , "KgC/m2/s", & ! sosst_cd 409 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 410 CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity" & ! emp * tsn(:,:,1,jp_sal) 411 & , "KgPSU/m2/s",& ! sosss_cd 412 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 413 #endif 419 414 CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux" , "W/m2" , & ! qns + qsr 420 415 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 602 597 CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT ) ! sea surface salinity 603 598 CALL histwrite( nid_T, "sossheig", it, sshn , ndim_hT, ndex_hT ) ! sea surface height 604 !!$#if defined key_lim3 || defined key_lim2605 !!$ CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:) , ndim_hT, ndex_hT ) ! ice=>ocean water flux606 !!$ CALL histwrite( nid_T, "sowaflep", it, fmass(:,:) , ndim_hT, ndex_hT ) ! atmos=>ocean water flux607 !!$#endif608 599 CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf ) , ndim_hT, ndex_hT ) ! upward water flux 609 !!$ CALL histwrite( nid_T, "sorunoff", it, runoff , ndim_hT, ndex_hT ) ! runoff 610 CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf ) , ndim_hT, ndex_hT ) ! c/d water flux 611 zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 612 CALL histwrite( nid_T, "sosalflx", it, zw2d , ndim_hT, ndex_hT ) ! c/d salt flux 600 CALL histwrite( nid_T, "sosfldow", it, sfx , ndim_hT, ndex_hT ) ! downward salt flux 601 ! (includes virtual salt flux beneath ice 602 ! in linear free surface case) 603 #if ! defined key_vvl 604 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 605 CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sst 606 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 607 CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sss 608 #endif 613 609 CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux 614 610 CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux … … 782 778 !!---------------------------------------------------------------------- 783 779 ! 784 IF( nn_timing == 1 ) CALL timing_start('dia_wri_state') 780 ! IF( nn_timing == 1 ) CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep 785 781 786 782 ! 0. Initialisation … … 879 875 #endif 880 876 881 IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') 877 ! IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 882 878 ! 883 879 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r3294 r3625 54 54 !! level 14: qct(:,:) equivalent flux due to treshold SST 55 55 !! level 15: fbt(:,:) feedback term . 56 !! level 16: ( emps(:,:) - rnf(:,:) ) concentration/dilution water flux 56 !! level 16: ( emp * sss ) concentration/dilution term on salinity 57 !! level 17: ( emp * sst ) concentration/dilution term on temperature 57 58 !! level 17: fsalt(:,:) Ice=>ocean net freshwater 58 59 !! level 18: gps(:,:) the surface pressure (m). … … 107 108 108 109 109 inbsel = 1 7110 inbsel = 18 110 111 111 112 IF( inbsel > jpk ) THEN … … 172 173 ! fsel(:,:,14) = fsel(:,:,14) + qct(:,:) 173 174 ! fsel(:,:,15) = fsel(:,:,15) + fbt(:,:) 174 fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) ) 175 fsel(:,:,16) = fsel(:,:,16) + ( emp(:,:)*tsn(:,:,1,jp_sal) ) 176 fsel(:,:,17) = fsel(:,:,17) + ( emp(:,:)*tsn(:,:,1,jp_tem) ) 175 177 ! 176 178 ! Output of dynamics and tracer fields and selected fields … … 240 242 ! fsel(:,:,14) = qct(:,:) 241 243 ! fsel(:,:,15) = fbt(:,:) 242 fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1) 244 fsel(:,:,16) = ( emp(:,:)-tsn(:,:,1,jp_sal) ) * tmask(:,:,1) 245 fsel(:,:,17) = ( emp(:,:)-tsn(:,:,1,jp_tem) ) * tmask(:,:,1) 243 246 ! 244 247 ! qct(:,:) = 0._wp -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r2715 r3625 18 18 USE oce ! dynamics and tracers 19 19 USE dom_oce ! ocean space and time domain 20 USE phycst 20 21 USE in_out_manager ! I/O manager 21 22 USE sbc_oce ! ocean surface boundary conditions … … 173 174 !! put as run-off in open ocean. 174 175 !! 175 !! ** Action : emp , emps updated surface freshwater fluxesat kt176 !! ** Action : emp updated surface freshwater flux at kt 176 177 !!---------------------------------------------------------------------- 177 178 INTEGER, INTENT(in) :: kt ! ocean model time step 178 179 ! 179 180 INTEGER :: ji, jj, jc, jn ! dummy loop indices 180 REAL(wp) :: zze2 181 REAL(wp) :: zze2, zcoef, zcoef1 181 182 REAL(wp), DIMENSION (jpncs) :: zfwf 182 183 !!---------------------------------------------------------------------- … … 214 215 ENDIF 215 216 ! !--------------------! 216 ! ! update emp , emps!217 ! ! update emp ! 217 218 zfwf = 0.e0 !--------------------! 218 219 DO jc = 1, jpncs … … 235 236 IF( ncstt(jc) == 0 ) THEN 236 237 ! water/evap excess is shared by all open ocean 237 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 238 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 238 zcoef = zfwf(jc) / surf(jpncs+1) 239 zcoef1 = rcp * zcoef 240 emp(:,:) = emp(:,:) + zcoef 241 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 239 242 ELSEIF( ncstt(jc) == 1 ) THEN 240 243 ! Excess water in open sea, at outflow location, excess evap shared … … 245 248 IF ( ji > 1 .AND. ji < jpi & 246 249 .AND. jj > 1 .AND. jj < jpj ) THEN 247 emp (ji,jj) = emp (ji,jj) + zfwf(jc) / &248 (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))249 emp s(ji,jj) = emps(ji,jj) + zfwf(jc) / &250 (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))250 zcoef = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 251 zcoef1 = rcp * zcoef 252 emp(ji,jj) = emp(ji,jj) + zcoef 253 qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 251 254 END IF 252 255 END DO 253 256 ELSE 254 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 255 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 257 zcoef = zfwf(jc) / surf(jpncs+1) 258 zcoef1 = rcp * zcoef 259 emp(:,:) = emp(:,:) + zcoef 260 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 256 261 ENDIF 257 262 ELSEIF( ncstt(jc) == 2 ) THEN … … 262 267 ji = mi0(ncsir(jc,jn)) 263 268 jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 264 emp (ji,jj) = emp (ji,jj) + zfwf(jc) &265 / (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj) )266 emp s(ji,jj) = emps(ji,jj) + zfwf(jc) &267 / (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))269 zcoef = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 270 zcoef1 = rcp * zcoef 271 emp(ji,jj) = emp(ji,jj) + zcoef 272 qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 268 273 END DO 269 274 ENDIF … … 272 277 DO jj = ncsj1(jc), ncsj2(jc) 273 278 DO ji = ncsi1(jc), ncsi2(jc) 274 emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc) 275 emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc) 279 zcoef = zfwf(jc) / surf(jc) 280 zcoef1 = rcp * zcoef 281 emp(ji,jj) = emp(ji,jj) - zcoef 282 qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj) 276 283 END DO 277 284 END DO … … 280 287 ! 281 288 CALL lbc_lnk( emp , 'T', 1. ) 282 CALL lbc_lnk( emps, 'T', 1. )283 289 ! 284 290 END SUBROUTINE sbc_clo -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r3294 r3625 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 || defined key_cice 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_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r3322 r3625 81 81 ! 82 82 INTEGER :: ji, jj, jk ! dummy loop indices 83 REAL(wp) :: z2dt, zg_2 83 REAL(wp) :: z2dt, zg_2, zintp, zgrau0r ! temporary scalar 84 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 85 REAL(wp), POINTER, DIMENSION(:,:) :: zpice 85 86 !!---------------------------------------------------------------------- 86 87 ! … … 117 118 END DO 118 119 END DO 120 ENDIF 121 122 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 123 CALL wrk_alloc( jpi, jpj, zpice ) 124 ! 125 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 126 zgrau0r = - grav * r1_rau0 127 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrau0r 128 DO jj = 2, jpjm1 129 DO ji = fs_2, fs_jpim1 ! vector opt. 130 spgu(ji,jj) = ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 131 spgv(ji,jj) = ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 132 END DO 133 END DO 134 DO jk = 1, jpkm1 ! Add the surface pressure trend to the general trend 135 DO jj = 2, jpjm1 136 DO ji = fs_2, fs_jpim1 ! vector opt. 137 ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 138 va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 139 END DO 140 END DO 141 END DO 142 ! 143 CALL wrk_dealloc( jpi, jpj, zpice ) 119 144 ENDIF 120 145 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r3294 r3625 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_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r3294 r3625 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_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r3608 r3625 8 8 !!---------------------------------------------------------------------- 9 9 USE dom_oce ! ocean space and time domain variables 10 #if defined key_nemocice_decomp 11 USE ice_domain_size, only: nx_global, ny_global 12 #endif 10 13 USE in_out_manager ! I/O manager 11 14 USE lib_mpp ! distributed memory computing … … 431 434 ! array (cf. par_oce.F90). 432 435 436 #if defined key_nemocice_decomp 437 ijpi = ( nx_global+2-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 438 ijpj = ( ny_global+2-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 439 #else 433 440 ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 434 #if defined key_nemocice_decomp435 ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj436 #else437 441 ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 438 442 #endif -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3609 r3625 120 120 121 121 ! variables used in case of sea-ice 122 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice 122 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice (public so that it can be freed in limthd) 123 INTEGER :: ngrp_iworld ! group ID for the world processors (for rheology) 123 124 INTEGER :: ngrp_ice ! group ID for the ice processors (for rheology) 124 125 INTEGER :: ndim_rank_ice ! number of 'ice' processors … … 1978 1979 !! ndim_rank_ice = number of processors with ice 1979 1980 !! nrank_ice (ndim_rank_ice) = ice processors 1980 !! ngrp_ world = group ID for the world processors1981 !! ngrp_iworld = group ID for the world processors 1981 1982 !! ngrp_ice = group ID for the ice processors 1982 1983 !! ncomm_ice = communicator for the ice procs. … … 2027 2028 2028 2029 ! Create the world group 2029 CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_ world, ierr )2030 CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_iworld, ierr ) 2030 2031 2031 2032 ! Create the ice group from the world group 2032 CALL MPI_GROUP_INCL( ngrp_ world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )2033 CALL MPI_GROUP_INCL( ngrp_iworld, ndim_rank_ice, nrank_ice, ngrp_ice, ierr ) 2033 2034 2034 2035 ! Create the ice communicator , ie the pool of procs with sea-ice … … 2037 2038 ! Find proc number in the world of proc 0 in the north 2038 2039 ! The following line seems to be useless, we just comment & keep it as reminder 2039 ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 2040 ! 2040 ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_iworld,n_ice_root,ierr) 2041 ! 2042 CALL MPI_GROUP_FREE(ngrp_ice, ierr) 2043 CALL MPI_GROUP_FREE(ngrp_iworld, ierr) 2044 2041 2045 DEALLOCATE(kice, zwork) 2042 2046 ! -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r3294 r3625 16 16 !! 'key_ldfslp' Rotation of lateral mixing tensor 17 17 !!---------------------------------------------------------------------- 18 !! ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator)19 !! ldf_slp : calculates the slopes of neutral surface (Madec operator)20 !! ldf_slp_mxl : calculates the slopes at the base of the mixed layer (Madec operator)21 !! ldf_slp_init : initialization of the slopes computation18 !! ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator) 19 !! ldf_slp : calculates the slopes of neutral surface (Madec operator) 20 !! ldf_slp_mxl : calculates the slopes at the base of the mixed layer (Madec operator) 21 !! ldf_slp_init : initialization of the slopes computation 22 22 !!---------------------------------------------------------------------- 23 USE oce ! ocean dynamics and tracers 24 USE dom_oce ! ocean space and time domain 25 USE ldftra_oce ! lateral diffusion: traceur 26 USE ldfdyn_oce ! lateral diffusion: dynamics 27 USE phycst ! physical constants 28 USE zdfmxl ! mixed layer depth 29 USE eosbn2 ! equation of states 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE in_out_manager ! I/O manager 32 USE prtctl ! Print control 33 USE wrk_nemo ! work arrays 34 USE timing ! Timing 23 USE oce ! ocean dynamics and tracers 24 USE dom_oce ! ocean space and time domain 25 USE ldftra_oce ! lateral diffusion: traceur 26 USE ldfdyn_oce ! lateral diffusion: dynamics 27 USE phycst ! physical constants 28 USE zdfmxl ! mixed layer depth 29 USE eosbn2 ! equation of states 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE in_out_manager ! I/O manager 32 USE prtctl ! Print control 33 USE wrk_nemo ! work arrays 34 USE timing ! Timing 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 35 36 36 37 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r3294 r3625 12 12 13 13 !!---------------------------------------------------------------------- 14 !! albedo_ice : albedo for ice (clear and overcast skies) 15 !! albedo_oce : albedo for ocean (clear and overcast skies) 16 !! albedo_init : initialisation of albedo computation 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constants 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! MPP library 21 USE wrk_nemo ! work arrays 14 !! albedo_ice : albedo for ice (clear and overcast skies) 15 !! albedo_oce : albedo for ocean (clear and overcast skies) 16 !! albedo_init : initialisation of albedo computation 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constants 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! MPP library 21 USE wrk_nemo ! work arrays 22 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 22 23 23 24 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r3294 r3625 94 94 ! finally, arrays corresponding to different ice categories 95 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: category ice fraction 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt 98 98 #endif 99 99 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r3609 r3625 40 40 LOGICAL , PUBLIC :: ln_apr_dyn = .FALSE. !: Atmospheric pressure forcing used on dynamics (ocean & ice) 41 41 LOGICAL , PUBLIC :: ln_icebergs = .FALSE. !: Icebergs 42 INTEGER , PUBLIC :: nn_ice = 0 !: flag on ice in the surface boundary condition (=0/1/2/3) 42 INTEGER , PUBLIC :: nn_ice = 0 !: flag for ice in the surface boundary condition (=0/1/2/3) 43 INTEGER , PUBLIC :: nn_ice_embd = 0 !: flag for levitating/embedding sea-ice in the ocean 44 ! !: =0 levitating ice (no mass exchange, concentration/dilution effect) 45 ! !: =1 levitating ice with mass and salt exchange but no presure effect 46 ! !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 43 47 INTEGER , PUBLIC :: nn_fwb = 0 !: FreshWater Budget: 44 48 ! !: = 0 unchecked … … 62 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_tot !: total non solar heat flux (over sea and ice) [W/m2] 63 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp , emp_b !: freshwater budget: volume flux [Kg/m2/s] 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emps , emps_b !: freshwater budget: concentration/dillution [Kg/m2/s]68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx , sfx_b !: salt flux [PSU/m2/s] 65 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s] 66 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s] … … 106 110 & vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) ) 107 111 ! 108 ALLOCATE( qns_tot(jpi,jpj) , qns 109 & qsr_tot(jpi,jpj) , qsr 110 & emp (jpi,jpj) , emp_b 111 & emps (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) )112 ALLOCATE( qns_tot(jpi,jpj) , qns (jpi,jpj) , qns_b(jpi,jpj), & 113 & qsr_tot(jpi,jpj) , qsr (jpi,jpj) , & 114 & emp (jpi,jpj) , emp_b(jpi,jpj) , & 115 & sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) ) 112 116 ! 113 117 ALLOCATE( rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , & -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r3294 r3625 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 sfx (:,:) = 0.0_wp 93 qns (:,:) = rn_qns0 - emp(:,:) * sst_m(:,:) * rcp ! including heat content associated with mass flux at SST 92 94 qsr (:,:) = rn_qsr0 93 emp (:,:) = rn_emp094 emps(:,:) = rn_emp095 95 ! 96 96 utau(:,:) = rn_utau0 … … 130 130 !! 131 131 !! ** Action : - set the ocean surface boundary condition, i.e. 132 !! utau, vtau, taum, wndm, qns, qsr, emp, emps132 !! utau, vtau, taum, wndm, qns, qsr, emp, sfx 133 133 !! 134 134 !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000. … … 211 211 END DO 212 212 END DO 213 emps(:,:) = emp(:,:)214 213 215 214 ! Compute the emp flux such as its integration on the whole domain at each time is zero … … 224 223 ENDIF 225 224 226 !salinity terms 227 emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1) 228 emps(:,:) = emp(:,:) 225 ! freshwater (mass flux) and update of qns with heat content of emp 226 emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1) ! freshwater flux (=0 in domain average) 227 sfx (:,:) = 0.0_wp ! no salt flux 228 qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! evap and precip are at SST 229 229 230 230 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r3294 r3625 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 USE oce ! ocean dynamics and tracers 22 USE dom_oce ! ocean space and time domain 23 USE phycst ! physical constants 24 USE fldread ! read input fields 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 USE iom ! I/O manager library 27 USE in_out_manager ! I/O manager 28 USE lib_mpp ! distribued memory computing library 29 USE wrk_nemo ! work arrays 30 USE timing ! Timing 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 USE oce ! ocean dynamics and tracers 22 USE dom_oce ! ocean space and time domain 23 USE phycst ! physical constants 24 USE fldread ! read input fields 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 USE iom ! I/O manager library 27 USE in_out_manager ! I/O manager 28 USE lib_mpp ! distribued memory computing library 29 USE wrk_nemo ! work arrays 30 USE timing ! Timing 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 33 33 34 USE albedo … … 50 51 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) (N/m2) at V-point 51 52 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 ( -)53 INTEGER , PARAMETER :: jp_humi = 4 ! index of specific humidity ( % ) 54 INTEGER , PARAMETER :: jp_ccov = 5 ! index of cloud cover ( % ) 54 55 INTEGER , PARAMETER :: jp_tair = 6 ! index of 10m air temperature (Kelvin) 55 56 INTEGER , PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) … … 100 101 !! the i-component of the stress (N/m2) 101 102 !! the j-component of the stress (N/m2) 102 !! the 10m wind pseed module (m/s)103 !! the 10m wind speed module (m/s) 103 104 !! the 10m air temperature (Kelvin) 104 !! the 10m specific humidity ( -)105 !! the cloud cover ( -)105 !! the 10m specific humidity (%) 106 !! the cloud cover (%) 106 107 !! the total precipitation (rain+snow) (Kg/m2/s) 107 108 !! (2) CALL blk_oce_clio 108 109 !! 109 110 !! 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 111 !! the stress is assumed to be in the (i,j) mesh referential 112 112 !! 113 113 !! ** Action : defined at each time-step at the air-sea interface … … 115 115 !! - taum wind stress module at T-point 116 116 !! - wndm 10m wind module at T-point 117 !! - qns, qsr non-slor and solar heat flux 118 !! - emp, emps evaporation minus precipitation 117 !! - qns non-solar heat flux including latent heat of solid 118 !! precip. melting and emp heat content 119 !! - qsr solar heat flux 120 !! - emp upward mass flux (evap. - precip) 121 !! - sfx salt flux; set to zero at nit000 but possibly non-zero 122 !! if ice is present (computed in limsbc(_2).F90) 119 123 !!---------------------------------------------------------------------- 120 INTEGER, INTENT( in) :: kt ! ocean time step124 INTEGER, INTENT( in ) :: kt ! ocean time step 121 125 !! 122 126 INTEGER :: ifpr, jfpr ! dummy indices … … 171 175 ALLOCATE( sbudyko(jpi,jpj) , stauc(jpi,jpj), STAT=ierr3 ) 172 176 IF( ierr3 > 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate arrays' ) 177 ! 178 sfx(:,:) = 0._wp ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 173 179 ! 174 180 ENDIF … … 205 211 !! - taum wind stress module at T-point 206 212 !! - wndm 10m wind module at T-point 207 !! - qns, qsr non-slor and solar heat flux 208 !! - emp, emps evaporation minus precipitation 213 !! - qns non-solar heat flux including latent heat of solid 214 !! precip. melting and emp heat content 215 !! - qsr solar heat flux 216 !! - emp suface mass flux (evap.-precip.) 209 217 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC 210 218 !!---------------------------------------------------------------------- … … 223 231 REAL(wp) :: zsst, ztatm, zcco1, zpatm, zcmax, zrmax ! - - 224 232 REAL(wp) :: zrhoa, zev, zes, zeso, zqatm, zevsqr ! - - 225 REAL(wp) :: ztx2, zty2 233 REAL(wp) :: ztx2, zty2, zcevap, zcprec ! - - 226 234 REAL(wp), POINTER, DIMENSION(:,:) :: zqlw ! long-wave heat flux over ocean 227 235 REAL(wp), POINTER, DIMENSION(:,:) :: zqla ! latent heat flux over ocean … … 363 371 ! III Total FLUXES ! 364 372 ! ----------------------------------------------------------------------------- ! 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 ! 373 zcevap = rcp / cevap ! convert zqla ==> evap (Kg/m2/s) ==> m/s ==> W/m2 374 zcprec = rcp / rday ! convert prec ( mm/day ==> m/s) ==> W/m2 375 376 !CDIR COLLAPSE 377 emp(:,:) = zqla(:,:) / cevap & ! freshwater flux 378 & - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 379 ! 380 !CDIR COLLAPSE 381 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 382 & - zqla(:,:) * pst(:,:) * zcevap & ! remove evap. heat content at SST in Celcius 383 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 384 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 385 371 386 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 372 387 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean … … 407 422 !! 408 423 !! ** 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 !! 424 !! - snow precipitation 425 !! - solar flux at the ocean and ice surfaces 426 !! - the long-wave radiation for the ocean and sea/ice 427 !! - turbulent heat fluxes over water and ice 428 !! - evaporation over water 429 !! - total heat fluxes sensitivity over ice (dQ/dT) 430 !! - latent heat flux sensitivity over ice (dQla/dT) 431 !! - qns : modified the non solar heat flux over the ocean 432 !! to take into account solid precip latent heat flux 417 433 !!---------------------------------------------------------------------- 418 434 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] … … 594 610 ! 595 611 ! ----------------------------------------------------------------------------- ! 596 ! Total FLUXES !612 ! Total FLUXES ! 597 613 ! ----------------------------------------------------------------------------- ! 598 614 ! … … 601 617 !CDIR COLLAPSE 602 618 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 619 ! 620 ! ----------------------------------------------------------------------------- ! 621 ! Correct the OCEAN non solar flux with the existence of solid precipitation ! 622 ! ---------------=====--------------------------------------------------------- ! 623 !CDIR COLLAPSE 624 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 625 & - p_spr(:,:) * lfus & ! remove melting solid precip 626 & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 627 & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 603 628 ! 604 629 !!gm : not necessary as all input data are lbc_lnk... -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3294 r3625 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 fluxes 114 !! - emp upward mass flux (evapo. - precip.) 115 !! - sfx salt flux due to freezing/melting (non-zero only if ice is present) 116 !! (set in limsbc(_2).F90) 118 117 !!---------------------------------------------------------------------- 119 118 INTEGER, INTENT(in) :: kt ! ocean time step … … 125 124 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 126 125 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 ! " " 126 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 127 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif ! - - 130 128 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 131 129 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & … … 181 179 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' ) 182 180 ! 183 ENDIF 184 185 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 186 187 ! ! surface ocean fluxes computed with CLIO bulk formulea 181 sfx(:,:) = 0._wp ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 182 ! 183 ENDIF 184 185 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 186 187 ! ! compute the surface ocean fluxes using CORE bulk formulea 188 188 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 189 189 … … 221 221 !! - qns : Non Solar heat flux over the ocean (W/m2) 222 222 !! - evap : Evaporation over the ocean (kg/m2/s) 223 !! - emp (s): evaporation minus precipitation (kg/m2/s)223 !! - emp : evaporation minus precipitation (kg/m2/s) 224 224 !! 225 225 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC … … 252 252 zcoef_qsatw = 0.98 * 640380. / rhoa 253 253 254 zst(:,:) = pst(:,:) + rt0 ! convert eCelcius to Kelvin (and set minimum value far above 0 K)254 zst(:,:) = pst(:,:) + rt0 ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 255 255 256 256 ! ----------------------------------------------------------------------------- ! … … 378 378 379 379 !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(:,:) 380 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 381 & - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1) 382 !CDIR COLLAPSE 383 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 384 & - sf(jp_snow)%fnow(:,:,1) * lfus & ! remove latent melting heat for solid precip 385 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST 386 & + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) & ! add liquid precip heat content at Tair 387 & * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & 388 & + sf(jp_snow)%fnow(:,:,1) & ! add solid precip heat content at min(Tair,Tsnow) 389 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic 385 390 ! 386 391 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 387 392 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean 388 393 CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean 394 CALL iom_put( "qhc_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 389 395 CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean 390 396 ! -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r3294 r3625 84 84 !! - wndm 10m wind module at T-point 85 85 !! - qns, qsr non-slor and solar heat flux 86 !! - emp , empsevaporation minus precipitation86 !! - emp evaporation minus precipitation 87 87 !!---------------------------------------------------------------------- 88 88 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sh_now ! specific humidity at T-point … … 258 258 emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1) 259 259 !CDIR COLLAPSE 260 emps(:,:) = emp(:,:)261 260 262 261 CALL iom_put( "qlw_oce", qbw ) ! output downward longwave heat over the ocean -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3294 r3625 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 … … 777 779 ! Stress module can be negative when received (interpolation problem) 778 780 IF( llnewtau ) THEN 779 frcv(jpr_taum)%z3(:,:,1) = MAX( 0. 0e0, frcv(jpr_taum)%z3(:,:,1) )781 frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) 780 782 ENDIF 781 783 ENDIF … … 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. melting 827 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus 828 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 cycle 833 ! 834 ! ! total freshwater fluxes over the ocean (emp, emps) 825 ! ! total freshwater fluxes over the ocean (emp) 835 826 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 836 827 CASE( 'conservative' ) … … 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 * sst_m(:,:) 1144 1148 ! 1145 1149 ! ! ========================= ! … … 1233 1237 & + pist(:,:,1) * zicefr(:,:) ) ) 1234 1238 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 1239 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 1240 qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with: 1241 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1242 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1243 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1237 1244 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1238 1245 !!gm … … 1254 1261 ! ! ========================= ! 1255 1262 CASE( 'oce only' ) 1256 qsr_tot(:,: ) = MAX( 0.0,frcv(jpr_qsroce)%z3(:,:,1))1263 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1257 1264 CASE( 'conservative' ) 1258 1265 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1357 1364 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1358 1365 CASE( 'no' ) 1359 ztmp3(:,:,:) = 0. 01366 ztmp3(:,:,:) = 0._wp 1360 1367 DO jl=1,jpl 1361 1368 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) … … 1409 1416 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 1410 1417 CASE( 'no' ) 1411 ztmp3(:,:,:) = 0. 0 ; ztmp4(:,:,:) = 0.01418 ztmp3(:,:,:) = 0._wp ; ztmp4(:,:,:) = 0._wp 1412 1419 DO jl=1,jpl 1413 1420 ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r2715 r3625 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 !! - sfx salt flux; set to zero at nit000 but possibly non-zero 73 !! if ice is present (computed in limsbc(_2).F90) 72 74 !!---------------------------------------------------------------------- 73 75 INTEGER, INTENT(in) :: kt ! ocean time step … … 121 123 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 122 124 ! 125 sfx(:,:) = 0.0_wp ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90) 126 ! 123 127 ENDIF 124 128 … … 139 143 END DO 140 144 END DO 145 ! ! add to qns the heat due to e-p 146 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 147 ! 141 148 ! ! module of wind stress and wind speed at T-point 142 149 zcoef = 1. / ( zrhoa * zcdrag ) … … 154 161 CALL lbc_lnk( taum(:,:), 'T', 1. ) ; CALL lbc_lnk( wndm(:,:), 'T', 1. ) 155 162 156 emps(:,:) = emp (:,:) ! Initialization of emps (needed when no ice model)157 158 163 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 159 164 WRITE(numout,*) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r3294 r3625 59 59 !! =3 global mean of emp set to zero at each nn_fsbc time step 60 60 !! & spread out over erp area depending its sign 61 !! Note: if sea ice is embedded it is taken into account when computing the budget 61 62 !!---------------------------------------------------------------------- 62 63 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 64 65 INTEGER, INTENT( in ) :: kn_fwb ! ocean time-step index 65 66 ! 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 67 INTEGER :: inum, ikty, iyear ! local integers 68 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars 69 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread, zcoef ! - - 70 REAL(wp), POINTER, DIMENSION(:,:) :: ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 71 REAL(wp), POINTER, DIMENSION(:,:) :: ztmsk_tospread, zerp_cor ! - - 70 72 !!---------------------------------------------------------------------- 71 73 ! … … 87 89 ! 88 90 area = glob_sum( e1e2t(:,:) ) ! interior global domain surface 91 ! 92 #if ! defined key_lim2 && ! defined key_lim3 && ! defined key_cice 93 snwice_mass_b(:,:) = 0.e0 ! no sea-ice model is being used : no snow+ice mass 94 snwice_mass (:,:) = 0.e0 95 #endif 96 ! 89 97 ENDIF 90 98 … … 95 103 ! 96 104 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 97 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area ! sum over the global domain 98 emp (:,:) = emp (:,:) - z_fwf 99 emps(:,:) = emps(:,:) - z_fwf 105 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area ! sum over the global domain 106 zcoef = z_fwf * rcp 107 emp(:,:) = emp(:,:) - z_fwf 108 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction 100 109 ENDIF 101 110 ! 102 111 CASE ( 2 ) !== fwf budget adjusted from the previous year ==! 103 112 ! 104 IF( kt == nit000 ) THEN ! initialisation113 IF( kt == nit000 ) THEN ! initialisation 105 114 ! ! Read the corrective factor on precipitations (fwfold) 106 115 CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) … … 117 126 ikty = 365 * 86400 / rdttra(1) !!bug use of 365 days leap year or 360d year !!!!!!! 118 127 IF( MOD( kt, ikty ) == 0 ) THEN 119 a_fwb_b = a_fwb 120 a_fwb = glob_sum( e1e2t(:,:) * sshn(:,:) ) ! sum over the global domain 128 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow 129 ! sum over the global domain 130 a_fwb = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 121 131 a_fwb = a_fwb * 1.e+3 / ( area * 86400. * 365. ) ! convert in Kg/m3/s = mm/s 122 132 !!gm ! !!bug 365d year … … 125 135 ENDIF 126 136 ! 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 137 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes 138 zcoef = fwfold * rcp 139 emp(:,:) = emp(:,:) + fwfold 140 qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction 141 ENDIF 142 ! 143 IF( kt == nitend .AND. lwp ) THEN ! save fwfold value in a file 133 144 CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 134 145 WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb … … 143 154 ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 144 155 ! 145 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) 156 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp 146 157 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 147 ! ! fwf global mean 148 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area158 ! ! fwf global mean (excluding ocean to ice/snow exchanges) 159 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 149 160 ! 150 161 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation … … 160 171 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 161 172 ! ! weight to respect erp field 2D structure 162 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )173 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 163 174 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 164 175 ! ! final correction term to apply … … 168 179 CALL lbc_lnk( zerp_cor, 'T', 1. ) 169 180 ! 170 emp (:,:) = emp(:,:) + zerp_cor(:,:)171 emps(:,:) = emps(:,:) + zerp_cor(:,:)172 erp (:,:) = erp(:,:) + zerp_cor(:,:)181 emp(:,:) = emp(:,:) + zerp_cor(:,:) 182 qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:) ! account for change to the heat budget due to fw correction 183 erp(:,:) = erp(:,:) + zerp_cor(:,:) 173 184 ! 174 185 IF( nprint == 1 .AND. lwp ) THEN ! control print -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r3294 r3625 15 15 USE dom_oce ! ocean space and time domain 16 16 USE domvvl 17 USE phycst, only : rcp, rau0 17 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 18 18 USE in_out_manager ! I/O manager 19 19 USE lib_mpp ! distributed memory computing library … … 37 37 USE ice_gather_scatter 38 38 USE ice_calendar, only: dt 39 USE ice_state, only: aice,aicen,uvel,vvel,vsno n,vicen39 USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 40 40 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 41 41 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm, & … … 59 59 PUBLIC cice_sbc_final ! routine called by sbc_final 60 60 PUBLIC sbc_ice_cice ! routine called by sbc 61 62 INTEGER , PARAMETER :: ji_off = INT ( (jpiglo - nx_global) / 2 ) 63 INTEGER , PARAMETER :: jj_off = INT ( (jpjglo - ny_global) / 2 ) 61 64 62 65 INTEGER , PARAMETER :: jpfld = 13 ! maximum number of files to read … … 107 110 !! ** Action : - time evolution of the CICE sea-ice model 108 111 !! - update all sbc variables below sea-ice: 109 !! utau, vtau, qns , qsr, emp , emps112 !! utau, vtau, qns , qsr, emp , sfx 110 113 !!--------------------------------------------------------------------- 111 114 INTEGER, INTENT(in) :: kt ! ocean time step … … 143 146 !! ** Purpose: Initialise ice related fields for NEMO and coupling 144 147 !! 145 INTEGER, INTENT( in ) :: nsbc ! surface forcing type 146 !!--------------------------------------------------------------------- 147 148 INTEGER :: ji, jj, jpl ! dummy loop indices 148 INTEGER, INTENT( in ) :: nsbc ! surface forcing type 149 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 150 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 151 INTEGER :: ji, jj, jl ! dummy loop indices 152 !!--------------------------------------------------------------------- 149 153 150 154 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_init') 155 ! 156 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 151 157 ! 152 158 IF(lwp) WRITE(numout,*)'cice_sbc_init' … … 182 188 CALL cice2nemo(aice,fr_i, 'T', 1. ) 183 189 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 184 DO j pl=1,ncat185 CALL cice2nemo(aicen(:,:,j pl,:),a_i(:,:,jpl), 'T', 1. )190 DO jl=1,ncat 191 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 186 192 ENDDO 187 193 ENDIF … … 198 204 CALL lbc_lnk ( fr_iu , 'U', 1. ) 199 205 CALL lbc_lnk ( fr_iv , 'V', 1. ) 206 207 ! ! embedded sea ice 208 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 209 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 210 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 211 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 212 snwice_mass_b(:,:) = snwice_mass(:,:) 213 ELSE 214 snwice_mass (:,:) = 0.0_wp ! no mass exchanges 215 snwice_mass_b(:,:) = 0.0_wp ! no mass exchanges 216 ENDIF 217 IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart : 218 & .NOT.ln_rstart ) THEN ! deplete the initial ssh belew sea-ice area 219 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 220 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 221 ! 222 ! Note: Changed the initial values of sshb and sshn=> need to recompute ssh[u,v,f]_[b,n] 223 ! which were previously set in domvvl 224 IF ( lk_vvl ) THEN ! Is this necessary? embd 2 should be restricted to vvl only??? 225 DO jj = 1, jpjm1 226 DO ji = 1, jpim1 ! caution: use of Vector Opt. not possible 227 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 228 zcoefv = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 229 zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 230 sshu_b(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 231 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 232 sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshb(ji,jj ) & 233 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 234 sshu_n(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshn(ji ,jj) & 235 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 236 sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshn(ji,jj ) & 237 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 238 END DO 239 END DO 240 CALL lbc_lnk( sshu_b, 'U', 1. ) ; CALL lbc_lnk( sshu_n, 'U', 1. ) 241 CALL lbc_lnk( sshv_b, 'V', 1. ) ; CALL lbc_lnk( sshv_n, 'V', 1. ) 242 DO jj = 1, jpjm1 243 DO ji = 1, jpim1 ! NO Vector Opt. 244 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 245 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 246 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 247 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 248 END DO 249 END DO 250 CALL lbc_lnk( sshf_n, 'F', 1. ) 251 ENDIF 252 ENDIF 253 254 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 200 255 ! 201 256 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_init') … … 212 267 INTEGER, INTENT(in ) :: nsbc ! surface forcing type 213 268 214 INTEGER :: ji, jj, j pl ! dummy loop indices215 REAL(wp), DIMENSION(:,:), POINTER :: ztmp 269 INTEGER :: ji, jj, jl ! dummy loop indices 270 REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice 216 271 REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 272 REAL(wp) :: zintb, zintn ! dummy argument 217 273 !!--------------------------------------------------------------------- 218 274 219 275 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_in') 220 276 ! 221 CALL wrk_alloc( jpi,jpj, ztmp )277 CALL wrk_alloc( jpi,jpj, ztmp, zpice ) 222 278 CALL wrk_alloc( jpi,jpj,ncat, ztmpn ) 223 279 … … 259 315 ! Surface downward latent heat flux (CI_5) 260 316 IF (nsbc == 2) THEN 261 DO j pl=1,ncat262 ztmpn(:,:,j pl)=qla_ice(:,:,1)*a_i(:,:,jpl)317 DO jl=1,ncat 318 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 263 319 ENDDO 264 320 ELSE … … 269 325 DO ji=1,jpi 270 326 IF (fr_i(ji,jj).eq.0.0) THEN 271 DO j pl=1,ncat272 ztmpn(ji,jj,j pl)=0.0327 DO jl=1,ncat 328 ztmpn(ji,jj,jl)=0.0 273 329 ENDDO 274 330 ! This will then be conserved in CICE 275 331 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 276 332 ELSE 277 DO j pl=1,ncat278 ztmpn(ji,jj,j pl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj)333 DO jl=1,ncat 334 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 279 335 ENDDO 280 336 ENDIF … … 282 338 ENDDO 283 339 ENDIF 284 DO j pl=1,ncat285 CALL nemo2cice(ztmpn(:,:,j pl),flatn_f(:,:,jpl,:),'T', 1. )340 DO jl=1,ncat 341 CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 286 342 287 343 ! GBM conductive flux through ice (CI_6) 288 344 ! Convert to GBM 289 345 IF (nsbc == 2) THEN 290 ztmp(:,:) = botmelt(:,:,j pl)*a_i(:,:,jpl)346 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 291 347 ELSE 292 ztmp(:,:) = botmelt(:,:,j pl)348 ztmp(:,:) = botmelt(:,:,jl) 293 349 ENDIF 294 CALL nemo2cice(ztmp,fcondtopn_f(:,:,j pl,:),'T', 1. )350 CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. ) 295 351 296 352 ! GBM surface heat flux (CI_7) 297 353 ! Convert to GBM 298 354 IF (nsbc == 2) THEN 299 ztmp(:,:) = (topmelt(:,:,j pl)+botmelt(:,:,jpl))*a_i(:,:,jpl)355 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 300 356 ELSE 301 ztmp(:,:) = (topmelt(:,:,j pl)+botmelt(:,:,jpl))357 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 302 358 ENDIF 303 CALL nemo2cice(ztmp,fsurfn_f(:,:,j pl,:),'T', 1. )359 CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ) 304 360 ENDDO 305 361 … … 383 439 CALL nemo2cice(ztmp,vocn,'F', -1. ) 384 440 441 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! 442 ! 443 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 444 ! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 445 zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 446 ! 447 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 448 ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 449 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 450 ! 451 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 452 ! 453 ! 454 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 455 zpice(:,:) = ssh_m(:,:) 456 ENDIF 457 385 458 ! x comp and y comp of sea surface slope (on F points) 386 459 ! T point to F point 387 460 DO jj=1,jpjm1 388 461 DO ji=1,jpim1 389 ztmp(ji,jj)=0.5 * ( ( ssh_m(ji+1,jj )-ssh_m(ji,jj ))/e1u(ji,jj ) &390 + ( ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) &462 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj ))/e1u(ji,jj ) & 463 + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 391 464 * fmask(ji,jj,1) 392 465 ENDDO … … 397 470 DO jj=1,jpjm1 398 471 DO ji=1,jpim1 399 ztmp(ji,jj)=0.5 * ( ( ssh_m(ji ,jj+1)-ssh_m(ji ,jj))/e2v(ji ,jj) &400 + ( ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) &472 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj))/e2v(ji ,jj) & 473 + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 401 474 * fmask(ji,jj,1) 402 475 ENDDO … … 420 493 INTEGER, INTENT( in ) :: nsbc ! surface forcing type 421 494 422 INTEGER :: ji, jj, j pl ! dummy loop indices423 REAL(wp), DIMENSION(:,:), POINTER :: ztmp 495 INTEGER :: ji, jj, jl ! dummy loop indices 496 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 424 497 !!--------------------------------------------------------------------- 425 498 426 499 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_out') 427 500 ! 428 CALL wrk_alloc( jpi,jpj, ztmp )501 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 429 502 430 503 IF( kt == nit000 ) THEN … … 433 506 434 507 ! x comp of ocean-ice stress 435 CALL cice2nemo(strocnx,ztmp ,'F', -1. )508 CALL cice2nemo(strocnx,ztmp1,'F', -1. ) 436 509 ss_iou(:,:)=0.0 437 510 ! F point to U point 438 511 DO jj=2,jpjm1 439 512 DO ji=2,jpim1 440 ss_iou(ji,jj) = 0.5 * ( ztmp (ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1)513 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 441 514 ENDDO 442 515 ENDDO … … 444 517 445 518 ! y comp of ocean-ice stress 446 CALL cice2nemo(strocny,ztmp ,'F', -1. )519 CALL cice2nemo(strocny,ztmp1,'F', -1. ) 447 520 ss_iov(:,:)=0.0 448 521 ! F point to V point … … 450 523 DO jj=1,jpjm1 451 524 DO ji=2,jpim1 452 ss_iov(ji,jj) = 0.5 * ( ztmp (ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1)525 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 453 526 ENDDO 454 527 ENDDO … … 473 546 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 474 547 ELSE IF (nsbc ==5) THEN 475 ! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above) 548 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 549 ! This is currently as required with the coupling fields from the UM atmosphere 476 550 emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:) 477 551 ENDIF 478 552 479 ! Subtract fluxes from CICE to get freshwater equivalent flux used in 480 ! salinity calculation 481 CALL cice2nemo(fresh_gbm,ztmp,'T', 1. ) 482 emps(:,:)=emp(:,:)-ztmp(:,:) 483 ! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU) 484 CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. ) 485 DO jj=1,jpj 486 DO ji=1,jpi 487 IF (sss_m(ji,jj).gt.0.0) THEN 488 emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj) 489 ENDIF 490 ENDDO 491 ENDDO 492 493 ! No longer remove precip over ice from free surface calculation on basis that the 494 ! weight of the precip will affect the free surface even if it falls on the ice 495 ! (same to the argument that freezing / melting of ice doesn't change the free surface) 496 ! Sublimation from the ice is treated in a similar way (included in emp but not emps) 497 ! 498 ! This should not be done in the variable volume case 499 500 IF (.NOT. lk_vvl) THEN 501 502 emp(:,:) = emp(:,:) - tprecip(:,:)*fr_i(:,:) 503 504 ! Take sublimation into account 505 IF (nsbc == 5 ) THEN 506 emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) ) 507 ELSE IF (nsbc == 2 ) THEN 508 emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub 509 ENDIF 510 511 ENDIF 512 553 CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 554 CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 555 556 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 557 ! Otherwise we are effectively allowing ice of higher salinity than the ocean to form 558 ! which has to be compensated for by the ocean salinity potentially going negative 559 ! This check breaks conservation but seems reasonable until we have prognostic ice salinity 560 ! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 561 WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0) 562 sfx(:,:)=ztmp2(:,:)*1000.0 563 emp(:,:)=emp(:,:)-ztmp1(:,:) 564 513 565 CALL lbc_lnk( emp , 'T', 1. ) 514 CALL lbc_lnk( emps, 'T', 1. )566 CALL lbc_lnk( sfx , 'T', 1. ) 515 567 516 568 ! Solar penetrative radiation and non solar surface heat flux … … 532 584 ! Now add in ice / snow related terms 533 585 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 534 CALL cice2nemo(fswthru_gbm,ztmp ,'T', 1. )535 qsr(:,:)=qsr(:,:)+ztmp (:,:)586 CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 587 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 536 588 CALL lbc_lnk( qsr , 'T', 1. ) 537 589 … … 542 594 ENDDO 543 595 544 CALL cice2nemo(fhocn_gbm,ztmp ,'T', 1. )545 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp (:,:)596 CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 597 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 546 598 547 599 CALL lbc_lnk( qns , 'T', 1. ) … … 551 603 CALL cice2nemo(aice,fr_i,'T', 1. ) 552 604 IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 553 DO j pl=1,ncat554 CALL cice2nemo(aicen(:,:,j pl,:),a_i(:,:,jpl), 'T', 1. )605 DO jl=1,ncat 606 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 555 607 ENDDO 556 608 ENDIF … … 568 620 CALL lbc_lnk ( fr_iv , 'V', 1. ) 569 621 622 ! ! embedded sea ice 623 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 624 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 625 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 626 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 627 snwice_mass_b(:,:) = snwice_mass(:,:) 628 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 629 ENDIF 630 570 631 ! Release work space 571 632 572 CALL wrk_dealloc( jpi,jpj, ztmp )633 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 573 634 ! 574 635 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_out') … … 587 648 !!--------------------------------------------------------------------- 588 649 589 INTEGER :: j pl ! dummy loop index650 INTEGER :: jl ! dummy loop index 590 651 INTEGER :: ierror 591 652 … … 610 671 ! Snow and ice thicknesses (CO_2 and CO_3) 611 672 612 DO j pl = 1,ncat613 CALL cice2nemo(vsnon(:,:,j pl,:),ht_s(:,:,jpl),'T', 1. )614 CALL cice2nemo(vicen(:,:,j pl,:),ht_i(:,:,jpl),'T', 1. )673 DO jl = 1,ncat 674 CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 675 CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 615 676 ENDDO 616 677 ! … … 780 841 REAL(wp), DIMENSION(jpi,jpj) :: pn 781 842 #if !defined key_nemocice_decomp 843 REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 782 844 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 783 845 #endif … … 798 860 ! Copy local domain data from NEMO to CICE field 799 861 pc(:,:,1)=0.0 800 DO jj=2,ny_block 801 DO ji=2,nx_block 802 pc(ji,jj,1)=pn(ji ,jj-1)862 DO jj=2,ny_block-1 863 DO ji=2,nx_block-1 864 pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off) 803 865 ENDDO 804 866 ENDDO … … 824 886 ! pcg(:,:)=0.0 825 887 DO jn=1,jpnij 826 DO jj= 1,nlcjt(jn)-1827 DO ji= 2,nlcit(jn)-1828 p cg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)888 DO jj=nldjt(jn),nlejt(jn) 889 DO ji=nldit(jn),nleit(jn) 890 png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 829 891 ENDDO 892 ENDDO 893 ENDDO 894 DO jj=1,ny_global 895 DO ji=1,nx_global 896 pcg(ji,jj)=png2(ji+ji_off,jj+jj_off) 830 897 ENDDO 831 898 ENDDO … … 922 989 DO jj=1,jpjm1 923 990 DO ji=1,jpim1 924 pn(ji,jj)=pc(ji ,jj+1,1)991 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 925 992 ENDDO 926 993 ENDDO … … 936 1003 ! Need to make sure this is robust to changes in NEMO halo rows.... 937 1004 ! (may be OK but not spent much time thinking about it) 1005 ! Note that non-existent pcg elements may be used below, but 1006 ! the lbclnk call on pn will replace these with sensible values 938 1007 939 1008 IF (nproc==0) THEN 940 1009 png(:,:,:)=0.0 941 1010 DO jn=1,jpnij 942 DO jj= 1,nlcjt(jn)-1943 DO ji= 2,nlcit(jn)-1944 png(ji,jj,jn)=pcg(ji+nimppt(jn)- 2,jj+njmppt(jn)-1)1011 DO jj=nldjt(jn),nlejt(jn) 1012 DO ji=nldit(jn),nleit(jn) 1013 png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 945 1014 ENDDO 946 1015 ENDDO -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r3294 r3625 5 5 !! covered area using ice-if model 6 6 !!====================================================================== 7 !! History : 3.0 7 !! History : 3.0 ! 2006-06 (G. Madec) Original code 8 8 !!---------------------------------------------------------------------- 9 9 10 10 !!---------------------------------------------------------------------- 11 !! sbc_ice_if 11 !! sbc_ice_if : update sbc in ice-covered area 12 12 !!---------------------------------------------------------------------- 13 USE oce 14 USE dom_oce 15 USE phycst 16 USE eosbn2 17 USE sbc_oce 13 USE oce ! ocean dynamics and tracers 14 USE dom_oce ! ocean space and time domain 15 USE phycst ! physical constants 16 USE eosbn2 ! equation of state 17 USE sbc_oce ! surface boundary condition: ocean fields 18 18 USE sbccpl 19 USE fldread ! read input field 20 USE iom ! I/O manager library 21 USE in_out_manager ! I/O manager 22 USE lib_mpp ! MPP library 19 USE fldread ! read input field 20 USE iom ! I/O manager library 21 USE in_out_manager ! I/O manager 22 USE lib_mpp ! MPP library 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 23 24 24 25 IMPLICIT NONE … … 51 52 !! taum, wndm : remain unchanged 52 53 !! qns, qsr : update heat flux below sea-ice 53 !! emp, emps: update freshwater flux below sea-ice54 !! emp, sfx : update freshwater flux below sea-ice 54 55 !! fr_i : update the ice fraction 55 56 !!--------------------------------------------------------------------- -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r3294 r3625 10 10 !! - ! 2008-04 (G. Madec) sltyle and lim_ctl routine 11 11 !! 3.3 ! 2010-11 (G. Madec) ice-ocean stress always computed at each ocean time-step 12 !! 4.0! 2011-01 (A Porter) dynamical allocation12 !! 3.4 ! 2011-01 (A Porter) dynamical allocation 13 13 !!---------------------------------------------------------------------- 14 14 #if defined key_lim3 … … 88 88 !! ** Action : - time evolution of the LIM sea-ice model 89 89 !! - update all sbc variables below sea-ice: 90 !! utau, vtau, taum, wndm, qns , qsr, emp , emps90 !! utau, vtau, taum, wndm, qns , qsr, emp , sfx 91 91 !!--------------------------------------------------------------------- 92 92 INTEGER, INTENT(in) :: kt ! ocean time step … … 170 170 171 171 ! ! intialisation to zero !!gm is it truly necessary ??? 172 d_a_i_thd (:,:,:) = 0. e0 ; d_a_i_trp (:,:,:) = 0.e0173 d_v_i_thd (:,:,:) = 0. e0 ; d_v_i_trp (:,:,:) = 0.e0174 d_e_i_thd (:,:,:,:) = 0. e0 ; d_e_i_trp (:,:,:,:) = 0.e0175 d_v_s_thd (:,:,:) = 0. e0 ; d_v_s_trp (:,:,:) = 0.e0176 d_e_s_thd (:,:,:,:) = 0. e0 ; d_e_s_trp (:,:,:,:) = 0.e0177 d_smv_i_thd(:,:,:) = 0. e0 ; d_smv_i_trp(:,:,:) = 0.e0178 d_oa_i_thd (:,:,:) = 0. e0 ; d_oa_i_trp (:,:,:) = 0.e0179 ! 180 fseqv (:,:) = 0.e0181 fsbri (:,:) = 0.e0 ; fsalt_res(:,:) = 0.e0182 f salt_rpo(:,:) = 0.e0183 fhmec (:,:) = 0.e0 ; fhbri (:,:) = 0.e0184 fmmec (:,:) = 0.e0 ; fheat_res(:,:) = 0.e0185 f heat_rpo(:,:) = 0.e0 ; focea2D (:,:) = 0.e0186 fsup2D (:,:) = 0.e0172 d_a_i_thd (:,:,:) = 0._wp ; d_a_i_trp (:,:,:) = 0._wp 173 d_v_i_thd (:,:,:) = 0._wp ; d_v_i_trp (:,:,:) = 0._wp 174 d_e_i_thd (:,:,:,:) = 0._wp ; d_e_i_trp (:,:,:,:) = 0._wp 175 d_v_s_thd (:,:,:) = 0._wp ; d_v_s_trp (:,:,:) = 0._wp 176 d_e_s_thd (:,:,:,:) = 0._wp ; d_e_s_trp (:,:,:,:) = 0._wp 177 d_smv_i_thd(:,:,:) = 0._wp ; d_smv_i_trp(:,:,:) = 0._wp 178 d_oa_i_thd (:,:,:) = 0._wp ; d_oa_i_trp (:,:,:) = 0._wp 179 ! 180 sfx (:,:) = 0._wp 181 sfx_bri(:,:) = 0._wp ; sfx_mec (:,:) = 0._wp ; sfx_res (:,:) = 0._wp 182 fhbri (:,:) = 0._wp ; fheat_mec(:,:) = 0._wp ; fheat_res(:,:) = 0._wp 183 fhmec (:,:) = 0._wp ; 184 fmmec (:,:) = 0._wp 185 focea2D(:,:) = 0._wp 186 fsup2D (:,:) = 0._wp 187 187 ! 188 diag_sni_gr(:,:) = 0. e0 ; diag_lat_gr(:,:) = 0.e0189 diag_bot_gr(:,:) = 0. e0 ; diag_dyn_gr(:,:) = 0.e0190 diag_bot_me(:,:) = 0. e0 ; diag_sur_me(:,:) = 0.e0188 diag_sni_gr(:,:) = 0._wp ; diag_lat_gr(:,:) = 0._wp 189 diag_bot_gr(:,:) = 0._wp ; diag_dyn_gr(:,:) = 0._wp 190 diag_bot_me(:,:) = 0._wp ; diag_sur_me(:,:) = 0._wp 191 191 ! dynamical invariants 192 delta_i(:,:) = 0. e0 ; divu_i(:,:) = 0.e0 ; shear_i(:,:) = 0.e0192 delta_i(:,:) = 0._wp ; divu_i(:,:) = 0._wp ; shear_i(:,:) = 0._wp 193 193 194 194 CALL lim_rst_opn( kt ) ! Open Ice restart file … … 196 196 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print 197 197 ! 198 IF( .NOT. lk_c1d ) THEN 199 ! Ice dynamics & transport (not in 1D case) 198 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (except in 1D case) 200 199 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 201 200 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) … … 210 209 CALL lim_var_bv ! bulk brine volume (diag) 211 210 CALL lim_thd( kt ) ! Ice thermodynamics 212 zcoef = rdt_ice / 86400.e0! Ice natural aging211 zcoef = rdt_ice /rday ! Ice natural aging 213 212 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 214 213 CALL lim_var_glo2eqv ! this CALL is maybe not necessary (Martin) … … 268 267 269 268 inb_altests = 10 270 inb_alp(:) = 0269 inb_alp(:) = 0 271 270 272 271 ! Alert if incompatible volume and concentration … … 277 276 DO jj = 1, jpj 278 277 DO ji = 1, jpi 279 IF( v_i(ji,jj,jl) /= 0. e0 .AND. a_i(ji,jj,jl) == 0.e0) THEN278 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 280 279 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 281 280 WRITE(numout,*) ' at_i ', at_i(ji,jj) … … 297 296 DO jj = 1, jpj 298 297 DO ji = 1, jpi 299 IF( ht_i(ji,jj,jl) .GT. 50.0) THEN298 IF( ht_i(ji,jj,jl) > 50._wp ) THEN 300 299 CALL lim_prt_state( ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 301 300 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 309 308 DO jj = 1, jpj 310 309 DO ji = 1, jpi 311 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) .GT.0.5 .AND. &312 & at_i(ji,jj) .GT. 0.e0) THEN310 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 0.5 .AND. & 311 & at_i(ji,jj) > 0._wp ) THEN 313 312 CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 314 313 WRITE(numout,*) ' ice strength : ', strength(ji,jj) … … 332 331 DO jj = 1, jpj 333 332 DO ji = 1, jpi 334 IF( tms(ji,jj) .LE. 0.0 .AND. at_i(ji,jj) .GT. 0.e0) THEN333 IF( tms(ji,jj) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 335 334 CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 336 335 WRITE(numout,*) ' masks s, u, v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) … … 356 355 DO ji = 1, jpi 357 356 !!gm test twice sm_i ... ???? bug? 358 IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR.&359 ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. &360 ( a_i(ji,jj,jl) .GT. 0.e0) ) THEN357 IF( ( ( ABS( sm_i(ji,jj,jl) ) < 0.5 ) .OR. & 358 ( ABS( sm_i(ji,jj,jl) ) < 0.5 ) ) .AND. & 359 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 361 360 ! CALL lim_prt_state(ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 362 361 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj) … … 377 376 DO jj = 1, jpj 378 377 DO ji = 1, jpi 379 IF ( ( ( ABS( o_i(ji,jj,jl) ) .GT.rdt_ice ) .OR. &380 ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. &381 ( a_i(ji,jj,jl) .GT. 0.0) ) THEN378 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 379 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 380 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 382 381 CALL lim_prt_state( ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 383 382 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 392 391 DO jj = 1, jpj 393 392 DO ji = 1, jpi 394 IF( ABS( emps(ji,jj) ) .GT. 1.0e-2 ) THEN393 IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN 395 394 CALL lim_prt_state( ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 396 395 DO jl = 1, jpl … … 412 411 DO jj = 1, jpj 413 412 DO ji = 1, jpi 414 IF( ABS( qns(ji,jj) ) .GT. 1500.0 .AND. ( at_i(ji,jj) .GT. 0.0 )) THEN413 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 415 414 ! 416 415 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' … … 429 428 WRITE(numout,*) ' fdtcn : ', fdtcn(ji,jj) 430 429 WRITE(numout,*) ' fhmec : ', fhmec(ji,jj) 431 WRITE(numout,*) ' fheat_ rpo : ', fheat_rpo(ji,jj)430 WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj) 432 431 WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 433 432 WRITE(numout,*) ' fhbri : ', fhbri(ji,jj) … … 450 449 DO ji = 1, jpi 451 450 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt 452 IF( t_i(ji,jj,jk,jl) .GE. ztmelts .AND. v_i(ji,jj,jl) .GT.1.e-6 &453 & .AND. a_i(ji,jj,jl) .GT. 0.e0) THEN451 IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-6 & 452 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 454 453 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 455 454 WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl … … 606 605 WRITE(numout,*) ' - Heat / FW fluxes ' 607 606 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 608 ! WRITE(numout,*) ' fsbri : ', fsbri(ki,kj)609 ! WRITE(numout,*) ' fseqv : ', fseqv(ki,kj)607 ! WRITE(numout,*) ' sfx_bri : ', sfx_bri (ki,kj) 608 ! WRITE(numout,*) ' sfx : ', sfx (ki,kj) 610 609 ! WRITE(numout,*) ' fsalt_res : ', fsalt_res(ki,kj) 611 WRITE(numout,*) ' fmmec : ', fmmec (ki,kj)612 WRITE(numout,*) ' fhmec : ', fhmec (ki,kj)613 WRITE(numout,*) ' fhbri : ', fhbri (ki,kj)614 WRITE(numout,*) ' fheat_ rpo : ', fheat_rpo(ki,kj)610 WRITE(numout,*) ' fmmec : ', fmmec (ki,kj) 611 WRITE(numout,*) ' fhmec : ', fhmec (ki,kj) 612 WRITE(numout,*) ' fhbri : ', fhbri (ki,kj) 613 WRITE(numout,*) ' fheat_mec : ', fheat_mec(ki,kj) 615 614 WRITE(numout,*) 616 615 WRITE(numout,*) ' sst : ', sst_m(ki,kj) … … 621 620 WRITE(numout,*) ' utau_ice : ', utau_ice(ki,kj) 622 621 WRITE(numout,*) ' vtau_ice : ', vtau_ice(ki,kj) 623 WRITE(numout,*) ' utau : ', utau (ki,kj)624 WRITE(numout,*) ' vtau : ', vtau (ki,kj)625 WRITE(numout,*) ' oc. vel. u : ', u_oce (ki,kj)626 WRITE(numout,*) ' oc. vel. v : ', v_oce (ki,kj)622 WRITE(numout,*) ' utau : ', utau (ki,kj) 623 WRITE(numout,*) ' vtau : ', vtau (ki,kj) 624 WRITE(numout,*) ' oc. vel. u : ', u_oce (ki,kj) 625 WRITE(numout,*) ' oc. vel. v : ', v_oce (ki,kj) 627 626 ENDIF 628 627 … … 640 639 WRITE(numout,*) 641 640 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 642 WRITE(numout,*) ' qsr 643 WRITE(numout,*) ' qns 641 WRITE(numout,*) ' qsr : ', qsr(ki,kj) 642 WRITE(numout,*) ' qns : ', qns(ki,kj) 644 643 WRITE(numout,*) 645 644 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 646 WRITE(numout,*) ' emps : ', emps(ki,kj) 647 WRITE(numout,*) ' emp : ', emp(ki,kj) 648 WRITE(numout,*) ' fsbri : ', fsbri(ki,kj) 649 WRITE(numout,*) ' fseqv : ', fseqv(ki,kj) 650 WRITE(numout,*) ' fsalt_res : ', fsalt_res(ki,kj) 651 WRITE(numout,*) ' fsalt_rpo : ', fsalt_rpo(ki,kj) 645 WRITE(numout,*) ' emp : ', emp (ki,kj) 646 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ki,kj) 647 WRITE(numout,*) ' sfx : ', sfx (ki,kj) 648 WRITE(numout,*) ' sfx_res : ', sfx_res(ki,kj) 649 WRITE(numout,*) ' sfx_mec : ', sfx_mec(ki,kj) 652 650 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 653 WRITE(numout,*) ' fheat_res 651 WRITE(numout,*) ' fheat_res : ', fheat_res(ki,kj) 654 652 WRITE(numout,*) 655 653 WRITE(numout,*) ' - Momentum fluxes ' -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r3294 r3625 82 82 !! ** Action : - time evolution of the LIM sea-ice model 83 83 !! - update all sbc variables below sea-ice: 84 !! utau, vtau, taum, wndm, qns , qsr, emp , emps84 !! utau, vtau, taum, wndm, qns , qsr, emp , sfx 85 85 !!--------------------------------------------------------------------- 86 86 INTEGER, INTENT(in) :: kt ! ocean time step -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3609 r3625 12 12 !! - ! 2010-10 (J. Chanut, C. Bricaud, G. Madec) add the surface pressure forcing 13 13 !! 3.4 ! 2011-11 (C. Harris) CICE added as an option 14 !! 3.5 ! 2012-11 (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes 14 15 !!---------------------------------------------------------------------- 15 16 … … 84 85 INTEGER :: icpt ! local integer 85 86 !! 86 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx , ln_blk_clio, ln_blk_core, ln_cpl, & 87 & ln_blk_mfs, ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr , nn_fwb, ln_cdgw 87 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl, & 88 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 89 & ln_ssr , nn_fwb , ln_cdgw 88 90 !!---------------------------------------------------------------------- 89 91 … … 121 123 WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn 122 124 WRITE(numout,*) ' ice management in the sbc (=0/1/2/3) nn_ice = ', nn_ice 125 WRITE(numout,*) ' ice-ocean embedded/levitating (=0/1/2) nn_ice_embd = ', nn_ice_embd 123 126 WRITE(numout,*) ' daily mean to diurnal cycle qsr ln_dm2dc = ', ln_dm2dc 124 127 WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf … … 136 139 IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' ) 137 140 nkrnf = 0 138 rnf (:,:) = 0. e0139 rnfmsk (:,:) = 0. e0140 rnfmsk_z(:) = 0. e0141 rnf (:,:) = 0.0_wp 142 rnfmsk (:,:) = 0.0_wp 143 rnfmsk_z(:) = 0.0_wp 141 144 ENDIF 142 145 IF( nn_ice == 0 ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 146 147 sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 148 ! only if sea-ice is present 143 149 144 150 ! ! restartability … … 157 163 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) ) & 158 164 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 159 IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) ) & 160 & CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 165 IF( nn_ice == 4 .AND. lk_agrif ) & 166 & CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 167 IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 ) & 168 & CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 2 or 3' ) 161 169 162 170 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag … … 226 234 !! ** Action : - set the ocean surface boundary condition at before and now 227 235 !! time step, i.e. 228 !! utau_b, vtau_b, qns_b, qsr_b, emp_n, emps_b, qrp_b, erp_b229 !! utau , vtau , qns , qsr , emp , emps, qrp , erp236 !! utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b 237 !! utau , vtau , qns , qsr , emp , sfx , qrp , erp 230 238 !! - updte the ice fraction : fr_i 231 239 !!---------------------------------------------------------------------- … … 243 251 ! The 3D heat content due to qsr forcing is treated in traqsr 244 252 ! qsr_b (:,:) = qsr (:,:) 245 emp_b (:,:) = emp(:,:)246 emps_b(:,:) = emps(:,:)253 emp_b(:,:) = emp(:,:) 254 sfx_b(:,:) = sfx(:,:) 247 255 ENDIF 248 256 ! ! ---------------------------------------- ! … … 262 270 263 271 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 264 ! ! (i.e. utau,vtau, qns, qsr, emp, emps)272 ! ! (i.e. utau,vtau, qns, qsr, emp, sfx) 265 273 CASE( 0 ) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration 266 274 CASE( 1 ) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc … … 314 322 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point) 315 323 ! The 3D heat content due to qsr forcing is treated in traqsr 316 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point) 317 CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b ) ! before freshwater flux (T-point) 318 CALL iom_get( numror, jpdom_autoglo, 'emps_b', emps_b ) ! before C/D freshwater flux (T-point) 324 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point) 325 CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b ) ! before freshwater flux (T-point) 326 ! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6 327 IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 328 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point) 329 ELSE 330 sfx_b (:,:) = sfx(:,:) 331 ENDIF 319 332 ELSE !* no restart: set from nit000 values 320 333 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' … … 322 335 vtau_b(:,:) = vtau(:,:) 323 336 qns_b (:,:) = qns (:,:) 324 ! qsr_b (:,:) = qsr (:,:) 325 emp_b (:,:) = emp (:,:) 326 emps_b(:,:) = emps(:,:) 337 emp_b (:,:) = emp(:,:) 338 sfx_b (:,:) = sfx(:,:) 327 339 ENDIF 328 340 ENDIF … … 340 352 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 341 353 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 342 CALL iom_rstput( kt, nitrst, numrow, ' emps_b' , emps)354 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 343 355 ENDIF 344 356 … … 348 360 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 349 361 CALL iom_put( "empmr" , emp - rnf ) ! upward water flux 350 CALL iom_put( "empsmr", emps - rnf ) ! c/d water flux 362 CALL iom_put( "saltflx", sfx ) ! downward salt flux 363 ! (includes virtual salt flux beneath ice 364 ! in linear free surface case) 351 365 CALL iom_put( "qt" , qns + qsr ) ! total heat flux 352 366 CALL iom_put( "qns" , qns ) ! solar heat flux … … 365 379 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 ) 366 380 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 ) 367 CALL prt_ctl(tab2d_1=( emps-rnf) , clinfo1=' emps-rnf- : ', mask1=tmask, ovlap=1 )381 CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 ) 368 382 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask, ovlap=1 ) 369 383 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1 ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r3294 r3625 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) … … 83 82 END FUNCTION sbc_rnf_alloc 84 83 84 85 85 SUBROUTINE sbc_rnf( kt ) 86 86 !!---------------------------------------------------------------------- … … 96 96 !!---------------------------------------------------------------------- 97 97 INTEGER, INTENT(in) :: kt ! ocean time step 98 ! !98 ! 99 99 INTEGER :: ji, jj ! dummy loop indices 100 100 !!---------------------------------------------------------------------- … … 127 127 ! 128 128 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 129 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )130 129 ! 131 r1_rau0 = 1._wp / rau0 130 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 131 ! 132 132 ! ! set temperature & salinity content of runoffs 133 133 IF( ln_rnf_tem ) THEN ! use runoffs temperature data … … 199 199 !! 200 200 INTEGER :: ji, jj, jk ! dummy loop indices 201 REAL(wp) :: r1_rau0 ! local scalar202 201 REAL(wp) :: zfact ! local scalar 203 202 !!---------------------------------------------------------------------- … … 205 204 zfact = 0.5_wp 206 205 ! 207 r1_rau0 = 1._wp / rau0208 206 IF( ln_rnf_depth ) THEN !== runoff distributed over several levels ==! 209 207 IF( lk_vvl ) THEN ! variable volume case … … 252 250 INTEGER :: ji, jj, jk ! dummy loop indices 253 251 INTEGER :: ierror, inum ! temporary integer 254 ! !252 ! 255 253 NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, & 256 254 & sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, & 257 255 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact 258 256 !!---------------------------------------------------------------------- 259 257 ! 260 258 ! ! ============ 261 259 ! ! Namelist … … 273 271 REWIND ( numnam ) ! Read Namelist namsbc_rnf 274 272 READ ( numnam, namsbc_rnf ) 275 273 ! 276 274 ! ! Control print 277 275 IF(lwp) THEN … … 286 284 WRITE(numout,*) ' multiplicative factor for runoff rn_rfact = ', rn_rfact 287 285 ENDIF 288 286 ! 289 287 ! ! ================== 290 288 ! ! Type of runoff … … 395 393 nkrnf = 2 396 394 DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1 ; END DO 397 IF( ln_sco ) & 398 CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 395 IF( ln_sco ) CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 399 396 ENDIF 400 397 IF(lwp) WRITE(numout,*) … … 414 411 nkrnf = 0 415 412 ENDIF 416 413 ! 417 414 END SUBROUTINE sbc_rnf_init 418 415 … … 438 435 !! rnfmsk_z vertical structure 439 436 !!---------------------------------------------------------------------- 440 !441 437 INTEGER :: inum ! temporary integers 442 438 CHARACTER(len=140) :: cl_rnfile ! runoff file name … … 446 442 IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask' 447 443 IF(lwp) WRITE(numout,*) '~~~~~~~~~ ' 448 444 ! 449 445 cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname ) 450 446 IF( .NOT. sn_cnf%ln_clim ) THEN ; WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear ! add year 451 447 IF( sn_cnf%cltype == 'monthly' ) WRITE(cl_rnfile, '(a,"m",i2)' ) TRIM( cl_rnfile ), nmonth ! add month 452 448 ENDIF 453 449 ! 454 450 ! horizontal mask (read in NetCDF file) 455 451 CALL iom_open ( cl_rnfile, inum ) ! open file 456 452 CALL iom_get ( inum, jpdom_data, sn_cnf%clvar, rnfmsk ) ! read the river mouth array 457 453 CALL iom_close( inum ) ! close file 458 454 ! 459 455 IF( nclosea == 1 ) CALL clo_rnf( rnfmsk ) ! closed sea inflow set as ruver mouth 460 456 ! 461 457 rnfmsk_z(:) = 0._wp ! vertical structure 462 458 rnfmsk_z(1) = 1.0 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r3294 r3625 9 9 10 10 !!---------------------------------------------------------------------- 11 !! sbc_ssr : add to sbc a restoring term toward SST/SSS climatology 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers 14 USE dom_oce ! ocean space and time domain 15 USE sbc_oce ! surface boundary condition 16 USE phycst ! physical constants 17 USE sbcrnf ! surface boundary condition : runoffs 18 USE fldread ! read input fields 19 USE iom ! I/O manager 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! distribued memory computing library 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 USE timing ! Timing 11 !! sbc_ssr : add to sbc a restoring term toward SST/SSS climatology 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers 14 USE dom_oce ! ocean space and time domain 15 USE sbc_oce ! surface boundary condition 16 USE phycst ! physical constants 17 USE sbcrnf ! surface boundary condition : runoffs 18 USE fldread ! read input fields 19 USE iom ! I/O manager 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! distribued memory computing library 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 USE timing ! Timing 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 24 25 25 26 IMPLICIT NONE … … 63 64 !! - at each nscb time step 64 65 !! add a retroaction term on qns (nn_sstr = 1) 65 !! add a damping term on emps(nn_sssr = 1)66 !! add a damping term on emp & emps(nn_sssr = 2)66 !! add a damping term on sfx (nn_sssr = 1) 67 !! add a damping term on emp (nn_sssr = 2) 67 68 !!--------------------------------------------------------------------- 68 69 INTEGER, INTENT(in ) :: kt ! ocean time step … … 156 157 ! ! ========================= ! 157 158 ! 158 IF( nn_sstr == 1 ) THEN !* Temperature restoring term159 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 159 160 !CDIR COLLAPSE 160 161 DO jj = 1, jpj … … 168 169 ENDIF 169 170 ! 170 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux, emps only)171 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 171 172 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 172 173 !CDIR COLLAPSE … … 174 175 DO ji = 1, jpi 175 176 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 177 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) 178 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux 179 erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 180 180 END DO 181 181 END DO 182 182 CALL iom_put( "erp", erp ) ! freshwater flux damping 183 183 ! 184 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux, emp and emps)184 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 185 185 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 186 186 zerp_bnd = rn_sssr_bnd / rday ! - - … … 190 190 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 191 191 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 192 & / ( sss_m(ji,jj) +1.e-20 )192 & / MAX( sss_m(ji,jj), 1.e-20 ) 193 193 IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 194 emp 195 emps(ji,jj) = emps(ji,jj) + zerp196 erp 194 emp(ji,jj) = emp (ji,jj) + zerp 195 qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 196 erp(ji,jj) = zerp 197 197 END DO 198 198 END DO -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r3294 r3625 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_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r3294 r3625 14 14 !! and vertical advection trends using MUSCL scheme 15 15 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and active tracers 17 USE dom_oce ! ocean space and time domain 18 USE trdmod_oce ! tracers trends 19 USE trdtra ! tracers trends 20 USE in_out_manager ! I/O manager 21 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 22 USE trabbl ! tracers: bottom boundary layer 23 USE lib_mpp ! distribued memory computing 24 USE lbclnk ! ocean lateral boundary condition (or mpp link) 25 USE diaptr ! poleward transport diagnostics 26 USE trc_oce ! share passive tracers/Ocean variables 27 USE wrk_nemo ! Memory Allocation 28 USE timing ! Timing 16 USE oce ! ocean dynamics and active tracers 17 USE dom_oce ! ocean space and time domain 18 USE trdmod_oce ! tracers trends 19 USE trdtra ! tracers trends 20 USE in_out_manager ! I/O manager 21 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 22 USE trabbl ! tracers: bottom boundary layer 23 USE lib_mpp ! distribued memory computing 24 USE lbclnk ! ocean lateral boundary condition (or mpp link) 25 USE diaptr ! poleward transport diagnostics 26 USE trc_oce ! share passive tracers/Ocean variables 27 USE wrk_nemo ! Memory Allocation 28 USE timing ! Timing 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 29 30 30 31 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r3294 r3625 25 25 USE wrk_nemo ! Memory Allocation 26 26 USE timing ! Timing 27 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 28 29 29 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r3301 r3625 28 28 USE wrk_nemo ! Memory Allocation 29 29 USE timing ! Timing 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 31 31 32 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r3294 r3625 17 17 18 18 !!---------------------------------------------------------------------- 19 !! tra_adv_tvd : update the tracer trend with the horizontal 20 !! and vertical advection trends using a TVD scheme 21 !! nonosc : compute monotonic tracer fluxes by a nonoscillatory 22 !! algorithm 23 !!---------------------------------------------------------------------- 24 USE oce ! ocean dynamics and active tracers 25 USE dom_oce ! ocean space and time domain 26 USE trdmod_oce ! tracers trends 27 USE trdtra ! tracers trends 28 USE in_out_manager ! I/O manager 29 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 30 USE lib_mpp ! MPP library 31 USE lbclnk ! ocean lateral boundary condition (or mpp link) 32 USE diaptr ! poleward transport diagnostics 33 USE trc_oce ! share passive tracers/Ocean variables 34 USE wrk_nemo ! Memory Allocation 35 USE timing ! Timing 19 !! tra_adv_tvd : update the tracer trend with the 3D advection trends using a TVD scheme 20 !! nonosc : compute monotonic tracer fluxes by a non-oscillatory algorithm 21 !!---------------------------------------------------------------------- 22 USE oce ! ocean dynamics and active tracers 23 USE dom_oce ! ocean space and time domain 24 USE trdmod_oce ! tracers trends 25 USE trdtra ! tracers trends 26 USE in_out_manager ! I/O manager 27 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 28 USE lib_mpp ! MPP library 29 USE lbclnk ! ocean lateral boundary condition (or mpp link) 30 USE diaptr ! poleward transport diagnostics 31 USE trc_oce ! share passive tracers/Ocean variables 32 USE wrk_nemo ! Memory Allocation 33 USE timing ! Timing 34 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 36 35 37 36 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r3294 r3625 12 12 !! advection trends using a third order biaised scheme 13 13 !!---------------------------------------------------------------------- 14 USE oce 15 USE dom_oce 16 USE trdmod_oce 14 USE oce ! ocean dynamics and active tracers 15 USE dom_oce ! ocean space and time domain 16 USE trdmod_oce ! ocean space and time domain 17 17 USE trdtra 18 18 USE lib_mpp 19 USE lbclnk ! ocean lateral boundary condition (or mpp link) 20 USE in_out_manager ! I/O manager 21 USE diaptr ! poleward transport diagnostics 22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 USE trc_oce ! share passive tracers/Ocean variables 24 USE wrk_nemo ! Memory Allocation 25 USE timing ! Timing 19 USE lbclnk ! ocean lateral boundary condition (or mpp link) 20 USE in_out_manager ! I/O manager 21 USE diaptr ! poleward transport diagnostics 22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 USE trc_oce ! share passive tracers/Ocean variables 24 USE wrk_nemo ! Memory Allocation 25 USE timing ! Timing 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 27 27 28 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r3294 r3625 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_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r3294 r3625 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_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r3294 r3625 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 + sfx / 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 !! + sfx / rau0 / e3t 88 92 !! where emp, the surface freshwater budget (evaporation minus 89 93 !! precipitation minus runoff) given in kg/m2/s is divided 90 !! by 1035 kg/m3 (density of ocena water) to obtain m/s.94 !! by rau0 = 1020 kg/m3 (density of sea water) to obtain m/s. 91 95 !! Note: even though Fwe does not appear explicitly for 92 96 !! temperature in this routine, the heat carried by the water … … 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 * sfx(ji,jj) ! salt flux due to freezing/melting 172 172 END DO 173 173 END DO 174 ELSE ! Constant Volume case 174 ELSE ! Constant Volume case ==>> Concentration dilution effect 175 175 DO jj = 2, jpj 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) 179 ! 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) 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 180 ! salinity : salt flux + concent./dilut. effect (both in sfx) 181 sbc_tsc(ji,jj,jp_sal) = r1_rau0 * ( sfx(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 185 CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) ) ! c/d term on sst 186 CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) ) ! c/d term on sss 183 187 ENDIF 184 188 ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r3294 r3625 12 12 !! 'key_zdfgls' Generic Length Scale vertical physics 13 13 !!---------------------------------------------------------------------- 14 !! zdf_gls : update momentum and tracer Kz from a gls scheme15 !! zdf_gls_init : initialization, namelist read, and parameters control16 !! gls_rst : read/write gls restart in ocean restart file14 !! zdf_gls : update momentum and tracer Kz from a gls scheme 15 !! zdf_gls_init : initialization, namelist read, and parameters control 16 !! gls_rst : read/write gls restart in ocean restart file 17 17 !!---------------------------------------------------------------------- 18 18 USE oce ! ocean dynamics and active tracers … … 31 31 USE iom ! I/O manager library 32 32 USE timing ! Timing 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 34 34 35 IMPLICIT NONE … … 167 168 ! 168 169 ! surface friction 169 ustars2(ji,jj) = r au0r* taum(ji,jj) * tmask(ji,jj,1)170 ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 170 171 ! 171 172 ! bottom friction (explicit before friction) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r3294 r3625 15 15 !! 'key_zdfkpp' KPP scheme 16 16 !!---------------------------------------------------------------------- 17 !! zdf_kpp : update momentum and tracer Kz from a kpp scheme18 !! zdf_kpp_init : initialization, namelist read, and parameters control19 !! tra_kpp : compute and add to the T & S trend the non-local flux20 !! trc_kpp : compute and add to the passive tracer trend the non-local flux (lk_top=T)17 !! zdf_kpp : update momentum and tracer Kz from a kpp scheme 18 !! zdf_kpp_init : initialization, namelist read, and parameters control 19 !! tra_kpp : compute and add to the T & S trend the non-local flux 20 !! trc_kpp : compute and add to the passive tracer trend the non-local flux (lk_top=T) 21 21 !!---------------------------------------------------------------------- 22 USE oce ! ocean dynamics and active tracers 23 USE dom_oce ! ocean space and time domain 24 USE zdf_oce ! ocean vertical physics 25 USE sbc_oce ! surface boundary condition: ocean 26 USE phycst ! physical constants 27 USE eosbn2 ! equation of state 28 USE zdfddm ! double diffusion mixing 29 USE in_out_manager ! I/O manager 30 USE lib_mpp ! MPP library 31 USE wrk_nemo ! work arrays 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE prtctl ! Print control 34 USE trdmod_oce ! ocean trends definition 35 USE trdtra ! tracers trends 36 USE timing ! Timing 22 USE oce ! ocean dynamics and active tracers 23 USE dom_oce ! ocean space and time domain 24 USE zdf_oce ! ocean vertical physics 25 USE sbc_oce ! surface boundary condition: ocean 26 USE phycst ! physical constants 27 USE eosbn2 ! equation of state 28 USE zdfddm ! double diffusion mixing 29 USE in_out_manager ! I/O manager 30 USE lib_mpp ! MPP library 31 USE wrk_nemo ! work arrays 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE prtctl ! Print control 34 USE trdmod_oce ! ocean trends definition 35 USE trdtra ! tracers trends 36 USE timing ! Timing 37 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 37 38 38 39 IMPLICIT NONE … … 426 427 zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) 427 428 ! Non radiative surface buoyancy force 428 zBo (ji,jj) = grav * zthermal * qns(ji,jj) - grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) ) 429 zBo (ji,jj) = grav * zthermal * qns(ji,jj) - grav * zhalin * ( emp(ji,jj)-rnf(ji,jj) ) & 430 & - grav * rbeta * rcs * sfx(ji,jj) 429 431 ! Surface Temperature flux for non-local term 430 wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r o0cpr* tmask(ji,jj,1)432 wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r1_rau0_rcp * tmask(ji,jj,1) 431 433 ! Surface salinity flux for non-local term 432 ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1) 434 ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) & 435 & + sfx(ji,jj) ) * rcs * tmask(ji,jj,1) 433 436 ENDDO 434 437 ENDDO … … 1324 1327 DO ji = fs_2, fs_jpim1 1325 1328 ! Surface tracer flux for non-local term 1326 zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)1329 zflx = - ( sfx (ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1) 1327 1330 ! compute the trend 1328 1331 ztra = - ( ghats(ji,jj,jk ) * fsavs(ji,jj,jk ) & -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r3294 r3625 17 17 !! 'key_zdfric' Kz = f(Ri) 18 18 !!---------------------------------------------------------------------- 19 !! zdf_ric : update momentum and tracer Kz from the Richardson19 !! zdf_ric : update momentum and tracer Kz from the Richardson 20 20 !! number computation 21 !! zdf_ric_init : initialization, namelist read, & parameters control 22 !!---------------------------------------------------------------------- 23 USE oce ! ocean dynamics and tracers variables 24 USE dom_oce ! ocean space and time domain variables 25 USE zdf_oce ! ocean vertical physics 26 USE in_out_manager ! I/O manager 27 USE lbclnk ! ocean lateral boundary condition (or mpp link) 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays 30 USE timing ! Timing 21 !! zdf_ric_init : initialization, namelist read, & parameters control 22 !!---------------------------------------------------------------------- 23 USE oce ! ocean dynamics and tracers variables 24 USE dom_oce ! ocean space and time domain variables 25 USE zdf_oce ! ocean vertical physics 26 USE in_out_manager ! I/O manager 27 USE lbclnk ! ocean lateral boundary condition (or mpp link) 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays 30 USE timing ! Timing 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 32 32 33 USE eosbn2, ONLY : nn_eos -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r3294 r3625 31 31 !! 'key_zdftke' TKE vertical physics 32 32 !!---------------------------------------------------------------------- 33 !! zdf_tke : update momentum and tracer Kz from a tke scheme34 !! tke_tke : tke time stepping: update tke at now time step (en)35 !! tke_avn : compute mixing length scale and deduce avm and avt36 !! zdf_tke_init : initialization, namelist read, and parameters control37 !! tke_rst : read/write tke restart in ocean restart file33 !! zdf_tke : update momentum and tracer Kz from a tke scheme 34 !! tke_tke : tke time stepping: update tke at now time step (en) 35 !! tke_avn : compute mixing length scale and deduce avm and avt 36 !! zdf_tke_init : initialization, namelist read, and parameters control 37 !! tke_rst : read/write tke restart in ocean restart file 38 38 !!---------------------------------------------------------------------- 39 39 USE oce ! ocean: dynamics and active tracers variables … … 52 52 USE wrk_nemo ! work arrays 53 53 USE timing ! Timing 54 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 54 55 55 56 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r3294 r3625 12 12 !! 'key_zdftmx' Tidal vertical mixing 13 13 !!---------------------------------------------------------------------- 14 !! zdf_tmx : global momentum & tracer Kz with tidal induced Kz 15 !! tmx_itf : Indonesian momentum & tracer Kz with tidal induced Kz 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers variables 18 USE dom_oce ! ocean space and time domain variables 19 USE zdf_oce ! ocean vertical physics variables 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 USE eosbn2 ! ocean equation of state 22 USE phycst ! physical constants 23 USE prtctl ! Print control 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O Manager 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays 28 USE timing ! Timing 14 !! zdf_tmx : global momentum & tracer Kz with tidal induced Kz 15 !! tmx_itf : Indonesian momentum & tracer Kz with tidal induced Kz 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers variables 18 USE dom_oce ! ocean space and time domain variables 19 USE zdf_oce ! ocean vertical physics variables 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 USE eosbn2 ! ocean equation of state 22 USE phycst ! physical constants 23 USE prtctl ! Print control 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O Manager 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays 28 USE timing ! Timing 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 29 30 30 31 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3610 r3625 46 46 USE mppini ! shared/distributed memory setting (mpp_init routine) 47 47 USE domain ! domain initialization (dom_init routine) 48 #if defined key_nemocice_decomp 49 USE ice_domain_size, only: nx_global, ny_global 50 #endif 48 51 USE obcini ! open boundary cond. initialization (obc_ini routine) 49 52 USE bdyini ! open boundary cond. initialization (bdy_init routine) … … 259 262 ! than variables 260 263 IF( Agrif_Root() ) THEN 264 #if defined key_nemocice_decomp 265 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 266 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 267 #else 261 268 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 262 #if defined key_nemocice_decomp263 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.264 #else265 269 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 266 270 #endif … … 322 326 IF( lk_bdy ) CALL tide_init ! Open boundaries initialisation of tidal harmonic forcing 323 327 324 CALL flush(numout)325 328 CALL dyn_nept_init ! simplified form of Neptune effect 326 CALL flush(numout)327 329 328 330 CALL istate_init ! ocean initial state (Dynamics and tracers) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/oce.F90
r3294 r3625 47 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gru , grv !: horizontal gradient of rd at bottom u-point 48 48 49 !! arrays relating to embedding ice in the ocean. These arrays need to be declared 50 !! even if no ice model is required. In the no ice model or traditional levitating 51 !! ice cases they contain only zeros 52 !! --------------------- 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass !: mass of snow and ice at current ice time step [Kg/m2] 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2] 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s] 56 49 57 !!---------------------------------------------------------------------- 50 58 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 58 66 !! *** FUNCTION oce_alloc *** 59 67 !!---------------------------------------------------------------------- 60 INTEGER :: ierr( 2)68 INTEGER :: ierr(3) 61 69 !!---------------------------------------------------------------------- 62 70 ! … … 69 77 & rn2b (jpi,jpj,jpk) , rn2 (jpi,jpj,jpk) , STAT=ierr(1) ) 70 78 ! 71 ALLOCATE(rhd (jpi,jpj,jpk) , & 72 & rhop(jpi,jpj,jpk) , & 73 & sshb (jpi,jpj) , sshn (jpi,jpj) , ssha (jpi,jpj) , & 74 & sshu_b(jpi,jpj) , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) , & 75 & sshv_b(jpi,jpj) , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) , & 76 & sshf_n(jpi,jpj) , & 77 & spgu (jpi,jpj) , spgv(jpi,jpj) , & 78 & gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts), & 79 & gru(jpi,jpj) , grv(jpi,jpj) , STAT=ierr(2) ) 79 ALLOCATE( rhd (jpi,jpj,jpk) , & 80 & rhop(jpi,jpj,jpk) , & 81 & sshb (jpi,jpj) , sshn (jpi,jpj) , ssha (jpi,jpj) , & 82 & sshu_b(jpi,jpj) , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) , & 83 & sshv_b(jpi,jpj) , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) , & 84 & sshf_n(jpi,jpj) , & 85 & spgu (jpi,jpj) , spgv(jpi,jpj) , & 86 & gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts), & 87 & gru(jpi,jpj) , grv(jpi,jpj) , STAT=ierr(2) ) 88 ! 89 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 90 & snwice_fmass(jpi,jpj), STAT= ierr(3) ) 80 91 ! 81 92 oce_alloc = MAXVAL( ierr ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90
r3295 r3625 4 4 !! TOP : PISCES Compute remineralization/scavenging of organic compounds 5 5 !!====================================================================== 6 !! History : 7 !! 8 !! 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_pisces … … 17 17 !! p4z_rem_alloc : Allocate remineralisation variables 18 18 !!---------------------------------------------------------------------- 19 USE oce_trc ! shared variables between ocean and passive tracers 20 USE trc ! passive tracers common variables 21 USE sms_pisces ! PISCES Source Minus Sink variables 22 USE p4zopt ! optical model 23 USE p4zche ! chemical model 24 USE p4zprod ! Growth rate of the 2 phyto groups 25 USE p4zmeso ! Sources and sinks of mesozooplankton 26 USE p4zint ! interpolation and computation of various fields 27 USE prtctl_trc ! print control for debugging 19 USE oce_trc ! shared variables between ocean and passive tracers 20 USE trc ! passive tracers common variables 21 USE sms_pisces ! PISCES Source Minus Sink variables 22 USE p4zopt ! optical model 23 USE p4zche ! chemical model 24 USE p4zprod ! Growth rate of the 2 phyto groups 25 USE p4zmeso ! Sources and sinks of mesozooplankton 26 USE p4zint ! interpolation and computation of various fields 27 USE prtctl_trc ! print control for debugging 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 29 29 30 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r3295 r3625 19 19 USE prtctl_trc ! print control for debugging 20 20 USE iom ! I/O manager 21 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 21 22 22 23 IMPLICIT NONE -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90
r2761 r3625 1 1 MODULE sedchem 2 2 ! 3 3 #if defined key_sed 4 4 !!====================================================================== … … 6 6 !! sediment : Variable for chemistry of the CO2 cycle 7 7 !!====================================================================== 8 !! modules used 9 USE sed ! sediment global variable 8 USE sed ! sediment global variable 10 9 USE sedarr 11 12 !! * Accessibility 10 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 11 13 12 PUBLIC sed_chem 14 13 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r3294 r3625 63 63 REAL(wp) :: zsrau, zse3t ! temporary scalars 64 64 CHARACTER (len=22) :: charout 65 REAL(wp), POINTER, DIMENSION(:,: ) :: z emps65 REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx 66 66 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 67 67 !!--------------------------------------------------------------------- … … 70 70 ! 71 71 ! Allocate temporary workspace 72 CALL wrk_alloc( jpi, jpj, z emps)72 CALL wrk_alloc( jpi, jpj, zsfx ) 73 73 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 74 74 … … 80 80 81 81 82 IF( lk_offline ) THEN ! emps in dynamical files contains emps- rnf83 z emps(:,:) = emps(:,:)82 IF( lk_offline ) THEN ! sfx in dynamical files contains sfx - rnf 83 zsfx(:,:) = sfx(:,:) 84 84 ELSE ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff 85 85 IF( lk_vvl ) THEN ! volume variable 86 z emps(:,:) = emps(:,:) - emp(:,:)87 !!ch z emps(:,:) = 0.86 zsfx(:,:) = sfx(:,:) - emp(:,:) 87 !!ch zsfx(:,:) = 0. 88 88 ELSE ! linear free surface 89 IF( ln_rnf ) THEN ; z emps(:,:) = emps(:,:) - rnf(:,:) ! E-P-R90 ELSE ; z emps(:,:) = emps(:,:)89 IF( ln_rnf ) THEN ; zsfx(:,:) = sfx(:,:) - rnf(:,:) ! E-P-R 90 ELSE ; zsfx(:,:) = sfx(:,:) 91 91 ENDIF 92 92 ENDIF … … 102 102 DO ji = fs_2, fs_jpim1 ! vector opt. 103 103 zse3t = 1. / fse3t(ji,jj,1) 104 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + z emps(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t104 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t 105 105 END DO 106 106 END DO … … 117 117 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 118 118 ENDIF 119 CALL wrk_dealloc( jpi, jpj, z emps)119 CALL wrk_dealloc( jpi, jpj, zsfx ) 120 120 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 121 121 ! -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r3294 r3625 227 227 USE sbc_oce , ONLY : emp => emp !: freshwater budget: volume flux [Kg/m2/s] 228 228 USE sbc_oce , ONLY : emp_b => emp_b !: freshwater budget: volume flux [Kg/m2/s] 229 USE sbc_oce , ONLY : emps => emps !: freshwater budget: concentration/dillution [Kg/m2/s]229 USE sbc_oce , ONLY : sfx => sfx !: downward salt flux [PSU/m2/s] 230 230 USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s] 231 231 USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/trc.F90
r3294 r3625 133 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i_tm !: average ice fraction [m/s] 134 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tm !: freshwater budget: volume flux [Kg/m2/s] 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emps_tm !: freshwater budget:concentration/dilution [Kg/m2/s]135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_tm !: downward salt flux [PSU/m2/s] 136 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_b_hold !: hold emp from the beginning of each sub-stepping[m] 137 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tm !: solar radiation average [m] … … 173 173 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb_temp, rotb_temp 174 174 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_temp, qsr_temp, fr_i_temp,wndm_temp 175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_temp, emps_temp, emp_b_temp175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_temp, sfx_temp, emp_b_temp 176 176 ! 177 177 #if defined key_trabbl -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r3294 r3625 121 121 fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:) 122 122 emp_tm (:,:) = emp_tm (:,:) + emp (:,:) 123 emps_tm (:,:) = emps_tm (:,:) + emps(:,:)123 sfx_tm (:,:) = sfx_tm (:,:) + sfx (:,:) 124 124 qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:) 125 125 wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:) … … 209 209 emp_temp (:,:) = emp (:,:) 210 210 emp_b_temp (:,:) = emp_b (:,:) 211 emps_temp (:,:) = emps(:,:)211 sfx_temp (:,:) = sfx (:,:) 212 212 qsr_temp (:,:) = qsr (:,:) 213 213 wndm_temp (:,:) = wndm (:,:) … … 313 313 fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:) 314 314 emp_tm (:,:) = emp_tm (:,:) + emp (:,:) 315 emps_tm (:,:) = emps_tm (:,:) + emps(:,:)315 sfx_tm (:,:) = sfx_tm (:,:) + sfx (:,:) 316 316 qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:) 317 317 wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:) … … 332 332 qsr (:,:) = qsr_tm (:,:) * r1_ndttrc 333 333 emp (:,:) = emp_tm (:,:) * r1_ndttrc 334 emps (:,:) = emps_tm(:,:) * r1_ndttrc334 sfx (:,:) = sfx_tm (:,:) * r1_ndttrc 335 335 fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrc 336 336 # if defined key_trabbl … … 348 348 qsr (:,:) = qsr_tm (:,:) * r1_ndttrcp1 349 349 emp (:,:) = emp_tm (:,:) * r1_ndttrcp1 350 emps (:,:) = emps_tm(:,:) * r1_ndttrcp1350 sfx (:,:) = sfx_tm (:,:) * r1_ndttrcp1 351 351 fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrcp1 352 352 # if defined key_trabbl … … 498 498 CALL lbc_lnk( emp (:,:) , 'T', 1. ) 499 499 CALL lbc_lnk( emp_b (:,:) , 'T', 1. ) 500 CALL lbc_lnk( emps(:,:) , 'T', 1. )500 CALL lbc_lnk( sfx (:,:) , 'T', 1. ) 501 501 CALL lbc_lnk( qsr (:,:) , 'T', 1. ) 502 502 CALL lbc_lnk( wndm (:,:) , 'T', 1. ) … … 598 598 fr_i_tm(:,:) = 0._wp 599 599 emp_tm (:,:) = 0._wp 600 emps_tm(:,:)= 0._wp600 sfx_tm(:,:) = 0._wp 601 601 qsr_tm (:,:) = 0._wp 602 602 wndm_tm(:,:) = 0._wp … … 705 705 fr_i (:,:) = fr_i_temp (:,:) 706 706 emp (:,:) = emp_temp (:,:) 707 emps (:,:) = emps_temp(:,:)707 sfx (:,:) = sfx_temp (:,:) 708 708 emp_b (:,:) = emp_b_temp (:,:) 709 709 qsr (:,:) = qsr_temp (:,:) … … 824 824 fr_i_tm (:,:) = fr_i (:,:) 825 825 emp_tm (:,:) = emp (:,:) 826 emps_tm (:,:) = emps(:,:)826 sfx_tm (:,:) = sfx (:,:) 827 827 qsr_tm (:,:) = qsr (:,:) 828 828 wndm_tm (:,:) = wndm (:,:) … … 1053 1053 & rnf_temp(jpi,jpj) , h_rnf_temp(jpi,jpj) , & 1054 1054 & tsn_temp(jpi,jpj,jpk,2) , emp_b_temp(jpi,jpj), & 1055 & emp_temp(jpi,jpj) , emps_temp(jpi,jpj), &1055 & emp_temp(jpi,jpj) , sfx_temp(jpi,jpj) , & 1056 1056 & hmld_temp(jpi,jpj) , qsr_temp(jpi,jpj) , & 1057 1057 & fr_i_temp(jpi,jpj) , fr_i_tm(jpi,jpj) , & … … 1101 1101 & sshv_n_tm(jpi,jpj) , sshv_b_hold(jpi,jpj), & 1102 1102 & tsn_tm(jpi,jpj,jpk,2) , & 1103 & emp_tm(jpi,jpj) , emps_tm(jpi,jpj), &1103 & emp_tm(jpi,jpj) , sfx_tm(jpi,jpj) , & 1104 1104 & emp_b_hold(jpi,jpj) , & 1105 1105 & hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , &
Note: See TracChangeset
for help on using the changeset viewer.