Changeset 8373
- Timestamp:
- 2017-07-25T19:44:54+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 18 edited
-
albedoice.F90 (modified) (5 diffs)
-
icestp.F90 (modified) (8 diffs)
-
limadv_prather.F90 (modified) (4 diffs)
-
limadv_umx.F90 (modified) (10 diffs)
-
limistate.F90 (modified) (2 diffs)
-
limitd_me.F90 (modified) (9 diffs)
-
limmp.F90 (modified) (2 diffs)
-
limrhg.F90 (modified) (2 diffs)
-
limrst.F90 (modified) (5 diffs)
-
limthd.F90 (modified) (2 diffs)
-
limthd_dh.F90 (modified) (9 diffs)
-
limthd_dif.F90 (modified) (3 diffs)
-
limthd_ent.F90 (modified) (2 diffs)
-
limthd_lac.F90 (modified) (4 diffs)
-
limtrp.F90 (modified) (4 diffs)
-
limupdate2.F90 (modified) (1 diff)
-
limvar.F90 (modified) (6 diffs)
-
limwri.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/albedoice.F90
r8321 r8373 10 10 !! albedo_init : initialisation of albedo computation 11 11 !!---------------------------------------------------------------------- 12 USE ice, ONLY : jpl 12 13 USE phycst ! physical constants 13 14 USE in_out_manager ! I/O manager … … 82 83 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pa_ice_cs ! albedo of ice under clear sky 83 84 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pa_ice_os ! albedo of ice under overcast sky 84 ! !85 ! 85 86 INTEGER :: ji, jj, jl ! dummy loop indices 86 INTEGER :: ijpl ! number of ice categories (3rd dim of ice input arrays)87 REAL(wp) :: zswitch, z1_c1, z1_c288 REAL(wp) :: zhref_pnd89 REAL(wp) :: zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalb_it ! intermediate variable & albedo of ice (snow free)87 REAL(wp) :: zswitch, z1_c1, z1_c2 88 REAL(wp) :: zhref_pnd 89 REAL(wp) :: zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total 90 ! 91 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb, zalb_it ! intermediate variable & albedo of ice (snow free) 91 92 !! MV MP 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_pnd ! ponded sea ice albedo93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! bare sea ice albedo94 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_snw ! snow-covered sea ice albedo95 REAL(wp), POINTER, DIMENSION(:,:,:) :: zafrac_snw ! relative snow fraction96 REAL(wp), POINTER, DIMENSION(:,:,:) :: zafrac_ice ! relative ice fraction97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zafrac_pnd ! relative ice fraction (effective)93 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_pnd ! ponded sea ice albedo 94 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_ice ! bare sea ice albedo 95 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_snw ! snow-covered sea ice albedo 96 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zafrac_snw ! relative snow fraction 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zafrac_ice ! relative ice fraction 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zafrac_pnd ! relative ice fraction (effective) 98 99 !! 99 100 !!--------------------------------------------------------------------- 100 101 ijpl = SIZE( pt_ice, 3 ) ! number of ice categories102 103 CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it )104 CALL wrk_alloc( jpi,jpj,ijpl, zalb_pnd, zalb_ice, zalb_snw )105 CALL wrk_alloc( jpi,jpj,ijpl, zalb_pnd, zafrac_snw, zafrac_ice, zafrac_pnd )106 101 107 102 IF( albd_init == 0 ) CALL albedo_init ! initialization … … 148 143 ENDIF 149 144 150 DO jl = 1, ijpl145 DO jl = 1, jpl 151 146 DO jj = 1, jpj 152 147 DO ji = 1, jpi … … 224 219 225 220 ! Overcast sky surface albedo (accounting for snow, ice melt ponds) 226 DO jl = 1, ijpl221 DO jl = 1, jpl 227 222 DO jj = 1, jpj 228 223 DO ji = 1, jpi … … 309 304 310 305 END SELECT 311 312 CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it )313 CALL wrk_dealloc( jpi,jpj,ijpl, zalb_pnd, zalb_ice, zalb_snw )314 CALL wrk_dealloc( jpi,jpj,ijpl, zalb_pnd, zafrac_snw, zafrac_ice, zafrac_pnd )315 306 ! 316 307 END SUBROUTINE albedo_ice -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90
r8360 r8373 113 113 !! 114 114 INTEGER :: jl ! dummy loop index 115 REAL(wp), POINTER, DIMENSION(:,:,:):: zalb_os, zalb_cs ! ice albedo under overcast/clear sky116 REAL(wp), POINTER, DIMENSION(:,: ):: zutau_ice, zvtau_ice115 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 116 REAL(wp), DIMENSION(jpi,jpj) :: zutau_ice, zvtau_ice 117 117 !!---------------------------------------------------------------------- 118 118 … … 158 158 159 159 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 160 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice)161 160 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 162 161 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 163 162 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 164 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice)165 163 ENDIF 166 164 … … 209 207 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 210 208 !---------------------------------------------------------------------------------------- 211 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs )212 209 213 210 CALL albedo_ice( t_su, ht_i, ht_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos MV MP 2016 … … 227 224 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 228 225 END SELECT 229 230 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs )231 226 232 227 !----------------------------! … … 520 515 INTEGER :: jl ! dummy loop index 521 516 ! 522 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m ! Mean albedo over all categories523 REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m ! Mean temperature over all categories524 ! 525 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories526 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories527 REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m ! Mean sublimation over all categories528 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories529 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories517 REAL(wp), DIMENSION(jpi,jpj) :: zalb_m ! Mean albedo over all categories 518 REAL(wp), DIMENSION(jpi,jpj) :: ztem_m ! Mean temperature over all categories 519 ! 520 REAL(wp), DIMENSION(jpi,jpj) :: z_qsr_m ! Mean solar heat flux over all categories 521 REAL(wp), DIMENSION(jpi,jpj) :: z_qns_m ! Mean non solar heat flux over all categories 522 REAL(wp), DIMENSION(jpi,jpj) :: z_evap_m ! Mean sublimation over all categories 523 REAL(wp), DIMENSION(jpi,jpj) :: z_dqn_m ! Mean d(qns)/dT over all categories 524 REAL(wp), DIMENSION(jpi,jpj) :: z_devap_m ! Mean d(evap)/dT over all categories 530 525 !!---------------------------------------------------------------------- 531 526 ! … … 534 529 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! 535 530 CASE( 0 , 1 ) 536 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)537 531 ! 538 532 z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) … … 552 546 END DO 553 547 ! 554 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)555 548 END SELECT 556 549 ! 557 550 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==! 558 551 CASE( 1 , 2 ) 559 CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m )560 552 ! 561 553 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) … … 567 559 END DO 568 560 ! 569 CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m )570 561 END SELECT 571 562 ! -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90
r7646 r8373 65 65 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 66 66 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 67 REAL(wp), POINTER, DIMENSION(:,:) :: zf0 , zfx , zfy , zbet ! 2D workspace68 REAL(wp), POINTER, DIMENSION(:,:) :: zfm , zfxx , zfyy , zfxy ! - -69 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - -67 REAL(wp), DIMENSION(jpi,jpj) :: zf0 , zfx , zfy , zbet ! 2D workspace 68 REAL(wp), DIMENSION(jpi,jpj) :: zfm , zfxx , zfyy , zfxy ! - - 69 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 70 70 !--------------------------------------------------------------------- 71 72 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )73 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )74 71 75 72 ! Limitation of moments. … … 217 214 CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :') 218 215 ENDIF 219 !220 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )221 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )222 216 ! 223 217 END SUBROUTINE lim_adv_x … … 250 244 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 251 245 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 252 REAL(wp), POINTER, DIMENSION(:,:) :: zf0, zfx , zfy , zbet ! 2D workspace253 REAL(wp), POINTER, DIMENSION(:,:) :: zfm, zfxx, zfyy, zfxy ! - -254 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - -246 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace 247 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - - 248 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 255 249 !--------------------------------------------------------------------- 256 257 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )258 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )259 250 260 251 ! Limitation of moments. … … 404 395 ENDIF 405 396 ! 406 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )407 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )408 !409 397 END SUBROUTINE lim_adv_y 410 398 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
r8316 r8373 65 65 REAL(wp) :: zfp_ui, zfp_vj ! - - 66 66 REAL(wp) :: zfm_ui, zfm_vj ! - - 67 REAL(wp), POINTER, DIMENSION(:,:) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v67 REAL(wp), DIMENSION(jpi,jpj) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v 68 68 !!---------------------------------------------------------------------- 69 69 ! 70 70 IF( nn_timing == 1 ) CALL timing_start('lim_adv_umx') 71 !72 CALL wrk_alloc( jpi,jpj, zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )73 !74 71 ! 75 72 ! upstream advection with initial mass fluxes & intermediate update … … 145 142 CALL lbc_lnk( ptc(:,:) , 'T', 1. ) 146 143 ! 147 !148 CALL wrk_dealloc( jpi,jpj, zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )149 !150 144 IF( nn_timing == 1 ) CALL timing_stop('lim_adv_umx') 151 145 ! … … 174 168 INTEGER :: ji, jj ! dummy loop indices 175 169 REAL(wp) :: zc_box ! - - 176 REAL(wp), POINTER, DIMENSION(:,:) :: zzt170 REAL(wp), DIMENSION(jpi,jpj) :: zzt 177 171 !!---------------------------------------------------------------------- 178 172 ! 179 173 IF( nn_timing == 1 ) CALL timing_start('macho') 180 !181 CALL wrk_alloc( jpi,jpj, zzt )182 174 ! 183 175 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! … … 219 211 ENDIF 220 212 ! 221 CALL wrk_dealloc( jpi,jpj, zzt )222 !223 213 IF( nn_timing == 1 ) CALL timing_stop('macho') 224 214 ! … … 245 235 INTEGER :: ji, jj ! dummy loop indices 246 236 REAL(wp) :: zcu, zdx2, zdx4 ! - - 247 REAL(wp), POINTER, DIMENSION(:,:) :: ztu1, ztu2, ztu3, ztu4237 REAL(wp), DIMENSION(jpi,jpj) :: ztu1, ztu2, ztu3, ztu4 248 238 !!---------------------------------------------------------------------- 249 239 ! 250 240 IF( nn_timing == 1 ) CALL timing_start('ultimate_x') 251 !252 CALL wrk_alloc( jpi,jpj, ztu1, ztu2, ztu3, ztu4 )253 241 ! 254 242 ! !-- Laplacian in i-direction --! … … 346 334 END SELECT 347 335 ! 348 CALL wrk_dealloc( jpi,jpj, ztu1, ztu2, ztu3, ztu4 )349 !350 336 IF( nn_timing == 1 ) CALL timing_stop('ultimate_x') 351 337 ! … … 372 358 INTEGER :: ji, jj ! dummy loop indices 373 359 REAL(wp) :: zcv, zdy2, zdy4 ! - - 374 REAL(wp), POINTER, DIMENSION(:,:) :: ztv1, ztv2, ztv3, ztv4360 REAL(wp), DIMENSION(jpi,jpj) :: ztv1, ztv2, ztv3, ztv4 375 361 !!---------------------------------------------------------------------- 376 362 ! 377 363 IF( nn_timing == 1 ) CALL timing_start('ultimate_y') 378 !379 CALL wrk_alloc( jpi,jpj, ztv1, ztv2, ztv3, ztv4 )380 364 ! 381 365 ! !-- Laplacian in j-direction --! … … 474 458 END SELECT 475 459 ! 476 CALL wrk_dealloc( jpi,jpj, ztv1, ztv2, ztv3, ztv4 )477 !478 460 IF( nn_timing == 1 ) CALL timing_stop('ultimate_y') 479 461 ! … … 502 484 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zsml, z1_dt ! local scalars 503 485 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 504 REAL(wp), POINTER, DIMENSION(:,:) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv486 REAL(wp), DIMENSION(jpi,jpj) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv 505 487 !!---------------------------------------------------------------------- 506 488 ! 507 489 IF( nn_timing == 1 ) CALL timing_start('nonosc_2d') 508 !509 CALL wrk_alloc( jpi,jpj, zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )510 490 ! 511 491 zbig = 1.e+40_wp … … 578 558 CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 579 559 ! 580 CALL wrk_dealloc( jpi,jpj, zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )581 !582 560 IF( nn_timing == 1 ) CALL timing_stop('nonosc_2d') 583 561 ! -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r8316 r8373 83 83 INTEGER :: i_hemis, i_fill, jl0 84 84 REAL(wp) :: zarg, zV, zconv, zdv 85 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 86 REAL(wp), POINTER, DIMENSION(:,:) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 87 REAL(wp), POINTER, DIMENSION(:,:) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini !data by cattegories to fill 89 INTEGER , POINTER, DIMENSION(:) :: itest 90 !-------------------------------------------------------------------- 91 92 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 93 CALL wrk_alloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 94 CALL wrk_alloc( jpi, jpj, zswitch ) 95 Call wrk_alloc( 4, itest ) 85 REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator 86 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 87 REAL(wp), DIMENSION(jpi,jpj) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 88 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zh_i_ini, za_i_ini !data by cattegories to fill 89 INTEGER , DIMENSION(4) :: itest 90 !-------------------------------------------------------------------- 96 91 97 92 IF(lwp) WRITE(numout,*) … … 503 498 !!! 504 499 505 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini )506 CALL wrk_dealloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )507 CALL wrk_dealloc( jpi, jpj, zswitch )508 Call wrk_dealloc( 4, itest )509 510 500 END SUBROUTINE lim_istate 511 501 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r8341 r8373 110 110 REAL(wp) :: za, zfac ! local scalar 111 111 CHARACTER (len = 15) :: fieldid 112 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s)112 REAL(wp), DIMENSION(jpi,jpj) :: closing_net ! net rate at which area is removed (1/s) 113 113 ! (ridging ice area - area of new ridges) / dt 114 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s)115 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear116 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges114 REAL(wp), DIMENSION(jpi,jpj) :: divu_adv ! divu as implied by transport scheme (1/s) 115 REAL(wp), DIMENSION(jpi,jpj) :: opning ! rate of opening due to divergence/shear 116 REAL(wp), DIMENSION(jpi,jpj) :: closing_gross ! rate at which area removed, not counting area of new ridges 117 117 ! 118 118 INTEGER, PARAMETER :: nitermax = 20 … … 121 121 !!----------------------------------------------------------------------------- 122 122 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 123 124 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross )125 123 126 124 ! conservation test … … 288 286 ! control prints 289 287 IF( ln_ctl ) CALL lim_prt3D( 'limitd_me' ) 290 291 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross )292 288 ! 293 289 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 303 299 !! participating in ridging and of the resulting ridges. 304 300 !!---------------------------------------------------------------------! 305 INTEGER :: ji,jj, jl ! dummy loop indices301 INTEGER :: ji,jj, jl ! dummy loop indices 306 302 REAL(wp) :: Gstari, astari, hrmean, zdummy ! local scalar 307 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 308 !------------------------------------------------------------------------------! 309 310 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 303 REAL(wp), DIMENSION(jpi,jpj,-1:jpl) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 304 !------------------------------------------------------------------------------! 311 305 312 306 Gstari = 1.0/rn_gstar … … 477 471 END DO 478 472 ! 479 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )480 473 ! 481 474 END SUBROUTINE lim_itd_me_ridgeprep … … 502 495 REAL(wp) :: zwfx_snw ! snow mass flux increment 503 496 504 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices505 REAL(wp), POINTER, DIMENSION(:) :: zswitch, fvol ! new ridge volume going to n2506 507 REAL(wp), POINTER, DIMENSION(:) :: afrac ! fraction of category area ridged508 REAL(wp), POINTER, DIMENSION(:) :: ardg1 , ardg2 ! area of ice ridged & new ridges509 REAL(wp), POINTER, DIMENSION(:) :: vsrdg , esrdg ! snow volume & energy of ridging ice497 INTEGER , DIMENSION(jpij) :: indxi, indxj ! compressed indices 498 REAL(wp), DIMENSION(jpij) :: zswitch, fvol ! new ridge volume going to n2 499 500 REAL(wp), DIMENSION(jpij) :: afrac ! fraction of category area ridged 501 REAL(wp), DIMENSION(jpij) :: ardg1 , ardg2 ! area of ice ridged & new ridges 502 REAL(wp), DIMENSION(jpij) :: vsrdg , esrdg ! snow volume & energy of ridging ice 510 503 ! MV MP 2016 511 REAL(wp), POINTER, DIMENSION(:) :: vprdg ! pond volume of ridging ice512 REAL(wp), POINTER, DIMENSION(:) :: aprdg1 ! pond area of ridging ice513 REAL(wp), POINTER, DIMENSION(:) :: aprdg2 ! pond area of ridging ice504 REAL(wp), DIMENSION(jpij) :: vprdg ! pond volume of ridging ice 505 REAL(wp), DIMENSION(jpij) :: aprdg1 ! pond area of ridging ice 506 REAL(wp), DIMENSION(jpij) :: aprdg2 ! pond area of ridging ice 514 507 ! END MV MP 2016 515 REAL(wp), POINTER, DIMENSION(:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2516 517 REAL(wp), POINTER, DIMENSION(:) :: vrdg1 ! volume of ice ridged518 REAL(wp), POINTER, DIMENSION(:) :: vrdg2 ! volume of new ridges519 REAL(wp), POINTER, DIMENSION(:) :: vsw ! volume of seawater trapped into ridges520 REAL(wp), POINTER, DIMENSION(:) :: srdg1 ! sal*volume of ice ridged521 REAL(wp), POINTER, DIMENSION(:) :: srdg2 ! sal*volume of new ridges522 REAL(wp), POINTER, DIMENSION(:) :: smsw ! sal*volume of water trapped into ridges523 REAL(wp), POINTER, DIMENSION(:) :: oirdg1, oirdg2 ! ice age of ice ridged524 525 REAL(wp), POINTER, DIMENSION(:) :: afrft ! fraction of category area rafted526 REAL(wp), POINTER, DIMENSION(:) :: arft1 , arft2 ! area of ice rafted and new rafted zone527 REAL(wp), POINTER, DIMENSION(:) :: virft , vsrft ! ice & snow volume of rafting ice508 REAL(wp), DIMENSION(jpij) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 509 510 REAL(wp), DIMENSION(jpij) :: vrdg1 ! volume of ice ridged 511 REAL(wp), DIMENSION(jpij) :: vrdg2 ! volume of new ridges 512 REAL(wp), DIMENSION(jpij) :: vsw ! volume of seawater trapped into ridges 513 REAL(wp), DIMENSION(jpij) :: srdg1 ! sal*volume of ice ridged 514 REAL(wp), DIMENSION(jpij) :: srdg2 ! sal*volume of new ridges 515 REAL(wp), DIMENSION(jpij) :: smsw ! sal*volume of water trapped into ridges 516 REAL(wp), DIMENSION(jpij) :: oirdg1, oirdg2 ! ice age of ice ridged 517 518 REAL(wp), DIMENSION(jpij) :: afrft ! fraction of category area rafted 519 REAL(wp), DIMENSION(jpij) :: arft1 , arft2 ! area of ice rafted and new rafted zone 520 REAL(wp), DIMENSION(jpij) :: virft , vsrft ! ice & snow volume of rafting ice 528 521 ! MV MP 2016 529 REAL(wp), POINTER, DIMENSION(:) :: vprft ! pond volume of rafting ice530 REAL(wp), POINTER, DIMENSION(:) :: aprft1 ! pond area of rafted ice531 REAL(wp), POINTER, DIMENSION(:) :: aprft2 ! pond area of new rafted ice522 REAL(wp), DIMENSION(jpij) :: vprft ! pond volume of rafting ice 523 REAL(wp), DIMENSION(jpij) :: aprft1 ! pond area of rafted ice 524 REAL(wp), DIMENSION(jpij) :: aprft2 ! pond area of new rafted ice 532 525 ! END MV MP 2016 533 REAL(wp), POINTER, DIMENSION(:) :: esrft , smrft ! snow energy & salinity of rafting ice534 REAL(wp), POINTER, DIMENSION(:) :: oirft1, oirft2 ! ice age of ice rafted535 536 REAL(wp), POINTER, DIMENSION(:,:) :: eirft ! ice energy of rafting ice537 REAL(wp), POINTER, DIMENSION(:,:) :: erdg1 ! enth*volume of ice ridged538 REAL(wp), POINTER, DIMENSION(:,:) :: erdg2 ! enth*volume of new ridges539 REAL(wp), POINTER, DIMENSION(:,:) :: ersw ! enth of water trapped into ridges526 REAL(wp), DIMENSION(jpij) :: esrft , smrft ! snow energy & salinity of rafting ice 527 REAL(wp), DIMENSION(jpij) :: oirft1, oirft2 ! ice age of ice rafted 528 529 REAL(wp), DIMENSION(jpij,nlay_i) :: eirft ! ice energy of rafting ice 530 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg1 ! enth*volume of ice ridged 531 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg2 ! enth*volume of new ridges 532 REAL(wp), DIMENSION(jpij,nlay_i) :: ersw ! enth of water trapped into ridges 540 533 !!---------------------------------------------------------------------- 541 542 CALL wrk_alloc( jpij, indxi, indxj )543 CALL wrk_alloc( jpij, zswitch, fvol )544 ! MV MP 2016545 !CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )546 CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, vprdg, aprdg1, aprdg2, dhr, dhr2 )547 ! END MV MP 2016548 CALL wrk_alloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )549 ! MV MP 2016550 !CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )551 CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, aprft1, aprft2)552 CALL wrk_alloc ( jpij, vprft, smrft, oirft1, oirft2 )553 ! END MV MP 2016554 CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )555 534 556 535 !------------------------------------------------------------------------------- … … 794 773 ! SIMIP diagnostics 795 774 diag_dmi_dyn(:,:) = - wfx_dyn(:,:) + rhoic * diag_trp_vi(:,:) 796 diag_dms_dyn(:,:) = - wfx_snw_dyn(:,:) + rhosn * diag_trp_vs(:,:) 797 798 ! 799 CALL wrk_dealloc( jpij, indxi, indxj ) 800 CALL wrk_dealloc( jpij, zswitch, fvol ) 801 ! MV MP 2016 802 !CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 803 CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, vprdg, aprdg1, aprdg2, dhr, dhr2 ) 804 ! END MV MP 2016 805 CALL wrk_dealloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 806 ! MV MP 2016 807 !CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 808 CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, aprft1, aprft2, vprft ) 809 CALL wrk_dealloc( jpij, smrft, oirft1, oirft2 ) 810 CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 775 diag_dms_dyn(:,:) = - wfx_snw_dyn(:,:) + rhosn * diag_trp_vs(:,:) 811 776 ! 812 777 END SUBROUTINE lim_itd_me_ridgeshift … … 831 796 INTEGER :: numts_rm ! number of time steps for the P smoothing 832 797 REAL(wp) :: zp, z1_3 ! local scalars 833 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here834 REAL(wp), POINTER, DIMENSION(:,:) :: zstrp1, zstrp2 ! strength at previous time steps798 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 799 REAL(wp), DIMENSION(jpi,jpj) :: zstrp1, zstrp2 ! strength at previous time steps 835 800 !!---------------------------------------------------------------------- 836 837 CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 )838 801 839 802 !------------------------------------------------------------------------------! … … 966 929 967 930 ENDIF ! ksmooth 968 969 CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 )970 931 ! 971 932 END SUBROUTINE lim_itd_me_icestrength -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90
r8369 r8373 249 249 !!------------------------------------------------------------------- 250 250 251 INTEGER, POINTER, DIMENSION(:) :: indxi ! compressed indices for cells with ice melting 252 INTEGER, POINTER, DIMENSION(:) :: indxj ! 253 254 REAL(wp), POINTER, DIMENSION(:,:) :: zwfx_mlw ! available meltwater for melt ponding 255 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrfrac ! fraction of available meltwater retained for melt ponding 256 257 REAL(wp), PARAMETER :: zrmin = 0.15_wp ! minimum fraction of available meltwater retained for melt ponding 258 REAL(wp), PARAMETER :: zrmax = 0.70_wp ! maximum '' '' '' '' '' 259 REAL(wp), PARAMETER :: zrexp = 0.01_wp ! rate constant to refreeze melt ponds 260 REAL(wp), PARAMETER :: zpnd_aspect = 0.8_wp ! pond aspect ratio 261 262 REAL(wp) :: zhi ! dummy ice thickness 263 REAL(wp) :: zhs ! dummy snow depth 264 REAL(wp) :: zTp ! reference temperature 265 REAL(wp) :: zdTs ! dummy temperature difference 266 REAL(wp) :: z1_rhofw ! inverse freshwater density 267 REAL(wp) :: z1_zpnd_aspect ! inverse pond aspect ratio 268 REAL(wp) :: zvpold ! dummy pond volume 269 270 INTEGER :: ji, jj, jl, ij ! loop indices 271 INTEGER :: icells ! size of dummy array 272 251 INTEGER, DIMENSION(jpij) :: indxi ! compressed indices for cells with ice melting 252 INTEGER, DIMENSION(jpij) :: indxj ! 253 254 REAL(wp), DIMENSION(jpi,jpj) :: zwfx_mlw ! available meltwater for melt ponding 255 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zrfrac ! fraction of available meltwater retained for melt ponding 256 257 REAL(wp), PARAMETER :: zrmin = 0.15_wp ! minimum fraction of available meltwater retained for melt ponding 258 REAL(wp), PARAMETER :: zrmax = 0.70_wp ! maximum '' '' '' '' '' 259 REAL(wp), PARAMETER :: zrexp = 0.01_wp ! rate constant to refreeze melt ponds 260 REAL(wp), PARAMETER :: zpnd_aspect = 0.8_wp ! pond aspect ratio 261 262 REAL(wp) :: zhi ! dummy ice thickness 263 REAL(wp) :: zhs ! dummy snow depth 264 REAL(wp) :: zTp ! reference temperature 265 REAL(wp) :: zdTs ! dummy temperature difference 266 REAL(wp) :: z1_rhofw ! inverse freshwater density 267 REAL(wp) :: z1_zpnd_aspect ! inverse pond aspect ratio 268 REAL(wp) :: zvpold ! dummy pond volume 269 270 INTEGER :: ji, jj, jl, ij ! loop indices 271 INTEGER :: icells ! size of dummy array 273 272 !!------------------------------------------------------------------- 274 275 CALL wrk_alloc( jpi*jpj, indxi, indxj)276 CALL wrk_alloc( jpi,jpj, zwfx_mlw )277 CALL wrk_alloc( jpi,jpj,jpl, zrfrac )278 279 273 z1_rhofw = 1. / rhofw 280 274 z1_zpnd_aspect = 1. / zpnd_aspect … … 390 384 391 385 ENDIF 392 393 CALL wrk_dealloc( jpi*jpj, indxi, indxj)394 CALL wrk_dealloc( jpi,jpj, zwfx_mlw )395 CALL wrk_dealloc( jpi,jpj,jpl, zrfrac )396 386 397 387 END SUBROUTINE lim_mp_cesm -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r8324 r8373 123 123 REAL(wp) :: zfac_x, zfac_y 124 124 125 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors126 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points127 ! 128 REAL(wp), POINTER, DIMENSION(:,:) :: zaU , zaV ! ice fraction on U/V points129 REAL(wp), POINTER, DIMENSION(:,:) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points130 REAL(wp), POINTER, DIMENSION(:,:) :: zmf ! coriolis parameter at T points131 REAL(wp), POINTER, DIMENSION(:,:) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points132 REAL(wp), POINTER, DIMENSION(:,:) :: zspgU , zspgV ! surface pressure gradient at U/V points133 REAL(wp), POINTER, DIMENSION(:,:) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points134 REAL(wp), POINTER, DIMENSION(:,:) :: zfU , zfV ! internal stresses125 REAL(wp), DIMENSION(jpi,jpj) :: z1_e1t0, z1_e2t0 ! scale factors 126 REAL(wp), DIMENSION(jpi,jpj) :: zp_delt ! P/delta at T points 127 ! 128 REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV ! ice fraction on U/V points 129 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points 130 REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points 131 REAL(wp), DIMENSION(jpi,jpj) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points 132 REAL(wp), DIMENSION(jpi,jpj) :: zspgU , zspgV ! surface pressure gradient at U/V points 133 REAL(wp), DIMENSION(jpi,jpj) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 134 REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses 135 135 136 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear137 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components138 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence139 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope:136 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear 137 REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components 138 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! check convergence 139 REAL(wp), DIMENSION(jpi,jpj) :: zpice ! array used for the calculation of ice surface slope: 140 140 ! ocean surface (ssh_m) if ice is not embedded 141 141 ! ice top surface if ice is embedded 142 REAL(wp), POINTER, DIMENSION(:,:) :: zCorx, zCory ! Coriolis stress array143 REAL(wp), POINTER, DIMENSION(:,:) :: ztaux_oi, ztauy_oi ! Ocean-to-ice stress array144 145 REAL(wp), POINTER, DIMENSION(:,:) :: zswitchU, zswitchV ! dummy arrays146 REAL(wp), POINTER, DIMENSION(:,:) :: zmaskU, zmaskV ! mask for ice presence147 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask, zwf ! mask at F points for the ice148 149 REAL(wp), PARAMETER 150 REAL(wp), PARAMETER 142 REAL(wp), DIMENSION(jpi,jpj) :: zCorx, zCory ! Coriolis stress array 143 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_oi, ztauy_oi ! Ocean-to-ice stress array 144 145 REAL(wp), DIMENSION(jpi,jpj) :: zswitchU, zswitchV ! dummy arrays 146 REAL(wp), DIMENSION(jpi,jpj) :: zmaskU, zmaskV ! mask for ice presence 147 REAL(wp), DIMENSION(jpi,jpj) :: zfmask, zwf ! mask at F points for the ice 148 149 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 150 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity equals ocean velocity 151 151 !!------------------------------------------------------------------- 152 153 CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )154 CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )155 CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )156 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )157 CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )158 CALL wrk_alloc( jpi,jpj, zCorx, zCory)159 CALL wrk_alloc( jpi,jpj, ztaux_oi, ztauy_oi)160 152 161 153 #if defined key_agrif … … 762 754 ENDIF 763 755 ENDIF 764 ! 765 766 CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt ) 767 CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 768 CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 769 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 770 CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 771 CALL wrk_dealloc( jpi,jpj, zCorx, zCory ) 772 CALL wrk_dealloc( jpi,jpj, ztaux_oi, ztauy_oi ) 773 756 ! 774 757 END SUBROUTINE lim_rhg 775 758 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r8324 r8373 106 106 CHARACTER(len=25) :: znam 107 107 CHARACTER(len=2) :: zchar, zchar1 108 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 109 !!---------------------------------------------------------------------- 110 111 CALL wrk_alloc( jpi, jpj, z2d ) 108 REAL(wp), DIMENSION(jpi,jpj) :: z2d 109 !!---------------------------------------------------------------------- 112 110 113 111 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 … … 355 353 ENDIF 356 354 ! 357 CALL wrk_dealloc( jpi, jpj, z2d )358 355 ! 359 356 END SUBROUTINE lim_rst_write … … 366 363 !! ** purpose : read of sea-ice variable restart in a netcdf file 367 364 !!---------------------------------------------------------------------- 368 INTEGER :: ji, jj, jk, jl369 REAL(wp) :: 370 REAL(wp), POINTER, DIMENSION(:,:) :: z2d365 INTEGER :: ji, jj, jk, jl 366 REAL(wp) :: zfice, ziter 367 REAL(wp), DIMENSION(jpi,jpj) :: z2d 371 368 CHARACTER(len=25) :: znam 372 369 CHARACTER(len=2) :: zchar, zchar1 … … 374 371 LOGICAL :: llok 375 372 !!---------------------------------------------------------------------- 376 377 CALL wrk_alloc( jpi, jpj, z2d )378 373 379 374 IF(lwp) THEN … … 638 633 !CALL iom_close( numrir ) !clem: closed in icestp.F90 639 634 ! 640 CALL wrk_dealloc( jpi, jpj, z2d )641 !642 635 END SUBROUTINE lim_rst_read 643 636 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r8371 r8373 87 87 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 88 88 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 89 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)89 REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 90 90 ! 91 91 !!------------------------------------------------------------------- 92 92 93 93 IF( nn_timing == 1 ) CALL timing_start('limthd') 94 95 CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric )96 94 97 95 IF( kt == nit000 .AND. lwp ) THEN … … 322 320 323 321 IF( ln_ctl ) CALL lim_prt3D( 'limthd' ) ! Control print 324 !325 CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric )326 322 ! 327 323 IF( nn_timing == 1 ) CALL timing_stop('limthd') -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r8370 r8373 85 85 REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean 86 86 87 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3)88 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2)89 REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2)90 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2)91 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2)92 REAL(wp), POINTER, DIMENSION(:) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2)93 94 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt95 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre ! snow precipitation96 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_sub ! snow sublimation97 98 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah99 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness100 INTEGER , POINTER, DIMENSION(:,:) :: icount ! number of layers vanished by melting101 102 REAL(wp), POINTER, DIMENSION(:) :: zeh_i ! total ice heat content (J.m-2)103 REAL(wp), POINTER, DIMENSION(:) :: zsnw ! distribution of snow after wind blowing87 REAL(wp), DIMENSION(jpij) :: zqprec ! energy of fallen snow (J.m-3) 88 REAL(wp), DIMENSION(jpij) :: zq_su ! heat for surface ablation (J.m-2) 89 REAL(wp), DIMENSION(jpij) :: zq_bo ! heat for bottom ablation (J.m-2) 90 REAL(wp), DIMENSION(jpij) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 91 REAL(wp), DIMENSION(jpij) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 92 REAL(wp), DIMENSION(jpij) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2) 93 94 REAL(wp), DIMENSION(jpij) :: zdh_s_mel ! snow melt 95 REAL(wp), DIMENSION(jpij) :: zdh_s_pre ! snow precipitation 96 REAL(wp), DIMENSION(jpij) :: zdh_s_sub ! snow sublimation 97 98 REAL(wp), DIMENSION(jpij,nlay_i) :: zdeltah 99 REAL(wp), DIMENSION(jpij,nlay_i) :: zh_i ! ice layer thickness 100 INTEGER , DIMENSION(jpij,nlay_i) :: icount ! number of layers vanished by melting 101 102 REAL(wp), DIMENSION(jpij) :: zeh_i ! total ice heat content (J.m-2) 103 REAL(wp), DIMENSION(jpij) :: zsnw ! distribution of snow after wind blowing 104 104 105 105 REAL(wp) :: zswitch_sal … … 107 107 ! Heat conservation 108 108 INTEGER :: num_iter_max 109 110 109 !!------------------------------------------------------------------ 111 110 112 111 ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 113 112 SELECT CASE( nn_icesal ) ! varying salinity or not 114 CASE( 1, 3 ) ; zswitch_sal = 0 115 CASE( 2 ) ; zswitch_sal = 1 113 CASE( 1, 3 ) ; zswitch_sal = 0._wp ! prescribed salinity profile 114 CASE( 2 ) ; zswitch_sal = 1._wp ! varying salinity profile 116 115 END SELECT 117 116 118 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema ) 119 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zeh_i ) 120 CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 121 CALL wrk_alloc( jpij, nlay_i, icount ) 122 123 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp 124 zq_rema (:) = 0._wp ; zsnw (:) = 0._wp ; zevap_rema(:) = 0._wp ; 125 zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zeh_i(:) = 0._wp 126 127 zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp 128 icount (:,:) = 0 129 130 ! Initialize enthalpy at nlay_i+1 131 DO ji = 1, nidx 132 e_i_1d(ji,nlay_i+1) = 0._wp 117 DO ji = 1, nidx 118 icount (ji,:) = 0 119 zdh_s_mel(ji) = 0._wp 120 e_i_1d(ji,nlay_i+1) = 0._wp ! Initialize enthalpy at nlay_i+1 133 121 END DO 134 122 135 123 ! initialize layer thicknesses and enthalpies 136 h_i_old ( :,0:nlay_i+1) = 0._wp137 eh_i_old( :,0:nlay_i+1) = 0._wp124 h_i_old (1:nidx,0:nlay_i+1) = 0._wp 125 eh_i_old(1:nidx,0:nlay_i+1) = 0._wp 138 126 DO jk = 1, nlay_i 139 127 DO ji = 1, nidx … … 204 192 CALL lim_thd_snwblow( 1. - at_i_1d(1:nidx), zsnw(1:nidx) ) ! snow distribution over ice after wind blowing 205 193 206 zdeltah( :,:) = 0._wp194 zdeltah(1:nidx,:) = 0._wp 207 195 DO ji = 1, nidx 208 196 !----------- … … 239 227 240 228 ! If heat still available (zq_su > 0), then melt more snow 241 zdeltah( :,:) = 0._wp229 zdeltah(1:nidx,:) = 0._wp 242 230 DO jk = 1, nlay_s 243 231 DO ji = 1, nidx … … 263 251 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 264 252 ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 265 zdeltah( :,:) = 0._wp253 zdeltah(1:nidx,:) = 0._wp 266 254 DO ji = 1, nidx 267 255 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) … … 303 291 ! 3.4 Surface ice ablation 304 292 !-------------------------- 305 zdeltah( :,:) = 0._wp ! important293 zdeltah(1:nidx,:) = 0._wp ! important 306 294 DO jk = 1, nlay_i 307 295 DO ji = 1, nidx … … 498 486 ! 4.2 Basal melt 499 487 !---------------- 500 zdeltah( :,:) = 0._wp ! important488 zdeltah(1:nidx,:) = 0._wp ! important 501 489 DO jk = nlay_i, 1, -1 502 490 DO ji = 1, nidx … … 583 571 ! If heat still available for melting and snow remains, then melt more snow 584 572 !------------------------------------------- 585 zdeltah( :,:) = 0._wp ! important573 zdeltah(1:nidx,:) = 0._wp ! important 586 574 DO ji = 1, nidx 587 575 zq_rema(ji) = zq_su(ji) + zq_bo(ji) … … 668 656 DO ji = 1, nidx 669 657 IF( ht_i_1d(ji) == 0._wp ) a_i_1d(ji) = 0._wp 670 END DO 671 672 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema ) 673 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zeh_i ) 674 CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 675 CALL wrk_dealloc( jpij, nlay_i, icount ) 676 ! 658 END DO 677 659 ! 678 660 END SUBROUTINE lim_thd_dh -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r8369 r8373 95 95 INTEGER :: iconv_max = 50 ! max number of iterations in iterative procedure 96 96 97 INTEGER, POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation98 INTEGER, POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation97 INTEGER, DIMENSION(jpij) :: numeqmin ! reference number of top equation 98 INTEGER, DIMENSION(jpij) :: numeqmax ! reference number of bottom equation 99 99 100 100 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system … … 110 110 REAL(wp) :: zdti_bnd = 1.e-4_wp ! maximal authorized error on temperature 111 111 112 REAL(wp), POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow113 REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure )114 REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration115 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness116 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness117 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface118 REAL(wp), POINTER, DIMENSION(:) :: zqns_ice_b ! solar radiation absorbed at the surface119 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function120 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function121 REAL(wp), POINTER, DIMENSION(:) :: zdti ! current error on temperature122 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4)123 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice124 REAL(wp), POINTER, DIMENSION(:) :: zihic112 REAL(wp), DIMENSION(jpij) :: isnow ! switch for presence (1) or absence (0) of snow 113 REAL(wp), DIMENSION(jpij) :: ztsub ! old surface temperature (before the iterative procedure ) 114 REAL(wp), DIMENSION(jpij) :: ztsubit ! surface temperature at previous iteration 115 REAL(wp), DIMENSION(jpij) :: zh_i ! ice layer thickness 116 REAL(wp), DIMENSION(jpij) :: zh_s ! snow layer thickness 117 REAL(wp), DIMENSION(jpij) :: zfsw ! solar radiation absorbed at the surface 118 REAL(wp), DIMENSION(jpij) :: zqns_ice_b ! solar radiation absorbed at the surface 119 REAL(wp), DIMENSION(jpij) :: zf ! surface flux function 120 REAL(wp), DIMENSION(jpij) :: dzf ! derivative of the surface flux function 121 REAL(wp), DIMENSION(jpij) :: zdti ! current error on temperature 122 REAL(wp), DIMENSION(jpij) :: zdifcase ! case of the equation resolution (1->4) 123 REAL(wp), DIMENSION(jpij) :: zftrice ! solar radiation transmitted through the ice 124 REAL(wp), DIMENSION(jpij) :: zihic 125 125 126 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity 127 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice 128 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice 129 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice 130 REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice 131 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice 132 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence 133 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat 134 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice 135 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow 136 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow 137 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow 138 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow 139 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence 140 REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow 141 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow 142 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! 'Ind'ependent term 143 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! Temporary 'ind'ependent term 144 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis ! Temporary 'dia'gonal term 145 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! Tridiagonal system terms 146 147 ! diag errors on heat 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 126 REAL(wp), DIMENSION(jpij,0:nlay_i) :: ztcond_i ! Ice thermal conductivity 127 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zradtr_i ! Radiation transmitted through the ice 128 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zradab_i ! Radiation absorbed in the ice 129 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zkappa_i ! Kappa factor in the ice 130 REAL(wp), DIMENSION(jpij,0:nlay_i) :: ztib ! Old temperature in the ice 131 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zeta_i ! Eta factor in the ice 132 REAL(wp), DIMENSION(jpij,0:nlay_i) :: ztitemp ! Temporary temperature in the ice to check the convergence 133 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zspeche_i ! Ice specific heat 134 REAL(wp), DIMENSION(jpij,0:nlay_i) :: z_i ! Vertical cotes of the layers in the ice 135 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zradtr_s ! Radiation transmited through the snow 136 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zradab_s ! Radiation absorbed in the snow 137 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zkappa_s ! Kappa factor in the snow 138 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zeta_s ! Eta factor in the snow 139 REAL(wp), DIMENSION(jpij,0:nlay_s) :: ztstemp ! Temporary temperature in the snow to check the convergence 140 REAL(wp), DIMENSION(jpij,0:nlay_s) :: ztsb ! Temporary temperature in the snow 141 REAL(wp), DIMENSION(jpij,0:nlay_s) :: z_s ! Vertical cotes of the layers in the snow 142 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindterm ! 'Ind'ependent term 143 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindtbis ! Temporary 'ind'ependent term 144 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zdiagbis ! Temporary 'dia'gonal term 145 REAL(wp), DIMENSION(jpij,nlay_i+3,3) :: ztrid ! Tridiagonal system terms 146 REAL(wp), DIMENSION(jpij) :: zdq, zq_ini, zhfx_err ! diag errors on heat 147 REAL(wp), DIMENSION(jpij) :: zghe ! G(he), th. conduct enhancement factor, mono-cat 149 148 150 149 ! Mono-category 151 REAL(wp) :: zepsilon ! determines thres. above which computation of G(h) is done 152 REAL(wp) :: zratio_s ! dummy factor 153 REAL(wp) :: zratio_i ! dummy factor 154 REAL(wp) :: zh_thres ! thickness thres. for G(h) computation 155 REAL(wp) :: zhe ! dummy factor 156 REAL(wp) :: zkimean ! mean sea ice thermal conductivity 157 REAL(wp) :: zfac ! dummy factor 158 REAL(wp) :: zihe ! dummy factor 159 REAL(wp) :: zheshth ! dummy factor 160 161 REAL(wp), POINTER, DIMENSION(:) :: zghe ! G(he), th. conduct enhancement factor, mono-cat 162 150 REAL(wp) :: zepsilon ! determines thres. above which computation of G(h) is done 151 REAL(wp) :: zratio_s ! dummy factor 152 REAL(wp) :: zratio_i ! dummy factor 153 REAL(wp) :: zh_thres ! thickness thres. for G(h) computation 154 REAL(wp) :: zhe ! dummy factor 155 REAL(wp) :: zkimean ! mean sea ice thermal conductivity 156 REAL(wp) :: zfac ! dummy factor 157 REAL(wp) :: zihe ! dummy factor 158 REAL(wp) :: zheshth ! dummy factor 163 159 !!------------------------------------------------------------------ 164 !165 CALL wrk_alloc( jpij, numeqmin, numeqmax )166 CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )167 CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zdti, zdifcase, zftrice, zihic, zghe )168 CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )169 CALL wrk_alloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )170 CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )171 CALL wrk_alloc( jpij,nlay_i+3,3, ztrid )172 173 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err )174 160 175 161 ! --- diag error on heat diffusion - PART 1 --- ! … … 808 794 END DO 809 795 ! 810 CALL wrk_dealloc( jpij, numeqmin, numeqmax )811 CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )812 CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zdti, zdifcase, zftrice, zihic, zghe )813 CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )814 CALL wrk_dealloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )815 CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )816 CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )817 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )818 819 796 END SUBROUTINE lim_thd_dif 820 797 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r8342 r8373 73 73 INTEGER :: jk0, jk1 ! old/new layer indices 74 74 ! 75 REAL(wp), POINTER, DIMENSION(:,:) :: zeh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces76 REAL(wp), POINTER, DIMENSION(:,:):: zeh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces77 REAL(wp), POINTER, DIMENSION(:):: zhnew ! new layers thicknesses75 REAL(wp), DIMENSION(jpij,0:nlay_i+2) :: zeh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces 76 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zeh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces 77 REAL(wp), DIMENSION(jpij) :: zhnew ! new layers thicknesses 78 78 !!------------------------------------------------------------------- 79 80 CALL wrk_alloc( jpij, nlay_i+3, zeh_cum0, zh_cum0, kjstart = 0 )81 CALL wrk_alloc( jpij, nlay_i+1, zeh_cum1, zh_cum1, kjstart = 0 )82 CALL wrk_alloc( jpij, zhnew )83 79 84 80 !-------------------------------------------------------------------------- … … 142 138 END DO 143 139 144 !145 CALL wrk_dealloc( jpij, nlay_i+3, zeh_cum0, zh_cum0, kjstart = 0 )146 CALL wrk_dealloc( jpij, nlay_i+1, zeh_cum1, zh_cum1, kjstart = 0 )147 CALL wrk_dealloc( jpij, zhnew )148 !149 140 END SUBROUTINE lim_thd_ent 150 141 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r8342 r8373 83 83 REAL(wp) :: zv_newfra 84 84 85 INTEGER , POINTER, DIMENSION(:) :: jcat ! indexes of categories where new ice grows86 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not87 88 REAL(wp), POINTER, DIMENSION(:) :: zv_newice ! volume of accreted ice89 REAL(wp), POINTER, DIMENSION(:) :: za_newice ! fractional area of accreted ice90 REAL(wp), POINTER, DIMENSION(:) :: zh_newice ! thickness of accreted ice91 REAL(wp), POINTER, DIMENSION(:) :: ze_newice ! heat content of accreted ice92 REAL(wp), POINTER, DIMENSION(:) :: zs_newice ! salinity of accreted ice93 REAL(wp), POINTER, DIMENSION(:) :: zo_newice ! age of accreted ice94 REAL(wp), POINTER, DIMENSION(:) :: zdv_res ! residual volume in case of excessive heat budget95 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget96 REAL(wp), POINTER, DIMENSION(:) :: zat_i_1d ! total ice fraction97 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom98 REAL(wp), POINTER, DIMENSION(:) :: zvrel_1d ! relative ice / frazil velocity (1D vector)99 100 REAL(wp), POINTER, DIMENSION(:,:) :: zv_b ! old volume of ice in category jl101 REAL(wp), POINTER, DIMENSION(:,:) :: za_b ! old area of ice in category jl102 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i103 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i104 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i105 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d !: 1-D version of e_i107 108 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity85 INTEGER , DIMENSION(jpij) :: jcat ! indexes of categories where new ice grows 86 REAL(wp), DIMENSION(jpij) :: zswinew ! switch for new ice or not 87 88 REAL(wp), DIMENSION(jpij) :: zv_newice ! volume of accreted ice 89 REAL(wp), DIMENSION(jpij) :: za_newice ! fractional area of accreted ice 90 REAL(wp), DIMENSION(jpij) :: zh_newice ! thickness of accreted ice 91 REAL(wp), DIMENSION(jpij) :: ze_newice ! heat content of accreted ice 92 REAL(wp), DIMENSION(jpij) :: zs_newice ! salinity of accreted ice 93 REAL(wp), DIMENSION(jpij) :: zo_newice ! age of accreted ice 94 REAL(wp), DIMENSION(jpij) :: zdv_res ! residual volume in case of excessive heat budget 95 REAL(wp), DIMENSION(jpij) :: zda_res ! residual area in case of excessive heat budget 96 REAL(wp), DIMENSION(jpij) :: zat_i_1d ! total ice fraction 97 REAL(wp), DIMENSION(jpij) :: zv_frazb ! accretion of frazil ice at the ice bottom 98 REAL(wp), DIMENSION(jpij) :: zvrel_1d ! relative ice / frazil velocity (1D vector) 99 100 REAL(wp), DIMENSION(jpij,jpl) :: zv_b ! old volume of ice in category jl 101 REAL(wp), DIMENSION(jpij,jpl) :: za_b ! old area of ice in category jl 102 REAL(wp), DIMENSION(jpij,jpl) :: za_i_1d ! 1-D version of a_i 103 REAL(wp), DIMENSION(jpij,jpl) :: zv_i_1d ! 1-D version of v_i 104 REAL(wp), DIMENSION(jpij,jpl) :: zsmv_i_1d ! 1-D version of smv_i 105 106 REAL(wp), DIMENSION(jpij,nlay_i,jpl) :: ze_i_1d !: 1-D version of e_i 107 108 REAL(wp), DIMENSION(jpi,jpj) :: zvrel ! relative ice / frazil velocity 109 109 110 110 REAL(wp) :: zcai = 1.4e-3_wp ! ice-air drag (clem: should be dependent on coupling/forcing used) 111 111 !!-----------------------------------------------------------------------! 112 113 CALL wrk_alloc( jpij, jcat ) ! integer114 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )115 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )116 CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )117 CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )118 CALL wrk_alloc( jpi,jpj, zvrel )119 112 120 113 CALL lim_var_agg(1) … … 211 204 END DO 212 205 ! 213 CALL lbc_lnk( zvrel, 'T', 1. ) 214 CALL lbc_lnk( hicol, 'T', 1. ) 206 CALL lbc_lnk_multi( zvrel, 'T', 1., hicol, 'T', 1. ) 215 207 216 208 ENDIF ! End of computation of frazil ice collection thickness … … 234 226 END DO 235 227 236 ! debug point to follow237 jiindex_1d = 0238 IF( ln_limctl ) THEN239 DO ji = mi0(iiceprt), mi1(iiceprt)240 DO jj = mj0(jiceprt), mj1(jiceprt)241 IF ( qlead(ji,jj) < 0._wp ) THEN242 jiindex_1d = (jj - 1) * jpi + ji243 ENDIF244 END DO245 END DO246 ENDIF247 248 IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nidx = ', nidx249 250 228 !------------------------------ 251 229 ! Move from 2-D to 1-D vectors … … 497 475 ENDIF ! nidx > 0 498 476 ! 499 CALL wrk_dealloc( jpij, jcat ) ! integer500 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )501 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )502 CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )503 CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )504 CALL wrk_dealloc( jpi,jpj, zvrel )505 !506 477 END SUBROUTINE lim_thd_lac 507 478 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r8321 r8373 71 71 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 72 72 REAL(wp) :: zdv, zda 73 REAL(wp), POINTER, DIMENSION(:,:):: zatold, zeiold, zesold, zsmvold74 REAL(wp), POINTER, DIMENSION(:,:,:):: zhimax, zviold, zvsold73 REAL(wp), DIMENSION(jpi,jpj) :: zatold, zeiold, zesold, zsmvold 74 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhimax, zviold, zvsold 75 75 ! --- ultimate macho only --- ! 76 76 REAL(wp) :: zdt … … 88 88 !!--------------------------------------------------------------------- 89 89 IF( nn_timing == 1 ) CALL timing_start('limtrp') 90 91 CALL wrk_alloc( jpi,jpj, zatold, zeiold, zesold, zsmvold )92 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold )93 90 94 91 IF( kt == nit000 .AND. lwp ) THEN … … 134 131 END DO 135 132 END DO 136 CALL lbc_lnk(zhimax(:,:,jl),'T',1.)137 133 END DO 134 CALL lbc_lnk( zhimax(:,:,:), 'T', 1. ) 138 135 139 136 ! --- If ice drift field is too fast, use an appropriate time step for advection --- ! … … 523 520 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 524 521 ! 525 CALL wrk_dealloc( jpi,jpj, zatold, zeiold, zesold, zsmvold )526 CALL wrk_dealloc( jpi,jpj,jpl, zhimax, zviold, zvsold )527 !528 522 IF( nn_timing == 1 ) CALL timing_stop('limtrp') 529 523 ! -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r8355 r8373 141 141 END DO 142 142 !lateral boundary conditions 143 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 144 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 143 CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 145 144 !mask velocities 146 145 u_ice(:,:) = u_ice(:,:) * umask(:,:,1) -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r8360 r8373 302 302 REAL(wp) :: zfac0, zfac1, zsal 303 303 REAL(wp) :: zswi0, zswi01, zargtemp , zs_zero 304 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha304 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_slope_s, zalpha 305 305 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 306 306 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 307 307 !!------------------------------------------------------------------ 308 309 CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )310 308 311 309 !--------------------------------------- … … 391 389 ENDIF ! nn_icesal 392 390 ! 393 CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )394 !395 391 END SUBROUTINE lim_var_salprof 396 392 … … 444 440 REAL(wp) :: zalpha, zswi0, zswi01, zs_zero ! - - 445 441 ! 446 REAL(wp), POINTER, DIMENSION(:) :: z_slope_s442 REAL(wp), DIMENSION(jpij) :: z_slope_s 447 443 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 448 444 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 449 445 !!--------------------------------------------------------------------- 450 451 CALL wrk_alloc( jpij, z_slope_s )452 446 453 447 !--------------------------------------- … … 511 505 ENDIF 512 506 ! 513 CALL wrk_dealloc( jpij, z_slope_s )514 !515 507 END SUBROUTINE lim_var_salprof1d 516 508 … … 652 644 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables 653 645 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables 654 INTEGER , POINTER, DIMENSION(:):: itest646 INTEGER , DIMENSION(4) :: itest 655 647 656 CALL wrk_alloc( 4, itest )657 648 !-------------------------------------------------------------------- 658 649 ! initialisation of variables … … 777 768 ENDDO 778 769 ENDDO 779 780 CALL wrk_dealloc( 4, itest )781 770 ! 782 771 END SUBROUTINE lim_var_itd -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r8316 r8373 55 55 REAL(wp) :: z2da, z2db, ztmp, zrho1, zrho2, zmiss_val 56 56 REAL(wp) :: zs12, zshear 57 REAL(wp), POINTER, DIMENSION(:,:,:) :: zswi2, zmiss258 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, zswi, zmiss ! 2D workspace59 REAL(wp), POINTER, DIMENSION(:,:) :: zfb ! ice freeboard60 REAL(wp), POINTER, DIMENSION(:,:) :: zamask, zamask15 ! 15% concentration mask61 REAL(wp), POINTER, DIMENSION(:,:) :: zsig1, zsig2, zsig357 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zswi2, zmiss2 58 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zswi, zmiss ! 2D workspace 59 REAL(wp), DIMENSION(jpi,jpj) :: zfb ! ice freeboard 60 REAL(wp), DIMENSION(jpi,jpj) :: zamask, zamask15 ! 15% concentration mask 61 REAL(wp), DIMENSION(jpi,jpj) :: zsig1, zsig2, zsig3 62 62 63 63 ! Global ice diagnostics (SIMIP) … … 72 72 73 73 IF( nn_timing == 1 ) CALL timing_start('limwri') 74 75 CALL wrk_alloc( jpi,jpj, jpl, zswi2, zmiss2 )76 CALL wrk_alloc( jpi,jpj , z2d, zswi, zmiss )77 CALL wrk_alloc( jpi,jpj , zfb, zamask, zamask15 )78 CALL wrk_alloc( jpi,jpj , zsig1, zsig2, zsig3 )79 74 80 75 !---------------------------------------- … … 428 423 ! not yet implemented 429 424 430 CALL wrk_dealloc( jpi, jpj, jpl, zswi2, zmiss2 )431 CALL wrk_dealloc( jpi, jpj , z2d, zswi, zmiss )432 CALL wrk_dealloc( jpi, jpj , zfb, zamask, zamask15 )433 CALL wrk_dealloc( jpi, jpj , zsig1, zsig2, zsig3 )434 435 425 IF( nn_timing == 1 ) CALL timing_stop('limwri') 436 426
Note: See TracChangeset
for help on using the changeset viewer.
