Changeset 4869 for trunk/NEMOGCM
- Timestamp:
- 2014-11-18T16:43:44+01:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r4863 r4869 324 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 325 325 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: at_i_typ !: total area contained in each ice type [m^2]327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vt_i_typ !: total volume contained in each ice type [m^3]328 329 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 330 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 331 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_i_cat !: ! go to trash333 328 334 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] … … 378 373 !! * Ice thickness distribution variables 379 374 !!-------------------------------------------------------------------------- 380 ! REMOVE381 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ice_types !: Vector connecting types and categories382 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ice_cat_bounds !: Matrix containing the integer upper and383 ! ! lower boundaries of ice thickness categories384 ! REMOVE385 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ice_ncat_types !: nb of thickness categories in each ice type386 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 387 376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 388 ! REMOVE389 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hi_max_typ !: Boundary of ice thickness categories in thickness space390 377 391 378 !!-------------------------------------------------------------------------- … … 476 463 & bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) ) 477 464 ii = ii + 1 478 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,&479 & e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) ,STAT=ierr(ii) )465 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , & 466 & e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 480 467 ii = ii + 1 481 468 ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) ) … … 518 505 ! * Ice thickness distribution variables 519 506 ii = ii + 1 520 ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types (jpm) , & 521 & hi_max (0:jpl) , hi_mean(jpl) , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) ) 507 ALLOCATE( hi_max(0:jpl), hi_mean(jpl), STAT=ierr(ii) ) 522 508 523 509 ! * Ice diagnostics -
trunk/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r4831 r4869 66 66 ! 67 67 ! ! adequation jpk versus ice/snow layers/categories 68 IF( jpl > jpk .OR. jpm > jpk .OR.&69 jkmax > jpk .OR. nlay_s > jpk ) CALL ctl_stop( 'STOP',&68 IF( jpl > jpk .OR. jkmax > jpk .OR. nlay_s > jpk ) & 69 & CALL ctl_stop( 'STOP', & 70 70 & 'ice_init: the 3rd dimension of workspace arrays is too small.', & 71 71 & 'use more ocean levels or less ice/snow layers/categories.' ) … … 174 174 !! limistate (only) and is changed to 99 m in ice_init 175 175 !!------------------------------------------------------------------ 176 INTEGER :: jl , jm! dummy loop index176 INTEGER :: jl ! dummy loop index 177 177 REAL(wp) :: zc1, zc2, zc3, zx1 ! local scalars 178 178 !!------------------------------------------------------------------ … … 185 185 ! 1) Ice thickness distribution parameters initialization 186 186 !------------------------------------------------------------------------------! 187 188 !- Types boundaries (integer)189 !----------------------------190 ice_cat_bounds(1,1) = 1191 ice_cat_bounds(1,2) = jpl192 193 !- Number of ice thickness categories in each ice type194 DO jm = 1, jpm195 ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1196 END DO197 198 !- Make the correspondence between thickness categories and ice types199 !---------------------------------------------------------------------200 DO jm = 1, jpm !over types201 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories202 ice_types(jl) = jm203 END DO204 END DO205 206 187 IF(lwp) THEN 207 WRITE(numout,*) ' Number of ice types jpm = ', jpm208 188 WRITE(numout,*) ' Number of ice categories jpl = ', jpl 209 DO jm = 1, jpm210 WRITE(numout,*) ' Ice type ', jm211 WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm)212 WRITE(numout,*) ' Thickness category boundaries ', ice_cat_bounds(jm,1:2)213 END DO214 WRITE(numout,*) 'Ice type vector', ice_types(1:jpl)215 WRITE(numout,*)216 189 ENDIF 217 190 … … 219 192 !---------------------------------- 220 193 hi_max(:) = 0._wp 221 hi_max_typ(:,:) = 0._wp 222 223 !- Type 1 - undeformed ice 224 zc1 = 3._wp / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp ) 194 195 zc1 = 3._wp / REAL( jpl, wp ) 225 196 zc2 = 10._wp * zc1 226 197 zc3 = 3._wp 227 198 228 DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)229 zx1 = REAL( jl-1 , wp ) / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1, wp )199 DO jl = 1, jpl 200 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 230 201 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 231 202 END DO 232 203 233 !- Fill in the hi_max_typ vector, useful in other circumstances 234 ! Tricky trick: hi_max_typ is actually not used in the code and will be removed in a 235 ! next flyspray at this time, the tricky trick will also be removed (Martin, march 08) 236 DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 237 hi_max_typ(jl,1) = hi_max(jl) 238 END DO 239 240 IF(lwp) WRITE(numout,*) ' Thickness category boundaries independently of ice type ' 204 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 241 205 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 242 206 243 IF(lwp) WRITE(numout,*) ' Thickness category boundaries inside ice types '244 IF(lwp) THEN245 DO jm = 1, jpm246 WRITE(numout,*) ' Type number ', jm247 WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm)248 END DO249 ENDIF250 207 ! 251 208 DO jl = 1, jpl -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4831 r4869 692 692 693 693 IF( partfun_swi == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 694 DO jl = 0, ice_cat_bounds(1,2) ! only undeformed ice participates694 DO jl = 0, jpl 695 695 DO jj = 1, jpj 696 696 DO ji = 1, jpi … … 715 715 Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 716 716 END DO !jl 717 DO jl = 0, ice_cat_bounds(1,2)717 DO jl = 0, jpl 718 718 athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 719 719 END DO … … 1193 1193 !------------------------------------------------------------------------------- 1194 1194 ! jl1 looping 1-jpl 1195 DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2)1195 DO jl2 = 1, jpl 1196 1196 ! over categories to which ridged ice is transferred 1197 1197 !CDIR NODEP … … 1238 1238 END DO ! jl2 (new ridges) 1239 1239 1240 DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2)1240 DO jl2 = 1, jpl 1241 1241 1242 1242 !CDIR NODEP -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4688 r4869 6 6 !! History : - ! (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 7 7 !! 3.0 ! 2005-12 (M. Vancoppenolle) adaptation to LIM-3 8 !! - ! 2006-06 (M. Vancoppenolle) adaptation to include salt, age and types8 !! - ! 2006-06 (M. Vancoppenolle) adaptation to include salt, age 9 9 !! - ! 2007-04 (M. Vancoppenolle) Mass conservation checked 10 10 !!---------------------------------------------------------------------- … … 66 66 INTEGER, INTENT(in) :: kt ! time step index 67 67 ! 68 INTEGER :: ji, jj, jk, jl, ja, jm, jbnd1, jbnd2 ! ice typesdummy loop index68 INTEGER :: ji, jj, jk, jl ! dummy loop index 69 69 ! 70 70 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b … … 86 86 ! Given thermodynamic growth rates, transport ice between 87 87 ! thickness categories. 88 DO jm = 1, jpm 89 jbnd1 = ice_cat_bounds(jm,1) 90 jbnd2 = ice_cat_bounds(jm,2) 91 IF( ice_ncat_types(jm) > 1 ) CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 92 END DO 88 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 93 89 ! 94 90 CALL lim_var_glo2eqv ! only for info … … 123 119 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 124 120 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 125 DO j a= 1, nlay_i121 DO jk = 1, nlay_i 126 122 CALL prt_ctl_info(' ') 127 CALL prt_ctl_info(' - Layer : ', ivar1=j a)123 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 128 124 CALL prt_ctl_info(' ~~~~~~~') 129 CALL prt_ctl(tab2d_1=t_i(:,:,j a,jl) , clinfo1= ' lim_itd_th : t_i : ')130 CALL prt_ctl(tab2d_1=e_i(:,:,j a,jl) , clinfo1= ' lim_itd_th : e_i : ')125 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 126 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 131 127 END DO 132 128 END DO … … 140 136 ! 141 137 142 SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp,kt )138 SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 143 139 !!------------------------------------------------------------------ 144 140 !! *** ROUTINE lim_itd_th_rem *** … … 153 149 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 154 150 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 155 INTEGER , INTENT (in) :: ntyp ! Number of the type used156 151 INTEGER , INTENT (in) :: kt ! Ocean time step 157 152 ! … … 218 213 WRITE(numout,*) ' klbnd : ', klbnd 219 214 WRITE(numout,*) ' kubnd : ', kubnd 220 WRITE(numout,*) ' ntyp : ', ntyp221 215 ENDIF 222 216 … … 321 315 DO jj = 1, jpj 322 316 DO ji = 1, jpi 323 zhb0(ji,jj) = hi_max _typ(0,ntyp) ! 0eme324 zhb1(ji,jj) = hi_max _typ(1,ntyp) ! 1er317 zhb0(ji,jj) = hi_max(0) ! 0eme 318 zhb1(ji,jj) = hi_max(1) ! 1er 325 319 326 320 zhbnew(ji,jj,klbnd-1) = 0._wp … … 382 376 ELSE ! if ice accretion 383 377 ! ji, a_i > epsi10; zdh0 > 0 384 IF ( ntyp .EQ. 1 )zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))378 zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 385 379 ! zhbnew was 0, and is shifted to the right to account for thin ice 386 380 ! growth in openwater (F0 = f1) 387 IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0388 ! in other types there is389 ! no open water growth (F0 = 0)390 381 ENDIF ! zdh0 391 382 … … 839 830 840 831 841 SUBROUTINE lim_itd_th_reb( klbnd, kubnd , ntyp)832 SUBROUTINE lim_itd_th_reb( klbnd, kubnd ) 842 833 !!------------------------------------------------------------------ 843 834 !! *** ROUTINE lim_itd_th_reb *** … … 849 840 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 850 841 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 851 INTEGER , INTENT (in) :: ntyp ! number of the ice type involved in the rebinning process852 842 ! 853 843 INTEGER :: ji,jj, jl ! dummy loop indices … … 889 879 890 880 !------------------------------------------------------------------------------ 891 ! 2) Make sure thickness of cat klbnd is at least hi_max _typ(klbnd)881 ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd) 892 882 !------------------------------------------------------------------------------ 893 883 DO jj = 1, jpj 894 884 DO ji = 1, jpi 895 885 IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 896 IF( ht_i(ji,jj,klbnd) <= hi_max _typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN897 a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max _typ(0,ntyp)898 ht_i(ji,jj,klbnd) = hi_max _typ(0,ntyp)886 IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN 887 a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max(0) 888 ht_i(ji,jj,klbnd) = hi_max(0) 899 889 ENDIF 900 890 ENDIF -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4867 r4869 74 74 !! update ht_s_b, ht_i_b and tbif_1d(:,:) 75 75 !!------------------------------------------------------------------------ 76 INTEGER :: ji,jj,jk,jl ,jm! dummy loop indices76 INTEGER :: ji,jj,jk,jl ! dummy loop indices 77 77 INTEGER :: layer, nbpac ! local integers 78 INTEGER :: ii, ij, iter ! - -78 INTEGER :: ii, ij, iter ! - - 79 79 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde ! local scalars 80 80 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new ! - - … … 102 102 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget 103 103 REAL(wp), POINTER, DIMENSION(:) :: zat_i_1d ! total ice fraction 104 REAL(wp), POINTER, DIMENSION(:) :: zat_i_lev ! total ice fraction for level ice only (type 1)105 104 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom 106 105 REAL(wp), POINTER, DIMENSION(:) :: zvrel_1d ! relative ice / frazil velocity (1D vector) … … 120 119 CALL wrk_alloc( jpij, jcat ) ! integer 121 120 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 122 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, z at_i_lev, zv_frazb, zvrel_1d )121 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 123 122 CALL wrk_alloc( jpij,jpl, zv_old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 124 123 CALL wrk_alloc( jpij,jkmax,jpl, ze_i_1d ) … … 541 540 CALL wrk_dealloc( jpij, jcat ) ! integer 542 541 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 543 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, z at_i_lev, zv_frazb, zvrel_1d )542 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 544 543 CALL wrk_dealloc( jpij,jpl, zv_old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 545 544 CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_1d ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r4688 r4869 69 69 !! 70 70 !!--------------------------------------------------------------------- 71 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 72 INTEGER :: jbnd1, jbnd2 71 INTEGER :: ji, jj, jk, jl ! dummy loop indices 73 72 INTEGER :: i_ice_switch 74 73 REAL(wp) :: zsal … … 93 92 ! Rebin categories with thickness out of bounds 94 93 !---------------------------------------------------- 95 DO jm = 1, jpm 96 jbnd1 = ice_cat_bounds(jm,1) 97 jbnd2 = ice_cat_bounds(jm,2) 98 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 99 END DO 94 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 100 95 101 96 at_i(:,:) = 0._wp … … 126 121 ! Final thickness distribution rebinning 127 122 ! -------------------------------------- 128 DO jm = 1, jpm 129 jbnd1 = ice_cat_bounds(jm,1) 130 jbnd2 = ice_cat_bounds(jm,2) 131 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 132 IF (ice_ncat_types(jm) .EQ. 1 ) THEN 133 ENDIF 134 END DO 123 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 135 124 136 125 !----------------- -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r4765 r4869 67 67 !! 68 68 !!--------------------------------------------------------------------- 69 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 70 INTEGER :: jbnd1, jbnd2 69 INTEGER :: ji, jj, jk, jl ! dummy loop indices 71 70 INTEGER :: i_ice_switch 72 71 REAL(wp) :: zh, zsal … … 89 88 ! Rebin categories with thickness out of bounds 90 89 !---------------------------------------------------- 91 DO jm = 1, jpm 92 jbnd1 = ice_cat_bounds(jm,1) 93 jbnd2 = ice_cat_bounds(jm,2) 94 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 95 END DO 90 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 96 91 97 92 !---------------------------------------------------------------------- 98 93 ! Constrain the thickness of the smallest category above hiclim 99 94 !---------------------------------------------------------------------- 100 DO jm = 1, jpm 101 DO jj = 1, jpj 102 DO ji = 1, jpi 103 jl = ice_cat_bounds(jm,1) 104 IF( v_i(ji,jj,jl) > 0._wp .AND. ht_i(ji,jj,jl) < hiclim ) THEN 105 zh = hiclim / ht_i(ji,jj,jl) 106 ht_s(ji,jj,jl) = ht_s(ji,jj,jl) * zh 107 ht_i(ji,jj,jl) = ht_i(ji,jj,jl) * zh 108 a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 109 ENDIF 110 END DO !ji 111 END DO !jj 112 END DO !jm 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN 98 zh = hiclim / ht_i(ji,jj,1) 99 ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh 100 ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh 101 a_i (ji,jj,1) = a_i(ji,jj,1) / zh 102 ENDIF 103 END DO 104 END DO 113 105 114 106 !----------------------------------------------------- … … 139 131 ! Final thickness distribution rebinning 140 132 ! -------------------------------------- 141 DO jm = 1, jpm 142 jbnd1 = ice_cat_bounds(jm,1) 143 jbnd2 = ice_cat_bounds(jm,2) 144 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 145 IF (ice_ncat_types(jm) .EQ. 1 ) THEN 146 ENDIF 147 END DO 133 IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 148 134 149 135 !----------------- -
trunk/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
r4688 r4869 18 18 ! !!! ice mechanical redistribution 19 19 INTEGER, PUBLIC, PARAMETER :: jpl = 5 !: number of ice categories 20 INTEGER, PUBLIC, PARAMETER :: jpm = 1 !: number of ice types21 20 22 21 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.