- Timestamp:
- 2016-11-21T11:40:00+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7278 r7280 13 13 !! - ! 2012-10 (C. Rousset) add lim_diahsb 14 14 !! 3.6 ! 2014-07 (M. Vancoppenolle, G. Madec, O. Marti) revise coupled interface 15 !! 4.0 ! 2016-06 (L. Brodeau) new unified bulk routine (based on AeroBulk) 15 16 !!---------------------------------------------------------------------- 16 17 #if defined key_lim3 … … 28 29 USE sbc_oce ! Surface boundary condition: ocean fields 29 30 USE sbc_ice ! Surface boundary condition: ice fields 30 USE sbcblk_core ! Surface boundary condition: CORE bulk 31 USE sbcblk_clio ! Surface boundary condition: CLIO bulk 31 USE sbcblk ! Surface boundary condition: bulk 32 32 USE sbccpl ! Surface boundary condition: coupled interface 33 33 USE albedo ! ocean & ice albedo … … 47 47 USE limupdate2 ! update of global variables 48 48 USE limvar ! Ice variables switch 49 USE limctl ! 49 USE limctl ! 50 50 USE limmsh ! LIM mesh 51 51 USE limistate ! LIM initial state … … 56 56 USE iom ! I/O manager library 57 57 USE prtctl ! Print control 58 USE lib_fortran ! 58 USE lib_fortran ! 59 59 USE lbclnk ! lateral boundary condition - MPP link 60 60 USE lib_mpp ! MPP library … … 62 62 USE timing ! Timing 63 63 64 #if defined key_bdy 64 #if defined key_bdy 65 65 USE bdyice_lim ! unstructured open boundary data (bdy_ice_lim routine) 66 66 #endif … … 71 71 PUBLIC sbc_ice_lim ! routine called by sbcmod.F90 72 72 PUBLIC sbc_lim_init ! routine called by sbcmod.F90 73 73 74 74 !! * Substitutions 75 75 # include "vectopt_loop_substitute.h90" … … 84 84 !!--------------------------------------------------------------------- 85 85 !! *** ROUTINE sbc_ice_lim *** 86 !! 87 !! ** Purpose : update the ocean surface boundary condition via the 88 !! Louvain la Neuve Sea Ice Model time stepping 86 !! 87 !! ** Purpose : update the ocean surface boundary condition via the 88 !! Louvain la Neuve Sea Ice Model time stepping 89 89 !! 90 90 !! ** Method : ice model time stepping 91 !! - call the ice dynamics routine 92 !! - call the ice advection/diffusion routine 93 !! - call the ice thermodynamics routine 94 !! - call the routine that computes mass and 91 !! - call the ice dynamics routine 92 !! - call the ice advection/diffusion routine 93 !! - call the ice thermodynamics routine 94 !! - call the routine that computes mass and 95 95 !! heat fluxes at the ice/ocean interface 96 !! - save the outputs 96 !! - save the outputs 97 97 !! - save the outputs for restart when necessary 98 98 !! 99 99 !! ** Action : - time evolution of the LIM sea-ice model 100 100 !! - update all sbc variables below sea-ice: 101 !! utau, vtau, taum, wndm, qns , qsr, emp , sfx 101 !! utau, vtau, taum, wndm, qns , qsr, emp , sfx 102 102 !!--------------------------------------------------------------------- 103 103 INTEGER, INTENT(in) :: kt ! ocean time step 104 INTEGER, INTENT(in) :: kblk ! type of bulk (= 3 CLIO, =4 CORE, =5 COUPLED)104 INTEGER, INTENT(in) :: kblk ! type of bulk (=4 BULK, =5 COUPLED) 105 105 !! 106 106 INTEGER :: jl ! dummy loop index 107 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 108 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 108 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 109 109 !!---------------------------------------------------------------------- 110 110 … … 119 119 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 120 120 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 121 121 122 122 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 123 123 CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 124 124 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 125 125 126 126 ! Mask sea ice surface temperature (set to rt0 over land) 127 127 DO jl = 1, jpl 128 128 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 129 END DO 130 ! 131 !------------------------------------------------! 132 ! --- Dynamical coupling with the atmosphere --- ! 129 END DO 130 ! 131 !------------------------------------------------! 132 ! --- Dynamical coupling with the atmosphere --- ! 133 133 !------------------------------------------------! 134 134 ! It provides the following fields: … … 136 136 !----------------------------------------------------------------- 137 137 SELECT CASE( kblk ) 138 CASE( jp_clio ) ; CALL blk_ice_clio_tau ! CLIO bulk formulation 139 CASE( jp_core ) ; CALL blk_ice_core_tau ! CORE bulk formulation 138 CASE( jp_blk ) ; CALL blk_ice_tau ! Bulk formulation 140 139 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 141 140 END SELECT 142 141 143 142 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 144 143 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) … … 153 152 !-------------------------------------------------------! 154 153 numit = numit + nn_fsbc ! Ice model time step 155 ! 154 ! 156 155 CALL sbc_lim_bef ! Store previous ice values 157 156 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 … … 160 159 IF( .NOT. lk_c1d ) THEN 161 160 ! 162 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 161 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 163 162 ! 164 163 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) … … 167 166 ! 168 167 #if defined key_bdy 169 CALL bdy_ice_lim( kt ) ! bdy ice thermo 168 CALL bdy_ice_lim( kt ) ! bdy ice thermo 170 169 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 171 170 #endif … … 174 173 ! 175 174 ENDIF 176 175 177 176 ! previous lead fraction and ice volume for flux calculations 178 CALL sbc_lim_bef 177 CALL sbc_lim_bef 179 178 CALL lim_var_glo2eqv ! ht_i and ht_s for ice albedo calculation 180 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 179 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 181 180 pfrld(:,:) = 1._wp - at_i(:,:) 182 181 phicif(:,:) = vt_i(:,:) 183 184 !------------------------------------------------------! 185 ! --- Thermodynamical coupling with the atmosphere --- ! 182 183 !------------------------------------------------------! 184 ! --- Thermodynamical coupling with the atmosphere --- ! 186 185 !------------------------------------------------------! 187 186 ! It provides the following fields: … … 196 195 197 196 SELECT CASE( kblk ) 198 CASE( jp_clio ) ! CLIO bulk formulation 199 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 200 ! (alb_ice) is computed within the bulk routine 201 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 202 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 203 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 204 CASE( jp_core ) ! CORE bulk formulation 197 CASE( jp_blk ) ! bulk formulation 205 198 ! albedo depends on cloud fraction because of non-linear spectral effects 206 199 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 207 CALL blk_ice_ core_flx( t_su, alb_ice )200 CALL blk_ice_flx( t_su, alb_ice ) 208 201 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 209 202 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) … … 219 212 ! --- ice thermodynamics --- ! 220 213 !----------------------------! 221 CALL lim_thd( kt ) ! Ice thermodynamics 214 CALL lim_thd( kt ) ! Ice thermodynamics 222 215 ! 223 216 CALL lim_update2( kt ) ! Corrections … … 225 218 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 226 219 ! 227 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 228 ! 229 CALL lim_wri( 1 ) ! Ice outputs 220 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 221 ! 222 CALL lim_wri( 1 ) ! Ice outputs 230 223 ! 231 224 IF( kt == nit000 .AND. ln_rstart ) & 232 225 & CALL iom_close( numrir ) ! close input ice restart file 233 226 ! 234 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 227 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 235 228 ! 236 229 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash … … 248 241 ! 249 242 END SUBROUTINE sbc_ice_lim 250 243 251 244 252 245 SUBROUTINE sbc_lim_init … … 259 252 !!---------------------------------------------------------------------- 260 253 IF(lwp) WRITE(numout,*) 261 IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 254 IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 262 255 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 263 256 ! 264 ! ! Open the reference and configuration namelist files and namelist output file 265 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 257 ! ! Open the reference and configuration namelist files and namelist output file 258 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 266 259 CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 267 260 IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 268 261 ! 269 CALL ice_run! set some ice run parameters262 CALL lim_run_init ! set some ice run parameters 270 263 ! 271 264 ! ! Allocate the ice arrays … … 308 301 CALL lim_var_glo2eqv 309 302 ! 310 CALL lim_sbc_init ! ice surface boundary condition 303 CALL lim_sbc_init ! ice surface boundary condition 311 304 ! 312 305 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction … … 318 311 ELSE ; rn_amax_2d(ji,jj) = rn_amax_s ! SH 319 312 ENDIF 320 ENDDO321 END DO322 ! 323 nstart = numit + nn_fsbc 324 nitrun = nitend - nit000 + 1 325 nlast = numit + nitrun 313 END DO 314 END DO 315 ! 316 nstart = numit + nn_fsbc 317 nitrun = nitend - nit000 + 1 318 nlast = numit + nitrun 326 319 ! 327 320 IF( nstock == 0 ) nstock = nlast + 1 … … 330 323 331 324 332 SUBROUTINE ice_run325 SUBROUTINE lim_run_init 333 326 !!------------------------------------------------------------------- 334 !! *** ROUTINE ice_run***335 !! 327 !! *** ROUTINE lim_run_init *** 328 !! 336 329 !! ** Purpose : Definition some run parameter for ice model 337 330 !! 338 !! ** Method : Read the namicerun namelist and check the parameter 331 !! ** Method : Read the namicerun namelist and check the parameter 339 332 !! values called at the first timestep (nit000) 340 333 !! … … 343 336 INTEGER :: ios ! Local integer output status for namelist read 344 337 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 345 & ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 338 & ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 346 339 !!------------------------------------------------------------------- 347 ! 340 ! 348 341 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 349 342 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) … … 357 350 IF(lwp) THEN ! control print 358 351 WRITE(numout,*) 359 WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 360 WRITE(numout,*) ' ~~~~~~' 361 WRITE(numout,*) ' number of ice categories = ', jpl 362 WRITE(numout,*) ' number of ice layers = ', nlay_i 363 WRITE(numout,*) ' number of snow layers = ', nlay_s 364 WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn 365 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n 366 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 367 WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb 368 WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout 369 WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 370 WRITE(numout,*) ' i-index for control prints (ln_icectl=true) = ', iiceprt 371 WRITE(numout,*) ' j-index for control prints (ln_icectl=true) = ', jiceprt 352 WRITE(numout,*) 'lim_run_init : ice share parameters for dynamics/advection/thermo of sea-ice' 353 WRITE(numout,*) '~~~~~~~~~~~~' 354 WRITE(numout,*) ' Namelist namicerun' 355 WRITE(numout,*) ' number of ice categories = ', jpl 356 WRITE(numout,*) ' number of ice layers = ', nlay_i 357 WRITE(numout,*) ' number of snow layers = ', nlay_s 358 WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn 359 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n 360 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 361 WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb 362 WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout 363 WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 364 WRITE(numout,*) ' i-index for control prints (ln_icectl=true) = ', iiceprt 365 WRITE(numout,*) ' j-index for control prints (ln_icectl=true) = ', jiceprt 372 366 ENDIF 373 367 ! 374 368 ! sea-ice timestep and inverse 375 rdt_ice = nn_fsbc * rdt 376 r1_rdtice = 1._wp / rdt_ice 369 rdt_ice = nn_fsbc * rdt 370 r1_rdtice = 1._wp / rdt_ice 377 371 378 372 ! inverse of nlay_i and nlay_s … … 384 378 #endif 385 379 ! 386 END SUBROUTINE ice_run380 END SUBROUTINE lim_run_init 387 381 388 382 … … 414 408 IF(lwp) THEN ! control print 415 409 WRITE(numout,*) 416 WRITE(numout,*) 'ice_itd : ice cat distribution' 417 WRITE(numout,*) ' ~~~~~~' 418 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 419 WRITE(numout,*) ' mean ice thickness in the domain (used if nn_catbnd=2) rn_himean = ', rn_himean 410 WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 411 WRITE(numout,*) '~~~~~~~~~~~~' 412 WRITE(numout,*) ' Namelist namiceitd' 413 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 414 WRITE(numout,*) ' mean ice thickness in the domain (used if nn_catbnd=2) rn_himean = ', rn_himean 420 415 ENDIF 421 416 ! 422 417 !---------------------------------- 423 !- Thickness categories boundaries 418 !- Thickness categories boundaries 424 419 !---------------------------------- 425 IF(lwp) WRITE(numout,*)426 IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '427 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'428 420 ! 429 421 hi_max(:) = 0._wp … … 443 435 zalpha = 0.05_wp 444 436 zhmax = 3._wp * rn_himean 445 DO jl = 1, jpl 437 DO jl = 1, jpl 446 438 znum = jpl * ( zhmax+1 )**zalpha 447 439 zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) … … 457 449 hi_max(jpl) = 99._wp ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 458 450 ! 459 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 460 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 451 IF(lwp) WRITE(numout,*) 452 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 453 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 461 454 ! 462 455 END SUBROUTINE lim_itd_init 463 456 464 457 465 458 SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice , & 466 459 & pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 467 460 !!--------------------------------------------------------------------- 468 461 !! *** ROUTINE ice_lim_flx *** 469 !! 462 !! 470 463 !! ** Purpose : update the ice surface boundary condition by averaging and / or 471 !! redistributing fluxes on ice categories 472 !! 473 !! ** Method : average then redistribute 474 !! 475 !! ** Action : 464 !! redistributing fluxes on ice categories 465 !! 466 !! ** Method : average then redistribute 467 !! 468 !! ** Action : 476 469 !!--------------------------------------------------------------------- 477 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 478 ! ! = 1 average and redistribute ; =2 redistribute479 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 470 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 471 ! ! = 1 average and redistribute ; =2 redistribute 472 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 480 473 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo 481 474 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqns_ice ! non solar flux … … 526 519 CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m ) 527 520 ! 528 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 529 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 521 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 522 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 530 523 DO jl = 1, jpl 531 524 pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 532 525 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 533 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 526 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 534 527 END DO 535 528 ! … … 546 539 !! *** ROUTINE sbc_lim_bef *** 547 540 !! 548 !! ** purpose : store ice variables at "before" time step 541 !! ** purpose : store ice variables at "before" time step 549 542 !!---------------------------------------------------------------------- 550 543 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 551 544 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 552 545 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 553 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 546 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 554 547 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 555 548 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content … … 557 550 u_ice_b(:,:) = u_ice(:,:) 558 551 v_ice_b(:,:) = v_ice(:,:) 559 ! 552 ! 560 553 END SUBROUTINE sbc_lim_bef 561 554 … … 569 562 !!---------------------------------------------------------------------- 570 563 sfx (:,:) = 0._wp ; 571 sfx_bri(:,:) = 0._wp ; 564 sfx_bri(:,:) = 0._wp ; 572 565 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 573 566 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp … … 580 573 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 581 574 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 582 wfx_spr(:,:) = 0._wp ; 583 ! 584 hfx_thd(:,:) = 0._wp ; 575 wfx_spr(:,:) = 0._wp ; 576 ! 577 hfx_thd(:,:) = 0._wp ; 585 578 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 586 579 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 587 580 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 588 581 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 589 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 582 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 590 583 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 591 584 hfx_err_dif(:,:) = 0._wp … … 595 588 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 596 589 ! 597 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ;598 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ;590 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp 591 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp 599 592 ! 600 593 END SUBROUTINE sbc_lim_diag0 601 594 602 595 603 596 FUNCTION fice_cell_ave ( ptab ) 604 597 !!-------------------------------------------------------------------------- … … 608 601 REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 609 602 INTEGER :: jl ! Dummy loop index 610 611 fice_cell_ave (:,:) = 0. 0_wp603 604 fice_cell_ave (:,:) = 0._wp 612 605 DO jl = 1, jpl 613 606 fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 614 607 END DO 615 608 616 609 END FUNCTION fice_cell_ave 617 618 610 611 619 612 FUNCTION fice_ice_ave ( ptab ) 620 613 !!--------------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
