Changeset 921 for trunk/NEMO/OPA_SRC
- Timestamp:
- 2008-05-13T10:28:52+02:00 (16 years ago)
- Location:
- trunk/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
sbcblk_clio.F90 (modified) (1 diff)
-
sbcice_lim.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r914 r921 58 58 LOGICAL :: lbulk_init = .TRUE. ! flag, bulk initialization done or not) 59 59 60 #if ! defined key_lim3 61 ! in namicerun with LIM3 60 62 REAL(wp) :: cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM 61 63 REAL(wp) :: cao = 1.00e-3 ! chosen by default ==> should depends on many things... !!gmto be updated 64 #endif 62 65 63 66 REAL(wp) :: yearday !: number of days per year -
trunk/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r918 r921 2 2 !!====================================================================== 3 3 !! *** MODULE sbcice_lim *** 4 !! Surface module : update surface oceanboundary condition over ice5 !! 4 !! Surface module : update the ocean surface boundary condition over ice 5 !! & covered area using LIM sea-ice model 6 6 !! Sea-Ice model : LIM 3.0 Sea ice model time-stepping 7 7 !!====================================================================== 8 !! History : 9.0 ! 06-12 (M. Vancoppenolle) Original code 9 !! 9.0 ! 06-06 (G. Madec) Surface module from icestp.F90 8 !! History : 2.0 ! 2006-12 (M. Vancoppenolle) Original code 9 !! 3.0 ! 2008-02 (C. Talandier) Surface module from icestp.F90 10 !! 9.0 ! 2008-04 (G. Madec) sltyle and lim_ctl routine 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_lim3 … … 13 14 !! 'key_lim3' : LIM 3.0 sea-ice model 14 15 !!---------------------------------------------------------------------- 15 !! ----------------------------------------------------------------------16 !! sbc_ice_lim : sea-ice model time-stepping and17 !! update ocean sbc over ice-covered area16 !! sbc_ice_lim : sea-ice model time-stepping and update ocean sbc over ice-covered area 17 !! lim_ctl : alerts in case of ice model crash 18 !! lim_prt_state : ice control print at a given grid point 18 19 !!---------------------------------------------------------------------- 19 20 USE oce ! ocean dynamics and tracers … … 52 53 USE in_out_manager ! I/O manager 53 54 USE prtctl ! Print control 54 USE ocfzpt ! ocean freezing point55 55 56 56 IMPLICIT NONE … … 61 61 CHARACTER(len=1) :: cl_grid = 'C' ! type of grid used in ice dynamics 62 62 63 INTEGER :: nn_ico_cpl = 0 ! ice-ocean coupling indicator: !!gm ===>> to be put in namelist 64 ! ! = 0 LIM-3 old case 65 ! ! = 1 stresses computed using now ocean velocity 66 ! ! = 2 combination of 0 and 1 cases 67 68 63 69 !! * Substitutions 64 70 # include "domzgr_substitute.h90" 65 71 # include "vectopt_loop_substitute.h90" 66 72 !!---------------------------------------------------------------------- 67 !! OPA 9.0 , LOCEAN-IPSL (2006)68 !! $ 73 !! NEMO/LIM 3.0 , UCL-LOCEAN-IPSL (2008) 74 !! $Id: $ 69 75 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 70 76 !!---------------------------------------------------------------------- … … 94 100 INTEGER, INTENT(in) :: kt ! ocean time step 95 101 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE) 96 INTEGER, INTENT(in) :: kico ! type of ice-ocean stress102 INTEGER, INTENT(in) :: kico ! ice-ocean stress treatment 97 103 !! 98 INTEGER :: ji, jj, jk, jl ! dummy loop indices 99 INTEGER :: indx ! indexes for ice points 100 INTEGER :: numaltests ! number of alert tests (max 20) 101 INTEGER :: alert_id ! number of the current alert 102 REAL(wp) :: ztmelts ! ice layer melting point 103 REAL(wp) :: zinda 104 INTEGER , DIMENSION(20) :: numal ! number of alerts positive 105 CHARACTER (len=30), DIMENSION(20) :: alname ! name of alert 104 REAL(wp) :: zcoef ! temporary scalar 106 105 REAL(wp), DIMENSION(jpi,jpj,jpl) :: alb_ice_os ! albedo of the ice under overcast sky 107 106 REAL(wp), DIMENSION(jpi,jpj,jpl) :: alb_ice_cs ! albedo of ice under clear sky … … 111 110 IF(lwp) WRITE(numout,*) 112 111 IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 113 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM ) time stepping'114 112 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 113 ! 115 114 CALL ice_init 116 117 !+++++ 118 indx = 12 119 jiindx = 44 120 jjindx = 140 121 WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, & 122 ' jjindx : ',jjindx 123 !+++++ 124 115 ! 116 IF( ln_nicep ) THEN ! control print at a given point 117 jiindx = 44 ; jjindx = 140 118 WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 119 ENDIF 125 120 ENDIF 126 121 127 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 128 ! 129 ! ... mean surface ocean current at ice dynamics point 130 ! C-grid dynamics : U- & V-points as the ocean 131 u_oce(:,:) = ssu_m(:,:) * tmu(:,:) 132 v_oce(:,:) = ssv_m(:,:) * tmv(:,:) 133 ! 134 CALL lbc_lnk( u_oce, 'U', -1. ) ! U-point 135 CALL lbc_lnk( v_oce, 'V', -1. ) ! V-point 136 137 ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 138 t_bo(:,:) = tfreez( sss_m ) + rt0 139 140 141 ! ... ice albedo 142 CALL albedo_ice( t_su, ht_i, ht_s, alb_ice_cs, alb_ice_os ) 143 144 ! ... Sea-ice surface boundary conditions output from bulk formulae : 145 ! - utaui_ice ! surface ice stress i-component (I-point) [N/m2] 146 ! - vtaui_ice ! surface ice stress j-component (I-point) [N/m2] 147 ! - qns_ice ! non solar heat flux over ice (T-point) [W/m2] 148 ! - qsr_ice ! solar heat flux over ice (T-point) [W/m2] 149 ! - qla_ice ! latent heat flux over ice (T-point) [W/m2] 150 ! - dqns_ice ! non solar heat sensistivity (T-point) [W/m2] 151 ! - dqla_ice ! latent heat sensistivity (T-point) [W/m2] 152 ! - tprecip ! total precipitation (T-point) [Kg/m2/s] 153 ! - sprecip ! solid precipitation (T-point) [Kg/m2/s] 154 ! - fr1_i0 ! 1sr fraction of qsr penetration in ice [%] 155 ! - fr2_i0 ! 2nd fraction of qsr penetration in ice [%] 122 ! !----------------------! 123 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only ! 124 ! !----------------------! 125 ! ! Bulk Formulea ! 126 ! !----------------! 127 ! 128 u_oce(:,:) = ssu_m(:,:) ! mean surface ocean current at ice velocity point 129 v_oce(:,:) = ssv_m(:,:) ! (C-grid dynamics : U- & V-points as the ocean) 130 ! 131 t_bo(:,:) = tfreez( sss_m ) + rt0 ! masked sea surface freezing temperature [Kelvin] 132 ! ! (set to rt0 over land) 133 CALL albedo_ice( t_su, ht_i, ht_s, alb_ice_cs, alb_ice_os ) ! ... ice albedo 134 135 ! Bulk formulea - provides the following fields: 136 ! utaui_ice, vtaui_ice : surface ice stress (U- & V-points) [N/m2] 137 ! qsr_ice , qns_ice : solar & non solar heat flux over ice (T-point) [W/m2] 138 ! qla_ice : latent heat flux over ice (T-point) [W/m2] 139 ! dqns_ice , dqla_ice : non solar & latent heat sensistivity (T-point) [W/m2] 140 ! tprecip , sprecip : total & solid precipitation (T-point) [Kg/m2/s] 141 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 156 142 ! 157 143 SELECT CASE( kblk ) 158 CASE( 3 ) ! CLIO bulk formulation 159 CALL blk_ice_clio( t_su , u_ice , v_ice , alb_ice_cs, alb_ice_os, & 160 & utaui_ice, vtaui_ice , qns_ice , qsr_ice, & 161 & qla_ice , dqns_ice , dqla_ice , & 162 & tprecip , sprecip , & 163 & fr1_i0 , fr2_i0 , cl_grid ) 164 165 ! CAUTION: ocean shortwave radiation sets to zero if more than 50% of sea-ice !!gm to be removed 166 DO jj = 1, jpj 167 DO ji = 1, jpi 168 zinda = MAX( 0.e0, SIGN( 1.e0, -( -1.5 - freeze(ji,jj) ) ) ) 169 qsr(ji,jj) = zinda * qsr(ji,jj) 170 END DO 171 END DO 172 173 CASE( 4 ) ! CORE bulk formulation 174 CALL blk_ice_core( t_su , u_ice , v_ice , alb_ice_cs, & 175 & utaui_ice, vtaui_ice , qns_ice , qsr_ice, & 176 & qla_ice , dqns_ice , dqla_ice, & 177 & tprecip , sprecip , & 178 & fr1_i0 , fr2_i0 , cl_grid ) 144 CASE( 3 ) ! CLIO bulk formulation 145 CALL blk_ice_clio( t_su , u_ice , v_ice , alb_ice_cs, alb_ice_os, & 146 & utaui_ice, vtaui_ice , qns_ice , qsr_ice , & 147 & qla_ice , dqns_ice , dqla_ice , & 148 & tprecip , sprecip , & 149 & fr1_i0 , fr2_i0 , cl_grid ) 150 ! 151 CASE( 4 ) ! CORE bulk formulation 152 CALL blk_ice_core( t_su , u_ice , v_ice , alb_ice_cs, & 153 & utaui_ice, vtaui_ice , qns_ice , qsr_ice , & 154 & qla_ice , dqns_ice , dqla_ice , & 155 & tprecip , sprecip , & 156 & fr1_i0 , fr2_i0 , cl_grid ) 179 157 END SELECT 180 158 181 IF(ln_ctl) THEN ! print mean trends (used for debugging) 182 CALL prt_ctl_info( 'Ice Forcings ' ) 183 CALL prt_ctl( tab2d_1=tprecip ,clinfo1=' sbc_ice_lim: precip : ' ) 184 CALL prt_ctl( tab2d_1=utaui_ice,clinfo1=' sbc_ice_lim: utaui_ice: ', tab2d_2=vtaui_ice, clinfo2=' vtaui_ice: ' ) 185 CALL prt_ctl( tab2d_1=sst_m ,clinfo1=' sbc_ice_lim: sst : ', tab2d_2=sss_m , clinfo2=' sss : ' ) 186 CALL prt_ctl( tab2d_1=u_oce ,clinfo1=' sbc_ice_lim: u_io : ', tab2d_2=v_oce , clinfo2=' v_io : ' ) 187 CALL prt_ctl( tab2d_1=frld ,clinfo1=' sbc_ice_lim: frld 1 : ' ) 188 ! 189 DO jl = 1, jpl 190 CALL prt_ctl_info('* - category number ', ivar1=jl) 191 CALL prt_ctl(tab3d_1=t_su , clinfo1=' sbc_ice_lim: t_su : ', kdim=jl) 192 CALL prt_ctl(tab3d_1=qsr_ice , clinfo1=' sbc_ice_lim: qsr_ice : ', kdim=jl) 193 CALL prt_ctl(tab3d_1=qns_ice , clinfo1=' sbc_ice_lim: qns_ice : ', kdim=jl) 194 CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' sbc_ice_lim: dqns_ice : ', kdim=jl) 195 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' sbc_ice_lim: qla_ice : ', kdim=jl) 196 CALL prt_ctl(tab3d_1=dqla_ice, clinfo1=' sbc_ice_lim: dqla_ice : ', kdim=jl) 197 END DO 198 ! 199 ENDIF 200 201 !------------------------------------------------ 202 ! Store old values of ice model global variables 203 !------------------------------------------------ 204 159 ! !----------------------! 160 ! ! LIM-3 time-stepping ! 161 ! !----------------------! 162 ! 163 numit = numit + nn_fsbc ! Ice model time step 164 ! 165 ! ! Store previous ice values 166 !!gm : remark old_... should becomes ...b as tn versus tb 205 167 old_a_i(:,:,:) = a_i(:,:,:) ! ice area 206 168 old_e_i(:,:,:,:) = e_i(:,:,:,:) ! ice thermal energy … … 211 173 old_oa_i(:,:,:) = oa_i(:,:,:) ! areal age content 212 174 175 ! ! intialisation to zero !!gm is it truly necessary ??? 213 176 d_a_i_thd(:,:,:) = 0.e0 ; d_a_i_trp(:,:,:) = 0.e0 214 177 d_v_i_thd(:,:,:) = 0.e0 ; d_v_i_trp(:,:,:) = 0.e0 … … 218 181 d_smv_i_thd(:,:,:) = 0.e0 ; d_smv_i_trp(:,:,:) = 0.e0 219 182 d_oa_i_thd(:,:,:) = 0.e0 ; d_oa_i_trp(:,:,:) = 0.e0 220 183 ! 221 184 fseqv(:,:) = 0.e0 222 185 fsbri(:,:) = 0.e0 ; fsalt_res(:,:) = 0.e0 … … 226 189 fheat_rpo(:,:) = 0.e0 ; focea2D(:,:) = 0.e0 227 190 fsup2D(:,:) = 0.e0 228 191 ! 229 192 diag_sni_gr(:,:) = 0.e0 ; diag_lat_gr(:,:) = 0.e0 230 193 diag_bot_gr(:,:) = 0.e0 ; diag_dyn_gr(:,:) = 0.e0 231 194 diag_bot_me(:,:) = 0.e0 ; diag_sur_me(:,:) = 0.e0 232 233 195 ! dynamical invariants 234 delta_i(:,:) = 0.e0 235 divu_i(:,:) = 0.e0 236 shear_i(:,:) = 0.e0 237 238 !----------------! 239 ! Ice model step ! 240 !----------------! 241 numit = numit + nn_fsbc 242 CALL lim_rst_opn( kt ) ! Open Ice restart file 243 !+++++ 244 WRITE(numout,*) ' - Beginning the time step - ' 245 CALL lim_inst_state(jiindx,jjindx,1) 246 WRITE(numout,*) ' ' 247 !+++++ 248 !---------------------| 249 ! Dynamical processes | 250 !---------------------| 251 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (not in 1D case) 252 CALL lim_dyn ! Ice dynamics ( rheology/dynamics ) 253 CALL lim_trp ! Ice transport ( Advection/diffusion ) 254 CALL lim_var_agg(1) ! aggregate categories, requested 255 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 256 !+++++ 257 WRITE(numout,*) ' - After ice dynamics and transport ' 258 CALL lim_inst_state( jiindx, jjindx, 1 ) 259 WRITE(numout,*) 260 WRITE(numout,*) ' Mechanical Check ************** ' 261 WRITE(numout,*) ' Check what means ice divergence ' 262 WRITE(numout,*) ' Total ice concentration ', at_i (jiindx,jjindx) 263 WRITE(numout,*) ' Total lead fraction ', ato_i(jiindx,jjindx) 264 WRITE(numout,*) ' Sum of both ', ato_i(jiindx,jjindx) + at_i(jiindx,jjindx) 265 WRITE(numout,*) ' Sum of both minus 1 ', ato_i(jiindx,jjindx) + at_i(jiindx,jjindx) - 1.00 266 !+++++ 267 CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 196 delta_i(:,:) = 0.e0 ; divu_i (:,:) = 0.e0 ; shear_i(:,:) = 0.e0 197 198 CALL lim_rst_opn( kt ) ! Open Ice restart file 199 ! 200 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print 201 ! 202 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (not in 1D case) 203 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 204 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 205 CALL lim_var_agg(1) ! aggregate categories, requested 206 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 207 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' ) ! control print 208 CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 268 209 ENDIF 269 !--------------------| 270 ! Ice thermodynamics | 271 !--------------------| 272 CALL lim_var_glo2eqv ! equivalent variables 273 CALL lim_var_agg(1) ! aggregate ice categories 274 CALL lim_var_bv ! bulk brine volume (diag) 275 CALL lim_thd ! Ice thermodynamics 276 oa_i(:,:,:) = oa_i(:,:,:) & 277 & + a_i(:,:,:) & 278 & * rdt_ice & 279 & / 86400.00 ! Ice natural aging 280 CALL lim_var_glo2eqv ! except info message that follows, 281 ! ! this CALL is maybe not necessary 282 !+++++ 283 WRITE(numout,*) ' - After ice thermodynamics ' 284 CALL lim_inst_state(jiindx,jjindx,1) 285 !+++++ 286 CALL lim_itd_th ! Remap ice categories, lateral accretion ! 287 !-------------------------| 288 ! Global variables update | 289 !-------------------------| 290 CALL lim_var_agg(1) ! requested by limupdate 291 CALL lim_update ! Global variables update 292 CALL lim_var_glo2eqv ! equivalent variables (outputs) 293 CALL lim_var_agg(2) ! aggregate ice thickness categories 294 !+++++ 295 IF(ln_nicep) THEN 296 WRITE(numout,*) ' - Final ice state after lim_update ' 297 CALL lim_inst_state(jiindx,jjindx,2) 298 WRITE(numout,*) ' ' 299 ENDIF 300 !+++++ 301 !--------------------------------------| 302 ! Fluxes of mass and heat to the ocean | 303 !--------------------------------------| 210 ! 211 ! ! Ice thermodynamics 212 CALL lim_var_glo2eqv ! equivalent variables 213 CALL lim_var_agg(1) ! aggregate ice categories 214 CALL lim_var_bv ! bulk brine volume (diag) 215 CALL lim_thd( kt ) ! Ice thermodynamics 216 zcoef = rdt_ice / 86400.e0 ! Ice natural aging 217 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 218 CALL lim_var_glo2eqv ! this CALL is maybe not necessary (Martin) 219 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print 220 CALL lim_itd_th( kt ) ! Remap ice categories, lateral accretion ! 221 ! 222 ! ! Global variables update | 223 CALL lim_var_agg( 1 ) ! requested by limupdate 224 CALL lim_update ! Global variables update 225 CALL lim_var_glo2eqv ! equivalent variables (outputs) 226 CALL lim_var_agg(2) ! aggregate ice thickness categories 227 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx, 2, ' - Final state - ' ) ! control print 228 ! 229 ! ! Fluxes of mass and heat to the ocean | 304 230 CALL lim_sbc_flx( kt ) ! Ice/Ocean heat freshwater/salt fluxes 305 231 IF( ln_limdyn .AND. kico == 0 ) & ! Ice/Ocean stresses (only in ice-dynamic case) 306 232 & CALL lim_sbc_tau( kt, kico ) ! otherwise the atm.-ocean stresses are used everywhere 307 308 !+++++ 309 WRITE(numout,*) ' - Final ice state after lim_flx ' 310 CALL lim_inst_state(jiindx,jjindx,3) 311 WRITE(numout,*) ' ' 312 !+++++ 313 !-------------------------| 314 ! Diagnostics and outputs | 315 !-------------------------| 316 IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) & 317 & CALL lim_dia ! Ice Diagnostics 318 CALL lim_wri ( 1 ) ! Ice outputs 319 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 320 CALL lim_var_glo2eqv 321 ! 322 !-------------------------------| 323 ! Alerts in case of model crash | 324 !-------------------------------| 325 326 numaltests = 10 327 numal(:) = 0 328 329 ! Alert if incompatible volume and concentration 330 alert_id = 2 ! reference number of this alert 331 alname(alert_id) = ' Incompat vol and con ' ! name of the alert 332 333 DO jl = 1, jpl 334 DO jj = 1, jpj 335 DO ji = 1, jpi 336 IF ((v_i(ji,jj,jl).NE.0.0).AND.(a_i(ji,jj,jl).EQ.0.0)) THEN 337 WRITE(numout,*) ' ALERTE 2 ' 338 WRITE(numout,*) ' Incompatible volume and concentration ' 339 WRITE(numout,*) ' at_i ', at_i(ji,jj) 340 WRITE(numout,*) ' Point - category', ji, jj, jl 341 WRITE(numout,*) 342 WRITE(numout,*) ' a_i *** a_i_old ', a_i(ji,jj,jl), old_a_i(ji,jj,jl) 343 WRITE(numout,*) ' v_i *** v_i_old ', v_i(ji,jj,jl), old_v_i(ji,jj,jl) 344 WRITE(numout,*) ' d_a_i_thd/trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 345 WRITE(numout,*) ' d_v_i_thd/trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 346 numal(alert_id) = numal(alert_id) + 1 347 ENDIF 348 END DO 349 END DO 350 END DO 351 352 ! Alerte if very thick ice 353 alert_id = 3 ! reference number of this alert 354 alname(alert_id) = ' Very thick ice ' ! name of the alert 355 jl = jpl 233 ! 234 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx, 3, ' - Final state lim_sbc - ' ) ! control print 235 ! 236 ! ! Diagnostics and outputs 237 ! ! Ice Diagnostics 238 IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) CALL lim_dia 239 CALL lim_wri( 1 ) ! Ice outputs 240 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 241 CALL lim_var_glo2eqv ! ??? 242 ! 243 IF( ln_nicep ) CALL lim_ctl ! alerts in case of model crash 244 ! 245 ENDIF ! End sea-ice time step only 246 247 ! !--------------------------! 248 ! Ice/Ocean stresses (nn_ico_cpl=1 or 2 cases) ! at all ocean time step ! 249 ! !--------------------------! 250 IF( ln_limdyn .AND. nn_ico_cpl /= 0 ) & 251 & CALL lim_sbc_tau( kt, nn_ico_cpl ) 252 !!gm remark, in this case the ocean-ice stress is not saved in diag call above ..... find a solution!!! 253 ! 254 END SUBROUTINE sbc_ice_lim 255 256 257 SUBROUTINE lim_ctl 258 !!----------------------------------------------------------------------- 259 !! *** ROUTINE lim_ctl *** 260 !! 261 !! ** Purpose : Alerts in case of model crash 262 !!------------------------------------------------------------------- 263 INTEGER :: ji, jj, jk, jl ! dummy loop indices 264 INTEGER :: inb_altests ! number of alert tests (max 20) 265 INTEGER :: ialert_id ! number of the current alert 266 REAL(wp) :: ztmelts ! ice layer melting point 267 CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert 268 INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive 269 !!------------------------------------------------------------------- 270 271 inb_altests = 10 272 inb_alp(:) = 0 273 274 ! Alert if incompatible volume and concentration 275 ialert_id = 2 ! reference number of this alert 276 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 277 278 DO jl = 1, jpl 356 279 DO jj = 1, jpj 357 280 DO ji = 1, jpi 358 IF (ht_i(ji,jj,jl) .GT. 50.0 ) THEN 359 WRITE(numout,*) ' ALERTE 3 ' 360 WRITE(numout,*) ' Very thick ice ' 361 CALL lim_inst_state(ji,jj,2) 362 WRITE(numout,*) ' ' 363 numal(alert_id) = numal(alert_id) + 1 281 IF( v_i(ji,jj,jl) /= 0.e0 .AND. a_i(ji,jj,jl) == 0.e0 ) THEN 282 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 283 WRITE(numout,*) ' at_i ', at_i(ji,jj) 284 WRITE(numout,*) ' Point - category', ji, jj, jl 285 WRITE(numout,*) ' a_i *** a_i_old ', a_i (ji,jj,jl), old_a_i (ji,jj,jl) 286 WRITE(numout,*) ' v_i *** v_i_old ', v_i (ji,jj,jl), old_v_i (ji,jj,jl) 287 WRITE(numout,*) ' d_a_i_thd/trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 288 WRITE(numout,*) ' d_v_i_thd/trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 289 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 364 290 ENDIF 365 291 END DO 366 292 END DO 367 368 ! Alert if very fast ice 369 alert_id = 4 ! reference number of this alert 370 alname(alert_id) = ' Very fast ice ' ! name of the alert 293 END DO 294 295 ! Alerte if very thick ice 296 ialert_id = 3 ! reference number of this alert 297 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 298 jl = jpl 299 DO jj = 1, jpj 300 DO ji = 1, jpi 301 IF( ht_i(ji,jj,jl) .GT. 50.0 ) THEN 302 CALL lim_prt_state( ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 303 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 304 ENDIF 305 END DO 306 END DO 307 308 ! Alert if very fast ice 309 ialert_id = 4 ! reference number of this alert 310 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 311 DO jj = 1, jpj 312 DO ji = 1, jpi 313 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) .GT. 0.5 .AND. & 314 & at_i(ji,jj) .GT. 0.e0 ) THEN 315 CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 316 WRITE(numout,*) ' ice strength : ', strength(ji,jj) 317 WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj) 318 WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj) 319 WRITE(numout,*) ' sea-ice stress utaui_ice : ', utaui_ice(ji,jj) 320 WRITE(numout,*) ' sea-ice stress vtaui_ice : ', vtaui_ice(ji,jj) 321 WRITE(numout,*) ' oceanic speed u : ', u_oce(ji,jj) 322 WRITE(numout,*) ' oceanic speed v : ', v_oce(ji,jj) 323 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 324 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 325 WRITE(numout,*) 326 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 327 ENDIF 328 END DO 329 END DO 330 331 ! Alert if there is ice on continents 332 ialert_id = 6 ! reference number of this alert 333 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 334 DO jj = 1, jpj 335 DO ji = 1, jpi 336 IF( tms(ji,jj) .LE. 0.0 .AND. at_i(ji,jj) .GT. 0.e0 ) THEN 337 CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 338 WRITE(numout,*) ' masks s, u, v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 339 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 340 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 341 WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj) 342 WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj) 343 WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1) 344 WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj) 345 WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj) 346 ! 347 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 348 ENDIF 349 END DO 350 END DO 351 352 ! 353 ! ! Alert if very fresh ice 354 ialert_id = 7 ! reference number of this alert 355 cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert 356 DO jl = 1, jpl 371 357 DO jj = 1, jpj 372 358 DO ji = 1, jpi 373 IF ( ( ( ABS( u_ice(ji,jj) ) .GT. 0.50) .OR. & 374 ( ABS( v_ice(ji,jj) ) .GT. 0.50) ) .AND. & 375 ( at_i(ji,jj) .GT. 0.0 ) ) THEN 376 WRITE(numout,*) ' ALERTE 4 ' 377 WRITE(numout,*) ' Very fast ice ' 378 CALL lim_inst_state(ji,jj,1) 379 WRITE(numout,*) ' ice strength : ', strength(ji,jj) 380 WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj) 381 WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj) 382 WRITE(numout,*) ' sea-ice stress utaui_ice : ', utaui_ice(ji,jj) 383 WRITE(numout,*) ' sea-ice stress vtaui_ice : ', vtaui_ice(ji,jj) 384 WRITE(numout,*) ' oceanic speed u : ', u_oce(ji,jj) 385 WRITE(numout,*) ' oceanic speed v : ', v_oce(ji,jj) 386 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 387 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 388 WRITE(numout,*) 389 numal(alert_id) = numal(alert_id) + 1 390 ENDIF 391 END DO 392 END DO 393 394 ! Alert if there is ice on continents 395 alert_id = 6 ! reference number of this alert 396 alname(alert_id) = ' Ice on continents ' ! name of the alert 397 DO jj = 1, jpj 398 DO ji = 1, jpi 399 IF ( ( tms(ji,jj) .LE. 0.0 ) .AND. ( at_i(ji,jj) .GT. 0.0 ) ) THEN 400 WRITE(numout,*) ' ALERTE 6 ' 401 WRITE(numout,*) ' Ice on continents ' 402 CALL lim_inst_state(ji,jj,1) 403 WRITE(numout,*) ' masks s, u, v : ', tms(ji,jj), & 404 tmu(ji,jj), & 405 tmv(ji,jj) 406 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 407 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 408 WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj) 409 WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj) 410 WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1) 411 WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj) 412 WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj) 413 414 numal(alert_id) = numal(alert_id) + 1 415 416 ENDIF 417 END DO 418 END DO 419 420 ! Alert if very fresh ice 421 alert_id = 7 ! reference number of this alert 422 alname(alert_id) = ' Very fresh ice ' ! name of the alert 423 DO jl = 1, jpl 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 IF ( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. & 427 ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. & 428 ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 429 ! WRITE(numout,*) ' ALERTE 7 ' 430 ! WRITE(numout,*) ' Very fresh ice ' 431 ! CALL lim_inst_state(ji,jj,1) 359 !!gm test twice sm_i ... ???? bug? 360 IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. & 361 ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. & 362 ( a_i(ji,jj,jl) .GT. 0.e0 ) ) THEN 363 ! CALL lim_prt_state(ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 432 364 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj) 433 365 ! WRITE(numout,*) ' sss : ', sss_m(ji,jj) 434 366 ! WRITE(numout,*) ' s_i_newice : ', s_i_newice(ji,jj,1:jpl) 435 367 ! WRITE(numout,*) 436 numal(alert_id) = numal(alert_id) + 1368 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 437 369 ENDIF 438 370 END DO 439 371 END DO 440 END DO 441 442 ! Alert if too old ice 443 alert_id = 9 ! reference number of this alert 444 alname(alert_id) = ' Very old ice ' ! name of the alert 445 DO jl = 1, jpl 372 END DO 373 ! 374 375 ! ! Alert if too old ice 376 ialert_id = 9 ! reference number of this alert 377 cl_alname(ialert_id) = ' Very old ice ' ! name of the alert 378 DO jl = 1, jpl 446 379 DO jj = 1, jpj 447 380 DO ji = 1, jpi 448 381 IF ( ( ( ABS( o_i(ji,jj,jl) ) .GT. rdt_ice ) .OR. & 449 382 ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. & 450 ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 451 WRITE(numout,*) ' ALERTE 9 ' 452 WRITE(numout,*) ' Wrong ice age ' 453 CALL lim_inst_state(ji,jj,1) 454 WRITE(numout,*) 455 numal(alert_id) = numal(alert_id) + 1 383 ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 384 CALL lim_prt_state( ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 385 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 456 386 ENDIF 457 387 END DO 458 388 END DO 459 460 END DO 461 462 ! Alert on salt flux 463 alert_id = 5 ! reference number of this alert 464 alname(alert_id) = ' High salt flux ' ! name of the alert 465 DO jj = 1, jpj 466 DO ji = 1, jpi 467 IF (ABS(emps(ji,jj)).gt.1.0e-2) THEN 468 WRITE(numout,*) ' ALERTE 5 ' 469 WRITE(numout,*) ' High salt flux ' 470 CALL lim_inst_state(ji,jj,3) 471 WRITE(numout,*) ' ' 389 END DO 390 391 ! Alert on salt flux 392 ialert_id = 5 ! reference number of this alert 393 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 394 DO jj = 1, jpj 395 DO ji = 1, jpi 396 IF( ABS( emps(ji,jj) ) .GT. 1.0e-2 ) THEN 397 CALL lim_prt_state( ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 472 398 DO jl = 1, jpl 473 399 WRITE(numout,*) ' Category no: ', jl 474 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , & 475 ' old_a_i : ', old_a_i(ji,jj,jl) 476 WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , & 477 ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl) 478 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , & 479 ' old_v_i : ', old_v_i(ji,jj,jl) 480 WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , & 481 ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl) 400 WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' old_a_i : ', old_a_i (ji,jj,jl) 401 WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl) 402 WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' old_v_i : ', old_v_i (ji,jj,jl) 403 WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl) 482 404 WRITE(numout,*) ' ' 483 END DO 484 numal(alert_id) = numal(alert_id) + 1 485 ENDIF 405 END DO 406 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 407 ENDIF 408 END DO 409 END DO 410 411 ! Alert if qns very big 412 ialert_id = 8 ! reference number of this alert 413 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 414 DO jj = 1, jpj 415 DO ji = 1, jpi 416 IF( ABS( qns(ji,jj) ) .GT. 1500.0 .AND. ( at_i(ji,jj) .GT. 0.0 ) ) THEN 417 ! 418 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 419 WRITE(numout,*) ' ji, jj : ', ji, jj 420 WRITE(numout,*) ' qns : ', qns(ji,jj) 421 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 422 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 423 WRITE(numout,*) ' qcmif : ', qcmif(ji,jj) 424 WRITE(numout,*) ' qldif : ', qldif(ji,jj) 425 WRITE(numout,*) ' qcmif : ', qcmif(ji,jj) / rdt_ice 426 WRITE(numout,*) ' qldif : ', qldif(ji,jj) / rdt_ice 427 WRITE(numout,*) ' qfvbq : ', qfvbq(ji,jj) 428 WRITE(numout,*) ' qdtcn : ', qdtcn(ji,jj) 429 WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice 430 WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice 431 WRITE(numout,*) ' fdtcn : ', fdtcn(ji,jj) 432 WRITE(numout,*) ' fhmec : ', fhmec(ji,jj) 433 WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(ji,jj) 434 WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 435 WRITE(numout,*) ' fhbri : ', fhbri(ji,jj) 436 ! 437 CALL lim_prt_state( ji, jj, 2, ' ') 438 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 439 ! 440 ENDIF 441 END DO 442 END DO 443 !+++++ 444 445 ! Alert if very warm ice 446 ialert_id = 10 ! reference number of this alert 447 cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 448 inb_alp(ialert_id) = 0 449 DO jl = 1, jpl 450 DO jk = 1, nlay_i 451 DO jj = 1, jpj 452 DO ji = 1, jpi 453 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt 454 IF( t_i(ji,jj,jk,jl) .GE. ztmelts .AND. v_i(ji,jj,jl) .GT. 1.e-6 & 455 & .AND. a_i(ji,jj,jl) .GT. 0.e0 ) THEN 456 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 457 WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 458 WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 459 WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 460 WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl) 461 WRITE(numout,*) ' ztmelts : ', ztmelts 462 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 463 ENDIF 464 END DO 486 465 END DO 487 466 END DO 488 489 ! Alert if qns very big 490 alert_id = 8 ! reference number of this alert 491 alname(alert_id) = ' qns very big ' ! name of the alert 492 DO jj = 1, jpj 493 DO ji = 1, jpi 494 IF ( ( ABS( qns(ji,jj) ) .GT. 1500.0 ) .AND. & 495 ( at_i(ji,jj) .GT. 0.0 ) ) THEN 496 497 WRITE(numout,*) ' ALERTE 8 ' 498 WRITE(numout,*) ' ji, jj : ', ji, jj 499 WRITE(numout,*) ' qns : ', qns(ji,jj) 500 WRITE(numout,*) ' Very high non-solar heat flux ' 501 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 502 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 503 WRITE(numout,*) ' qcmif : ', qcmif(jiindx,jjindx) 504 WRITE(numout,*) ' qldif : ', qldif(jiindx,jjindx) 505 WRITE(numout,*) ' qcmif : ', qcmif(jiindx,jjindx) / rdt_ice 506 WRITE(numout,*) ' qldif : ', qldif(jiindx,jjindx) / rdt_ice 507 WRITE(numout,*) ' qfvbq : ', qfvbq(jiindx,jjindx) 508 WRITE(numout,*) ' qdtcn : ', qdtcn(jiindx,jjindx) 509 WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) / rdt_ice 510 WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) / rdt_ice 511 WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx) 512 WRITE(numout,*) ' fhmec : ', fhmec(jiindx,jjindx) 513 WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(jiindx,jjindx) 514 WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 515 WRITE(numout,*) ' fhbri : ', fhbri(jiindx,jjindx) 516 517 CALL lim_inst_state(ji,jj,2) 518 numal(alert_id) = numal(alert_id) + 1 519 520 ENDIF 521 END DO 522 END DO 523 !+++++ 467 END DO 468 469 ialert_id = 1 ! reference number of this alert 470 cl_alname(ialert_id) = ' NO alerte 1 ' ! name of the alert 471 WRITE(numout,*) 472 WRITE(numout,*) ' All alerts at the end of ice model ' 473 DO ialert_id = 1, inb_altests 474 WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 475 END DO 476 ! 477 END SUBROUTINE lim_ctl 524 478 525 ! Alert if very warm ice 526 alert_id = 10 ! reference number of this alert 527 alname(alert_id) = ' Very warm ice ' ! name of the alert 528 numal(alert_id) = 0 529 DO jl = 1, jpl 530 DO jk = 1, nlay_i 531 DO jj = 1, jpj 532 DO ji = 1, jpi 533 ztmelts = -tmut*s_i(ji,jj,jk,jl) + rtt 534 IF ( ( t_i(ji,jj,jk,jl) .GE. ztmelts) .AND. & 535 ( v_i(ji,jj,jl) .GT. 1.0e-6) .AND. & 536 ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 537 WRITE(numout,*) ' ALERTE 10 ' 538 WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 539 WRITE(numout,*) ' Very warm ice ' 540 WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 541 WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 542 WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl) 543 WRITE(numout,*) ' ztmelts : ', ztmelts 544 numal(alert_id) = numal(alert_id) + 1 545 ENDIF 546 END DO 547 END DO 548 END DO 549 END DO 550 551 alert_id = 1 ! reference number of this alert 552 alname(alert_id) = ' Il n''y a pas d''alerte 1 ' ! name of the alert 553 WRITE(numout,*) 554 WRITE(numout,*) ' All alerts at the end of ice model ' 555 DO alert_id = 1, numaltests 556 WRITE(numout,*) alert_id, alname(alert_id)//' : ', numal(alert_id), ' times ! ' 557 END DO 558 ! 559 ENDIF ! End sea-ice coupling 560 ! 561 END SUBROUTINE sbc_ice_lim 562 563 564 SUBROUTINE lim_inst_state( ki, kj, kn ) 479 480 SUBROUTINE lim_prt_state( ki, kj, kn, cd1 ) 565 481 !!----------------------------------------------------------------------- 566 !! *** ROUTINE lim_ inst_state ***482 !! *** ROUTINE lim_prt_state *** 567 483 !! 568 484 !! ** Purpose : Writes global ice state on the (i,j) point 569 485 !! in ocean.ouput 570 486 !! 3 possibilities exist 571 !! n = 1 -> simple ice state572 !! n = 2 -> exhaustive state573 !! n = 3 -> ice/ocean salt fluxes487 !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1) 488 !! n = 2 -> exhaustive state 489 !! n = 3 -> ice/ocean salt fluxes 574 490 !! 575 491 !! ** input : point coordinates (i,j) 576 492 !! n : number of the option 577 493 !!------------------------------------------------------------------- 578 INTEGER, INTENT( in ) :: ki, kj, kn ! ocean time-step index 494 INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices 495 CHARACTER(len=*), INTENT(in) :: cd1 ! 496 !! 579 497 INTEGER :: jl 580 498 !!------------------------------------------------------------------- 499 500 WRITE(numout,*) cd1 ! print title 581 501 582 502 !---------------- … … 584 504 !---------------- 585 505 586 IF ( kn .EQ.1 ) THEN587 WRITE(numout,*) ' lim_ inst_state - Point : ',ki,kj506 IF ( kn == 1 .OR. kn == -1 ) THEN 507 WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj 588 508 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 589 509 WRITE(numout,*) ' Simple state ' … … 623 543 END DO 624 544 ENDIF 545 IF( kn == -1 ) THEN 546 WRITE(numout,*) ' Mechanical Check ************** ' 547 WRITE(numout,*) ' Check what means ice divergence ' 548 WRITE(numout,*) ' Total ice concentration ', at_i (ki,kj) 549 WRITE(numout,*) ' Total lead fraction ', ato_i(ki,kj) 550 WRITE(numout,*) ' Sum of both ', ato_i(ki,kj) + at_i(ki,kj) 551 WRITE(numout,*) ' Sum of both minus 1 ', ato_i(ki,kj) + at_i(ki,kj) - 1.00 552 ENDIF 553 625 554 626 555 !-------------------- … … 629 558 630 559 IF ( kn .EQ. 2 ) THEN 631 WRITE(numout,*) ' lim_ inst_state - Point : ',ki,kj560 WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj 632 561 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 633 562 WRITE(numout,*) ' Exhaustive state ' … … 705 634 706 635 IF ( kn .EQ. 3 ) THEN 707 WRITE(numout,*) ' lim_ inst_state - Point : ',ki,kj636 WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj 708 637 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 709 638 WRITE(numout,*) ' - Salt / Heat Fluxes ' … … 730 659 WRITE(numout,*) ' vtau : ', vtau(ki,kj) 731 660 ENDIF 732 733 END SUBROUTINE lim_inst_state 661 WRITE(numout,*) ' ' 662 ! 663 END SUBROUTINE lim_prt_state 734 664 735 665 #else
Note: See TracChangeset
for help on using the changeset viewer.
