Changeset 5059 for branches/2015/dev_r5044_CNRS_LIM3CLEAN
- Timestamp:
- 2015-02-04T17:22:15+01:00 (9 years ago)
- Location:
- branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO
- Files:
-
- 9 edited
-
LIM_SRC_3/dom_ice.F90 (modified) (2 diffs)
-
LIM_SRC_3/ice.F90 (modified) (3 diffs)
-
LIM_SRC_3/limcons.F90 (modified) (2 diffs)
-
LIM_SRC_3/limctl.F90 (modified) (4 diffs)
-
LIM_SRC_3/limdyn.F90 (modified) (4 diffs)
-
LIM_SRC_3/limtrp.F90 (modified) (11 diffs)
-
LIM_SRC_3/limupdate1.F90 (modified) (9 diffs)
-
LIM_SRC_3/limupdate2.F90 (modified) (10 diffs)
-
OPA_SRC/SBC/sbcice_lim.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
r5055 r5059 21 21 22 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcor !: coriolis coefficient 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: covrai !: sine of geographic latitude24 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: area !: surface of grid cell 25 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms, tmi !: temperature mask, mask for stress … … 43 42 !!------------------------------------------------------------------- 44 43 ! 45 ALLOCATE( fcor(jpi,jpj) , & 46 & covrai(jpi,jpj) , area(jpi,jpj) , & 44 ALLOCATE( fcor(jpi,jpj) , area(jpi,jpj) , & 47 45 & tms (jpi,jpj) , tmi (jpi,jpj) , & 48 46 & tmu (jpi,jpj) , tmv (jpi,jpj) , & -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r5058 r5059 380 380 ! thd refers to changes induced by thermodynamics 381 381 ! trp '' '' '' advection (transport of ice) 382 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_a_i_thd , d_a_i_trp !: icefractions383 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_s_thd , d_v_s_trp !: snow volume384 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_i_thd , d_v_i_trp !: ice volume385 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_smv_i_thd, d_smv_i_trp !:386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_oa_i_thd , d_oa_i_trp !:387 388 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_s_thd , d_e_s_trp !:389 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_i_thd , d_e_i_trp !:390 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: d_u_ice_dyn, d_v_ice_dyn !: ice velocity391 392 382 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 393 383 LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F) … … 414 404 INTEGER :: ice_alloc 415 405 ! 416 INTEGER :: ierr(1 9), ii406 INTEGER :: ierr(17), ii 417 407 !!----------------------------------------------------------------- 418 408 … … 485 475 & oa_i_b (jpi,jpj,jpl) , & 486 476 & u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 487 488 ! * Increment of global variables489 ii = ii + 1490 ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd (jpi,jpj,jpl) , d_v_s_trp (jpi,jpj,jpl) , &491 & d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) , &492 & d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , &493 & STAT=ierr(ii) )494 ii = ii + 1495 ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) , &496 & d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )497 477 498 478 ! * Ice thickness distribution variables -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r5055 r5059 6 6 !! History : - ! Original code from William H. Lipscomb, LANL 7 7 !! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation 8 !! 4.0! 2011-02 (G. Madec) add mpp considerations8 !! 3.5 ! 2011-02 (G. Madec) add mpp considerations 9 9 !! - ! 2014-05 (C. Rousset) add lim_cons_hsm 10 10 !!---------------------------------------------------------------------- … … 207 207 IF ( ABS( zsmv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 208 208 IF ( ABS( zei ) > 1. ) WRITE(numout,*) 'violation enthalpy [1e9 J] (',cd_routine,') = ',(zei) 209 IF ( zvmin < 0.) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',(zvmin)209 IF ( zvmin < 1.e-10 ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',(zvmin) 210 210 IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 211 211 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 212 212 ENDIF 213 IF ( zamin < 0.) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin213 IF ( zamin < 1.e-10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 214 214 ENDIF 215 215 -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
r5055 r5059 77 77 !WRITE(numout,*) ' a_i *** a_i_b ', a_i (ji,jj,jl), a_i_b (ji,jj,jl) 78 78 !WRITE(numout,*) ' v_i *** v_i_b ', v_i (ji,jj,jl), v_i_b (ji,jj,jl) 79 !WRITE(numout,*) ' d_a_i_thd/trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl)80 !WRITE(numout,*) ' d_v_i_thd/trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl)81 79 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 82 80 ENDIF … … 187 185 !WRITE(numout,*) ' Category no: ', jl 188 186 !WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' a_i_b : ', a_i_b (ji,jj,jl) 189 !WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl)190 187 !WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' v_i_b : ', v_i_b (ji,jj,jl) 191 !WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl)192 188 !WRITE(numout,*) ' ' 193 189 !END DO … … 363 359 WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj) 364 360 WRITE(numout,*) ' strength : ', strength(ji,jj) 365 WRITE(numout,*) ' d_u_ice_dyn : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn : ', d_v_ice_dyn(ji,jj)366 361 WRITE(numout,*) ' u_ice_b : ', u_ice_b(ji,jj) , ' v_ice_b : ', v_ice_b(ji,jj) 367 362 WRITE(numout,*) … … 375 370 WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl) , ' o_i : ', o_i(ji,jj,jl) 376 371 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl) 377 WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl)378 372 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl) 379 WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl)380 373 WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl) 381 WRITE(numout,*) ' d_v_s_trp : ', d_v_s_trp(ji,jj,jl) , ' d_v_s_thd : ', d_v_s_thd(ji,jj,jl)382 374 WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl)/1.0e9 , ' ei1 : ', e_i_b(ji,jj,1,jl)/1.0e9 383 WRITE(numout,*) ' de_i1_trp : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd : ', d_e_i_thd(ji,jj,1,jl)/1.0e9384 375 WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl)/1.0e9 , ' ei2_b : ', e_i_b(ji,jj,2,jl)/1.0e9 385 WRITE(numout,*) ' de_i2_trp : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd : ', d_e_i_thd(ji,jj,2,jl)/1.0e9386 376 WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl) 387 WRITE(numout,*) ' d_e_s_trp : ', d_e_s_trp(ji,jj,1,jl) , ' d_e_s_thd : ', d_e_s_thd(ji,jj,1,jl)388 377 WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl) , ' smv_i_b : ', smv_i_b(ji,jj,jl) 389 WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl) , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl)390 378 WRITE(numout,*) ' oa_i : ', oa_i(ji,jj,jl) , ' oa_i_b : ', oa_i_b(ji,jj,jl) 391 WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl) , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl)392 379 END DO !jl 393 380 -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r5055 r5059 6 6 !! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code 7 7 !! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid 8 !! 4.0! 2011-02 (G. Madec) dynamical allocation8 !! 3.5 ! 2011-02 (G. Madec) dynamical allocation 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_lim3 … … 244 244 INTEGER :: ios ! Local integer output status for namelist read 245 245 NAMELIST/namicedyn/ cw, pstar, c_rhg, creepl, ecc, ahi0, nevp, relast 246 INTEGER :: ji, jj 247 REAL(wp) :: za00, zd_max 246 248 !!------------------------------------------------------------------- 247 249 … … 264 266 WRITE(numout,*) ' creep limit creepl = ', creepl 265 267 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc 266 WRITE(numout,*) ' horizontal diffusivity coeff. for sea-iceahi0 = ', ahi0268 WRITE(numout,*) ' horizontal diffusivity coeff. (orca2 grid) ahi0 = ', ahi0 267 269 WRITE(numout,*) ' number of iterations for subcycling nevp = ', nevp 268 270 WRITE(numout,*) ' ratio of elastic timescale over ice time step relast = ', relast … … 271 273 usecc2 = 1._wp / ( ecc * ecc ) 272 274 rhoco = rau0 * cw 273 275 ! 274 276 ! Diffusion coefficients. 275 ahiu(:,:) = ahi0 * umask(:,:,1) 276 ahiv(:,:) = ahi0 * vmask(:,:,1) 277 ! 277 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 278 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 279 280 za00 = ahi0 / ( 1.e05_wp ) ! 1.e05 = 100km = max grid space at 60° latitude in orca2 281 ! (i.e. 60° = min latitude for ice cover) 282 DO jj = 1, jpj 283 DO ji = 1, jpi 284 ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 285 ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 286 END DO 287 END DO 288 ! 289 IF(lwp) WRITE(numout,*) '' 290 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to e1' 291 IF(lwp) WRITE(numout,*) ' maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 292 278 293 END SUBROUTINE lim_dyn_init 279 294 -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r5055 r5059 61 61 !! ** action : 62 62 !!--------------------------------------------------------------------- 63 INTEGER, INTENT(in) :: kt ! number of iteration63 INTEGER, INTENT(in) :: kt ! number of iteration 64 64 ! 65 INTEGER :: ji, jj, jk, jl, jt ! dummy loop indices65 INTEGER :: ji, jj, jk, jl, jt ! dummy loop indices 66 66 INTEGER :: initad ! number of sub-timestep for the advection 67 67 REAL(wp) :: zcfl , zusnit ! - - 68 CHARACTER(len=80) :: cltmp68 CHARACTER(len=80) :: cltmp 69 69 ! 70 70 REAL(wp), POINTER, DIMENSION(:,:) :: zsm, zs0at … … 75 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax ! old ice thickness 76 76 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold ! old concentration, enthalpies 77 REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 78 ! 79 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 77 REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 78 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 80 79 !!--------------------------------------------------------------------- 81 80 IF( nn_timing == 1 ) CALL timing_start('limtrp') … … 122 121 DO ji = 2, jpim1 123 122 zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) ) 124 !zhimax(ji,jj,jl) = ( ht_i(ji ,jj ,jl) * tmask(ji, jj ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) &125 ! & + ht_i(ji-1,jj ,jl) * tmask(ji-1,jj ,1) + ht_i(ji ,jj-1,jl) * tmask(ji ,jj-1,1) &126 ! & + ht_i(ji+1,jj ,jl) * tmask(ji+1,jj ,1) + ht_i(ji ,jj+1,jl) * tmask(ji ,jj+1,1) &127 ! & + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) )128 123 END DO 129 124 END DO … … 139 134 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) ) 140 135 IF(lk_mpp ) CALL mpp_max( zcfl ) 141 !!gm more readability: 142 ! IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 143 ! ELSE ; initad = 1 ; zusnit = 1.0_wp 144 ! ENDIF 145 !!gm end 146 initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 147 zusnit = 1.0 / REAL( initad ) 136 137 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 138 ELSE ; initad = 1 ; zusnit = 1.0_wp 139 ENDIF 140 148 141 IF( zcfl > 0.5_wp .AND. lwp ) ncfl = ncfl + 1 149 142 IF( numit == nlast .AND. lwp ) THEN 150 143 IF( ncfl > 0 ) THEN 151 WRITE(cltmp,'(i6.1)') ncfl152 CALL ctl_stop('STOP',TRIM(cltmp) )144 WRITE(cltmp,'(i6.1)') ncfl 145 CALL ctl_stop('STOP',TRIM(cltmp) ) 153 146 CALL ctl_warn( 'lim_trp: ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 154 147 ELSE … … 160 153 ! transported fields 161 154 !------------------------- 162 zs0ow(:,:,1) = ato_i(:,:) * area(:,:) 155 zs0ow(:,:,1) = ato_i(:,:) * area(:,:) ! Open water area 163 156 DO jl = 1, jpl 164 157 zs0sn (:,:,jl) = v_s (:,:,jl) * area(:,:) ! Snow volume … … 277 270 278 271 !------------------------------------------------------------------------------! 279 ! 4)Diffusion of Ice fields272 ! Diffusion of Ice fields 280 273 !------------------------------------------------------------------------------! 281 274 … … 322 315 323 316 !------------------------------------------------------------------------------! 324 ! 5) Update andlimit ice properties after transport317 ! limit ice properties after transport 325 318 !------------------------------------------------------------------------------! 326 327 319 !!gm & cr : MAX should not be active if adv scheme is positive ! 328 !--------------------------------------------------329 ! 5.1) Recover mean values over the grid squares.330 !--------------------------------------------------331 320 DO jl = 1, jpl 332 321 DO jj = 1, jpj … … 340 329 END DO 341 330 END DO 342 END DO 343 DO jl = 1, jpl 331 344 332 DO jk = 1, nlay_i 345 333 DO jj = 1, jpj … … 458 446 459 447 ! ------------------------------------------------- 460 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' ) ! control print448 ! control prints 461 449 ! ------------------------------------------------- 462 IF(ln_ctl) THEN ! Control print 463 CALL prt_ctl_info(' ') 464 CALL prt_ctl_info(' - Cell values : ') 465 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 466 CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp : cell area :') 467 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp : at_i :') 468 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp : vt_i :') 469 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp : vt_s :') 470 DO jl = 1, jpl 471 CALL prt_ctl_info(' ') 472 CALL prt_ctl_info(' - Category : ', ivar1=jl) 473 CALL prt_ctl_info(' ~~~~~~~~~~') 474 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_trp : a_i : ') 475 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_trp : ht_i : ') 476 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_trp : ht_s : ') 477 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_trp : v_i : ') 478 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_trp : v_s : ') 479 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_trp : e_s : ') 480 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_trp : t_su : ') 481 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_trp : t_snow : ') 482 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_trp : sm_i : ') 483 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_trp : smv_i : ') 484 DO jk = 1, nlay_i 485 CALL prt_ctl_info(' ') 486 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 487 CALL prt_ctl_info(' ~~~~~~~') 488 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp : t_i : ') 489 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp : e_i : ') 490 END DO 491 END DO 492 ENDIF 450 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' ) 493 451 ! 494 452 CALL wrk_dealloc( jpi,jpj, zsm, zs0at, zatold, zeiold, zesold ) … … 499 457 ! 500 458 IF( nn_timing == 1 ) CALL timing_stop('limtrp') 459 501 460 END SUBROUTINE lim_trp 502 461 … … 509 468 END SUBROUTINE lim_trp 510 469 #endif 511 512 470 !!====================================================================== 513 471 END MODULE limtrp -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r5055 r5059 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3. 6! 2014-06 (C. Rousset) Complete rewriting/cleaning7 !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_lim3 … … 13 13 !! lim_update1 : computes update of sea-ice global variables from trend terms 14 14 !!---------------------------------------------------------------------- 15 USE limrhg ! ice rheology16 17 USE dom_oce18 USE oce ! dynamics and tracers variables19 USE in_out_manager20 15 USE sbc_oce ! Surface boundary condition: ocean fields 21 16 USE sbc_ice ! Surface boundary condition: ice fields … … 23 18 USE phycst ! physical constants 24 19 USE ice 25 USE limdyn26 USE limtrp27 USE limthd28 USE limsbc29 USE limdiahsb30 USE limwri31 USE limrst32 20 USE thd_ice ! LIM thermodynamic sea-ice variables 33 21 USE limitd_th 34 USE limitd_me35 22 USE limvar 36 USE prtctl ! Print control 37 USE lbclnk ! lateral boundary condition - MPP exchanges 38 USE wrk_nemo ! work arrays 39 USE lib_fortran ! glob_sum 40 USE in_out_manager ! I/O manager 41 USE iom ! I/O manager 42 USE lib_mpp ! MPP library 23 USE prtctl ! Print control 24 USE wrk_nemo ! work arrays 43 25 USE timing ! Timing 44 USE limcons ! conservation tests 26 USE limcons ! conservation tests 27 USE lib_mpp ! MPP library 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 29 USE in_out_manager ! I/O manager 45 30 46 31 IMPLICIT NONE 47 32 PRIVATE 48 33 49 PUBLIC lim_update1 ! routine called by ice_step34 PUBLIC lim_update1 50 35 51 36 !! * Substitutions … … 66 51 !! 67 52 !!--------------------------------------------------------------------- 68 INTEGER, INTENT(in) :: kt ! number of iteration53 INTEGER, INTENT(in) :: kt ! number of iteration 69 54 INTEGER :: ji, jj, jk, jl ! dummy loop indices 70 INTEGER :: i_ice_switch71 55 REAL(wp) :: zsal 72 ! 73 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 56 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 74 57 !!------------------------------------------------------------------- 75 58 IF( nn_timing == 1 ) CALL timing_start('limupdate1') … … 141 124 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 142 125 ! salinity stays in bounds 143 i_ice_switch= 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )144 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )126 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 127 smv_i(ji,jj,jl) = rswitch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 145 128 ! associated salt flux 146 129 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice … … 150 133 ENDIF 151 134 135 ! conservation test 136 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 137 152 138 ! ------------------------------------------------- 153 139 ! Diagnostics … … 157 143 END DO 158 144 159 d_u_ice_dyn(:,:) = u_ice(:,:) - u_ice_b(:,:) 160 d_v_ice_dyn(:,:) = v_ice(:,:) - v_ice_b(:,:) 161 d_a_i_trp (:,:,:) = a_i (:,:,:) - a_i_b (:,:,:) 162 d_v_s_trp (:,:,:) = v_s (:,:,:) - v_s_b (:,:,:) 163 d_v_i_trp (:,:,:) = v_i (:,:,:) - v_i_b (:,:,:) 164 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - e_s_b (:,:,:,:) 165 d_e_i_trp (:,:,1:nlay_i,:) = e_i (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 166 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:) 167 d_smv_i_trp(:,:,:) = 0._wp 168 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 169 170 ! conservation test 171 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 172 145 ! heat content variation (W.m-2) 146 DO jj = 1, jpj 147 DO ji = 1, jpi 148 diag_heat_dhc(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + & 149 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) & 150 & ) * unit_fac * r1_rdtice / area(ji,jj) 151 END DO 152 END DO 153 154 ! ------------------------------------------------- 155 ! control prints 156 ! ------------------------------------------------- 173 157 IF(ln_ctl) THEN ! Control print 174 158 CALL prt_ctl_info(' ') … … 181 165 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update1 : strength :') 182 166 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update1 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 183 CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1 : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :')184 167 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update1 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 185 168 … … 196 179 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update1 : a_i : ') 197 180 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update1 : a_i_b : ') 198 CALL prt_ctl(tab2d_1=d_a_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_a_i_trp : ')199 181 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update1 : v_i : ') 200 182 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update1 : v_i_b : ') 201 CALL prt_ctl(tab2d_1=d_v_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_i_trp : ')202 183 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update1 : v_s : ') 203 184 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update1 : v_s_b : ') 204 CALL prt_ctl(tab2d_1=d_v_s_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_s_trp : ')205 185 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1 : ') 206 186 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1_b : ') 207 CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : de_i1_trp : ')208 187 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2 : ') 209 188 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2_b : ') 210 CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : de_i2_trp : ')211 189 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow : ') 212 190 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow_b : ') 213 CALL prt_ctl(tab2d_1=d_e_s_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : d_e_s_trp : ')214 191 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update1 : smv_i : ') 215 192 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update1 : smv_i_b : ') 216 CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl) , clinfo1= ' lim_update1 : d_smv_i_trp : ')217 193 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update1 : oa_i : ') 218 194 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update1 : oa_i_b : ') 219 CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_oa_i_trp : ')220 195 221 196 DO jk = 1, nlay_i -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r5055 r5059 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3. 6! 2014-06 (C. Rousset) Complete rewriting/cleaning7 !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_lim3 … … 13 13 !! lim_update2 : computes update of sea-ice global variables from trend terms 14 14 !!---------------------------------------------------------------------- 15 USE limrhg ! ice rheology16 17 USE dom_oce18 USE oce ! dynamics and tracers variables19 USE in_out_manager20 15 USE sbc_oce ! Surface boundary condition: ocean fields 21 16 USE sbc_ice ! Surface boundary condition: ice fields … … 23 18 USE phycst ! physical constants 24 19 USE ice 25 USE limdyn26 USE limtrp27 USE limthd28 USE limsbc29 USE limdiahsb30 USE limwri31 USE limrst32 20 USE thd_ice ! LIM thermodynamic sea-ice variables 33 21 USE limitd_th 34 USE limitd_me35 22 USE limvar 36 USE prtctl ! Print control 37 USE lbclnk ! lateral boundary condition - MPP exchanges 38 USE wrk_nemo ! work arrays 39 USE lib_fortran ! glob_sum 23 USE prtctl ! Print control 24 USE lbclnk ! lateral boundary condition - MPP exchanges 25 USE wrk_nemo ! work arrays 40 26 USE timing ! Timing 41 USE limcons ! conservation tests27 USE limcons ! conservation tests 42 28 USE limctl 29 USE lib_mpp ! MPP library 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 USE in_out_manager 43 32 44 33 IMPLICIT NONE … … 64 53 !! 65 54 !!--------------------------------------------------------------------- 66 INTEGER, INTENT(in) :: kt ! number of iteration 67 INTEGER :: ji, jj, jk, jl ! dummy loop indices 68 INTEGER :: i_ice_switch 55 INTEGER, INTENT(in) :: kt ! number of iteration 56 INTEGER :: ji, jj, jk, jl ! dummy loop indices 69 57 REAL(wp) :: zh, zsal 70 ! 71 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 58 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 72 59 !!------------------------------------------------------------------- 73 60 IF( nn_timing == 1 ) CALL timing_start('limupdate2') … … 142 129 143 130 !--------------------- 144 ! 2.11)Ice salinity131 ! Ice salinity 145 132 !--------------------- 146 133 IF ( num_sal == 2 ) THEN … … 151 138 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 152 139 ! salinity stays in bounds 153 i_ice_switch= 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )154 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)140 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 141 smv_i(ji,jj,jl) = rswitch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - rswitch ) * v_i(ji,jj,jl) 155 142 ! associated salt flux 156 143 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice … … 161 148 162 149 !------------------------------------------------------------------------------ 163 ! 2)Corrections to avoid wrong values |150 ! Corrections to avoid wrong values | 164 151 !------------------------------------------------------------------------------ 165 152 ! Ice drift … … 186 173 CALL lim_var_agg(2) ! aggregate ice thickness categories 187 174 175 ! conservation test 176 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 177 188 178 ! ------------------------------------------------- 189 179 ! Diagnostics … … 193 183 END DO 194 184 afx_tot = afx_thd + afx_dyn 195 196 d_a_i_thd(:,:,:) = a_i(:,:,:) - a_i_b(:,:,:)197 d_v_s_thd(:,:,:) = v_s(:,:,:) - v_s_b(:,:,:)198 d_v_i_thd(:,:,:) = v_i(:,:,:) - v_i_b(:,:,:)199 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:)200 d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)201 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:)202 d_smv_i_thd(:,:,:) = 0._wp203 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)204 185 205 186 ! heat content variation (W.m-2) 206 187 DO jj = 1, jpj 207 188 DO ji = 1, jpi 208 diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) + & 209 & SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) & 189 diag_heat_dhc(ji,jj) = diag_heat_dhc(ji,jj)+ & 190 & ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + & 191 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) & 210 192 & ) * unit_fac * r1_rdtice / area(ji,jj) 211 193 END DO 212 194 END DO 213 195 214 ! conservation test215 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)216 196 ! ------------------------------------------------- 197 ! control prints 198 ! ------------------------------------------------- 217 199 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 2, ' - Final state - ' ) ! control print 218 200 … … 241 223 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update2 : a_i : ') 242 224 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update2 : a_i_b : ') 243 CALL prt_ctl(tab2d_1=d_a_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_a_i_thd : ')244 225 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update2 : v_i : ') 245 226 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update2 : v_i_b : ') 246 CALL prt_ctl(tab2d_1=d_v_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_i_thd : ')247 227 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update2 : v_s : ') 248 228 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update2 : v_s_b : ') 249 CALL prt_ctl(tab2d_1=d_v_s_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_s_thd : ')250 229 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1 : ') 251 230 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1_b : ') 252 CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : de_i1_thd : ')253 231 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2 : ') 254 232 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2_b : ') 255 CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : de_i2_thd : ')256 233 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow : ') 257 234 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow_b : ') 258 CALL prt_ctl(tab2d_1=d_e_s_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : d_e_s_thd : ')259 235 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update2 : smv_i : ') 260 236 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update2 : smv_i_b : ') 261 CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl) , clinfo1= ' lim_update2 : d_smv_i_thd : ')262 237 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update2 : oa_i : ') 263 238 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update2 : oa_i_b : ') 264 CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_oa_i_thd : ')265 239 266 240 DO jk = 1, nlay_i -
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5058 r5059 183 183 !------------------------------! 184 184 numit = numit + nn_fsbc ! Ice model time step 185 ! 186 ! ! Store previous ice values 187 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 188 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 189 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 190 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 191 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 192 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 193 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 194 u_ice_b(:,:) = u_ice(:,:) 195 v_ice_b(:,:) = v_ice(:,:) 196 197 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 198 199 CALL lim_rst_opn( kt ) ! Open Ice restart file 185 ! 186 CALL sbc_lim_update ! Store previous ice values 187 188 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 189 190 CALL lim_rst_opn( kt ) ! Open Ice restart file 200 191 ! 201 192 ! ---------------------------------------------- … … 203 194 ! ---------------------------------------------- 204 195 IF( .NOT. lk_c1d ) THEN 205 206 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 207 208 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 209 210 IF( nn_monocat /= 2 ) & 211 & CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 196 197 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 198 199 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 200 201 IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 212 202 213 203 #if defined key_bdy 214 ! bdy ice thermo 215 CALL lim_var_glo2eqv ! equivalent variables 216 CALL bdy_ice_lim( kt ) 217 CALL lim_var_zapsmall 218 CALL lim_var_agg(1) 219 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' ) ! control print 204 CALL lim_var_glo2eqv 205 CALL bdy_ice_lim( kt ) ! bdy ice thermo 206 CALL lim_var_zapsmall 207 CALL lim_var_agg(1) 208 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' ) 220 209 #endif 221 222 CALL lim_update1( kt ) 223 210 CALL lim_update1( kt ) 211 224 212 ENDIF 225 226 !- Change old values for new values 227 u_ice_b(:,:) = u_ice(:,:) 228 v_ice_b(:,:) = v_ice(:,:) 229 a_i_b (:,:,:) = a_i (:,:,:) 230 v_s_b (:,:,:) = v_s (:,:,:) 231 v_i_b (:,:,:) = v_i (:,:,:) 232 e_s_b (:,:,:,:) = e_s (:,:,:,:) 233 e_i_b (:,:,:,:) = e_i (:,:,:,:) 234 oa_i_b (:,:,:) = oa_i (:,:,:) 235 smv_i_b(:,:,:) = smv_i(:,:,:) 213 214 CALL sbc_lim_update ! Store previous ice values 236 215 237 216 ! ---------------------------------------------- 238 217 ! ice thermodynamics 239 218 ! ---------------------------------------------- 240 CALL lim_var_glo2eqv ! equivalent variables241 CALL lim_var_agg(1) ! aggregate ice categories242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 CALL lim_thd( kt )! Ice thermodynamics258 259 CALL lim_update2( kt )! Global variables update260 ! 261 CALL lim_sbc_flx( kt )! Update surface ocean mass, heat and salt fluxes262 ! 263 IF(ln_limdiaout) CALL lim_diahsb 264 265 CALL lim_wri( 1 )! Ice outputs266 219 CALL lim_var_glo2eqv 220 CALL lim_var_agg(1) 221 222 ! previous lead fraction and ice volume for flux calculations 223 pfrld(:,:) = 1._wp - at_i(:,:) 224 phicif(:,:) = vt_i(:,:) 225 226 SELECT CASE( kblk ) 227 CASE ( jp_cpl ) 228 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 229 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 230 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 231 ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 232 qla_ice (:,:,:) = 0._wp 233 dqla_ice (:,:,:) = 0._wp 234 END SELECT 235 ! 236 CALL lim_thd( kt ) ! Ice thermodynamics 237 238 CALL lim_update2( kt ) ! Global variables update 239 ! 240 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 241 ! 242 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 243 244 CALL lim_wri( 1 ) ! Ice outputs 245 267 246 IF( kt == nit000 .AND. ln_rstart ) & 268 & CALL iom_close( numrir ) 269 ! 270 IF( lrst_ice ) CALL lim_rst_write( kt ) 271 CALL lim_var_glo2eqv! ???272 ! 273 IF( ln_nicep ) CALL lim_ctl( kt ) 247 & CALL iom_close( numrir ) ! close input ice restart file 248 ! 249 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 250 CALL lim_var_glo2eqv ! ??? 251 ! 252 IF( ln_nicep ) CALL lim_ctl( kt ) ! alerts in case of model crash 274 253 ! 275 254 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 276 255 ! 277 ENDIF ! End sea-ice time step only 278 279 ! !--------------------------! 280 ! ! at all ocean time step ! 281 ! !--------------------------! 282 ! 283 ! ! Update surface ocean stresses (only in ice-dynamic case) 284 ! ! otherwise the atm.-ocean stresses are used everywhere 256 ENDIF ! End sea-ice time step only 257 258 !--------------------------------! 259 ! --- at all ocean time step --- ! 260 !--------------------------------! 261 ! Update surface ocean stresses (only in ice-dynamic case) 262 ! otherwise the atm.-ocean stresses are used everywhere 285 263 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 286 264 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! … … 504 482 & pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 505 483 !!--------------------------------------------------------------------- 506 !! *** ROUTINE sbc_ice_lim***484 !! *** ROUTINE ice_lim_flx *** 507 485 !! 508 486 !! ** Purpose : update the ice surface boundary condition by averaging and / or … … 580 558 END SUBROUTINE ice_lim_flx 581 559 560 SUBROUTINE sbc_lim_update 561 !!---------------------------------------------------------------------- 562 !! *** ROUTINE sbc_lim_update *** 563 !! 564 !! ** purpose : store ice variables at "before" time step 565 !!---------------------------------------------------------------------- 566 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 567 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 568 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 569 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 570 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 571 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 572 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 573 u_ice_b(:,:) = u_ice(:,:) 574 v_ice_b(:,:) = v_ice(:,:) 575 576 END SUBROUTINE sbc_lim_update 577 582 578 SUBROUTINE sbc_lim_diag0 583 579 !!---------------------------------------------------------------------- 584 !! *** ROUTINE sbc_lim_ flx0 ***580 !! *** ROUTINE sbc_lim_diag0 *** 585 581 !! 586 582 !! ** purpose : set ice-ocean and ice-atm. fluxes to zeros at the beggining … … 612 608 afx_tot(:,:) = 0._wp ; 613 609 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 610 611 diag_heat_dhc(:,:) = 0._wp ; 614 612 615 613 END SUBROUTINE sbc_lim_diag0
Note: See TracChangeset
for help on using the changeset viewer.
