- Timestamp:
- 2015-02-04T17:22:15+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
