New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8373 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2017-07-25T19:44:54+02:00 (7 years ago)
Author:
clem
Message:

remove most of wrk_alloc

Location:
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
Files:
18 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/albedoice.F90

    r8321 r8373  
    1010   !!   albedo_init   : initialisation of albedo computation 
    1111   !!---------------------------------------------------------------------- 
     12   USE ice, ONLY : jpl 
    1213   USE phycst         ! physical constants 
    1314   USE in_out_manager ! I/O manager 
     
    8283      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_cs           !  albedo of ice under clear    sky 
    8384      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os           !  albedo of ice under overcast sky 
    84       !! 
     85      ! 
    8586      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_c2 
    88       REAL(wp)                            ::   zhref_pnd                                  
    89       REAL(wp)                            ::   zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total 
    90       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) 
    9192!! MV MP 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_pnd                  ! ponded sea ice albedo 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_ice                  ! bare sea ice albedo 
    94       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_snw                  ! snow-covered sea ice albedo 
    95       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zafrac_snw                ! relative snow fraction 
    96       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zafrac_ice                ! relative ice fraction 
    97       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) 
    9899      !! 
    99100      !!--------------------------------------------------------------------- 
    100  
    101       ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
    102        
    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 ) 
    106101 
    107102      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
     
    148143         ENDIF  
    149144 
    150          DO jl = 1, ijpl 
     145         DO jl = 1, jpl 
    151146            DO jj = 1, jpj 
    152147               DO ji = 1, jpi 
     
    224219          
    225220         ! Overcast sky surface albedo (accounting for snow, ice melt ponds) 
    226          DO jl = 1, ijpl 
     221         DO jl = 1, jpl 
    227222            DO jj = 1, jpj 
    228223               DO ji = 1, jpi 
     
    309304 
    310305      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 ) 
    315306      ! 
    316307   END SUBROUTINE albedo_ice 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90

    r8360 r8373  
    113113      !! 
    114114      INTEGER  ::   jl                 ! dummy loop index 
    115       REAL(wp), POINTER, DIMENSION(:,:,:)  ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    116       REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
     115      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  
    117117      !!---------------------------------------------------------------------- 
    118118 
     
    158158 
    159159         IF( ln_mixcpl) THEN                                                       ! Case of a mixed Bulk/Coupled formulation 
    160             CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
    161160                                      CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    162161            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    163162            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    164             CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
    165163         ENDIF 
    166164 
     
    209207         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%] 
    210208         !---------------------------------------------------------------------------------------- 
    211          CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    212209          
    213210                                      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 
     
    227224               IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    228225         END SELECT 
    229  
    230          CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    231226 
    232227         !----------------------------! 
     
    520515      INTEGER  ::   jl      ! dummy loop index 
    521516      ! 
    522       REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m    ! Mean albedo over all categories 
    523       REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m    ! Mean temperature over all categories 
    524       ! 
    525       REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories 
    526       REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories 
    527       REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m  ! Mean sublimation over all categories 
    528       REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories 
    529       REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 
     517      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 
    530525      !!---------------------------------------------------------------------- 
    531526      ! 
     
    534529      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==! 
    535530      CASE( 0 , 1 ) 
    536          CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    537531         ! 
    538532         z_qns_m  (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
     
    552546         END DO 
    553547         ! 
    554          CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    555548      END SELECT 
    556549      ! 
    557550      SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==! 
    558551      CASE( 1 , 2 ) 
    559          CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m ) 
    560552         ! 
    561553         zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 
     
    567559         END DO 
    568560         ! 
    569          CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m ) 
    570561      END SELECT 
    571562      ! 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90

    r7646 r8373  
    6565      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
    6666      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      - 
    67       REAL(wp), POINTER, DIMENSION(:,:) ::   zf0 , zfx  , zfy   , zbet   ! 2D workspace 
    68       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         !  -      - 
    7070      !--------------------------------------------------------------------- 
    71  
    72       CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 
    73       CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 
    7471 
    7572      ! Limitation of moments.                                            
     
    217214         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :') 
    218215      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 ) 
    222216      ! 
    223217   END SUBROUTINE lim_adv_x 
     
    250244      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    251245      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    252       REAL(wp), POINTER, DIMENSION(:,:) ::   zf0, zfx , zfy , zbet   ! 2D workspace 
    253       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     !  -      - 
    255249      !--------------------------------------------------------------------- 
    256  
    257       CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 
    258       CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 
    259250 
    260251      ! Limitation of moments. 
     
    404395      ENDIF 
    405396      ! 
    406       CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 
    407       CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 
    408       ! 
    409397   END SUBROUTINE lim_adv_y 
    410398 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90

    r8316 r8373  
    6565      REAL(wp) ::   zfp_ui, zfp_vj   !   -      - 
    6666      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_v 
     67      REAL(wp), DIMENSION(jpi,jpj) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v 
    6868      !!---------------------------------------------------------------------- 
    6969      ! 
    7070      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       ! 
    7471      ! 
    7572      !  upstream advection with initial mass fluxes & intermediate update 
     
    145142      CALL lbc_lnk( ptc(:,:) , 'T',  1. ) 
    146143      ! 
    147       ! 
    148       CALL wrk_dealloc( jpi,jpj,   zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v ) 
    149       ! 
    150144      IF( nn_timing == 1 )  CALL timing_stop('lim_adv_umx') 
    151145      ! 
     
    174168      INTEGER  ::   ji, jj    ! dummy loop indices 
    175169      REAL(wp) ::   zc_box    !   -      - 
    176       REAL(wp), POINTER, DIMENSION(:,:) :: zzt 
     170      REAL(wp), DIMENSION(jpi,jpj) :: zzt 
    177171      !!---------------------------------------------------------------------- 
    178172      ! 
    179173      IF( nn_timing == 1 )  CALL timing_start('macho') 
    180       ! 
    181       CALL wrk_alloc( jpi,jpj,   zzt ) 
    182174      ! 
    183175      IF( MOD( (kt - 1) / nn_fsbc , 2 ) == 0 ) THEN         !==  odd ice time step:  adv_x then adv_y  ==! 
     
    219211      ENDIF       
    220212      ! 
    221       CALL wrk_dealloc( jpi,jpj,   zzt ) 
    222       ! 
    223213      IF( nn_timing == 1 )  CALL timing_stop('macho') 
    224214      ! 
     
    245235      INTEGER  ::   ji, jj       ! dummy loop indices 
    246236      REAL(wp) ::   zcu, zdx2, zdx4    !   -      - 
    247       REAL(wp), POINTER, DIMENSION(:,:) :: ztu1, ztu2, ztu3, ztu4 
     237      REAL(wp), DIMENSION(jpi,jpj) :: ztu1, ztu2, ztu3, ztu4 
    248238      !!---------------------------------------------------------------------- 
    249239      ! 
    250240      IF( nn_timing == 1 )  CALL timing_start('ultimate_x') 
    251       ! 
    252       CALL wrk_alloc( jpi,jpj,   ztu1, ztu2, ztu3, ztu4 ) 
    253241      ! 
    254242      !                                                     !--  Laplacian in i-direction  --! 
     
    346334      END SELECT 
    347335      ! 
    348       CALL wrk_dealloc( jpi,jpj,   ztu1, ztu2, ztu3, ztu4 ) 
    349       ! 
    350336      IF( nn_timing == 1 )  CALL timing_stop('ultimate_x') 
    351337      ! 
     
    372358      INTEGER  ::   ji, jj       ! dummy loop indices 
    373359      REAL(wp) ::   zcv, zdy2, zdy4    !   -      - 
    374       REAL(wp), POINTER, DIMENSION(:,:) :: ztv1, ztv2, ztv3, ztv4 
     360      REAL(wp), DIMENSION(jpi,jpj) :: ztv1, ztv2, ztv3, ztv4 
    375361      !!---------------------------------------------------------------------- 
    376362      ! 
    377363      IF( nn_timing == 1 )  CALL timing_start('ultimate_y') 
    378       ! 
    379       CALL wrk_alloc( jpi,jpj,   ztv1, ztv2, ztv3, ztv4 ) 
    380364      ! 
    381365      !                                                     !--  Laplacian in j-direction  --! 
     
    474458      END SELECT 
    475459      ! 
    476       CALL wrk_dealloc( jpi,jpj,   ztv1, ztv2, ztv3, ztv4 ) 
    477       ! 
    478460      IF( nn_timing == 1 )  CALL timing_stop('ultimate_y') 
    479461      ! 
     
    502484      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zsml, z1_dt   ! local scalars 
    503485      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    504       REAL(wp), POINTER, DIMENSION(:,:) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv 
     486      REAL(wp), DIMENSION(jpi,jpj) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv 
    505487      !!---------------------------------------------------------------------- 
    506488      ! 
    507489      IF( nn_timing == 1 )  CALL timing_start('nonosc_2d') 
    508       ! 
    509       CALL wrk_alloc( jpi,jpj,   zbetup, zbetdo, zbup, zbdo, zmsk, zdiv ) 
    510490      ! 
    511491      zbig = 1.e+40_wp 
     
    578558      CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    579559      ! 
    580       CALL wrk_dealloc( jpi,jpj,   zbetup, zbetdo, zbup, zbdo, zmsk, zdiv ) 
    581       ! 
    582560      IF( nn_timing == 1 )  CALL timing_stop('nonosc_2d') 
    583561      ! 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r8316 r8373  
    8383      INTEGER    :: i_hemis, i_fill, jl0 
    8484      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      !-------------------------------------------------------------------- 
    9691 
    9792      IF(lwp) WRITE(numout,*) 
     
    503498!!!       
    504499 
    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  
    510500   END SUBROUTINE lim_istate 
    511501 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r8341 r8373  
    110110      REAL(wp) ::   za, zfac              ! local scalar 
    111111      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) 
    113113                                                               ! (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/shear 
    116       REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
     114      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 
    117117      ! 
    118118      INTEGER, PARAMETER ::   nitermax = 20     
     
    121121      !!----------------------------------------------------------------------------- 
    122122      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    123  
    124       CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 
    125123 
    126124      ! conservation test 
     
    288286      ! control prints 
    289287      IF( ln_ctl )       CALL lim_prt3D( 'limitd_me' ) 
    290  
    291       CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 
    292288      ! 
    293289      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
     
    303299      !!              participating in ridging and of the resulting ridges. 
    304300      !!---------------------------------------------------------------------! 
    305       INTEGER ::   ji,jj, jl    ! dummy loop indices 
     301      INTEGER  ::   ji,jj, jl    ! dummy loop indices 
    306302      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      !------------------------------------------------------------------------------! 
    311305 
    312306      Gstari     = 1.0/rn_gstar     
     
    477471      END DO 
    478472      ! 
    479       CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    480473      ! 
    481474   END SUBROUTINE lim_itd_me_ridgeprep 
     
    502495      REAL(wp) ::   zwfx_snw         ! snow mass flux increment 
    503496 
    504       INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
    505       REAL(wp), POINTER, DIMENSION(:) ::   zswitch, fvol   ! new ridge volume going to n2 
    506  
    507       REAL(wp), POINTER, DIMENSION(:) ::   afrac            ! fraction of category area ridged  
    508       REAL(wp), POINTER, DIMENSION(:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges 
    509       REAL(wp), POINTER, DIMENSION(:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice 
     497      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 
    510503      ! MV MP 2016 
    511       REAL(wp), POINTER, DIMENSION(:) ::   vprdg            ! pond volume of ridging ice 
    512       REAL(wp), POINTER, DIMENSION(:) ::   aprdg1           ! pond area of ridging ice 
    513       REAL(wp), POINTER, DIMENSION(:) ::   aprdg2           ! pond area of ridging ice 
     504      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 
    514507      ! END MV MP 2016 
    515       REAL(wp), POINTER, DIMENSION(:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
    516  
    517       REAL(wp), POINTER, DIMENSION(:) ::   vrdg1   ! volume of ice ridged 
    518       REAL(wp), POINTER, DIMENSION(:) ::   vrdg2   ! volume of new ridges 
    519       REAL(wp), POINTER, DIMENSION(:) ::   vsw     ! volume of seawater trapped into ridges 
    520       REAL(wp), POINTER, DIMENSION(:) ::   srdg1   ! sal*volume of ice ridged 
    521       REAL(wp), POINTER, DIMENSION(:) ::   srdg2   ! sal*volume of new ridges 
    522       REAL(wp), POINTER, DIMENSION(:) ::   smsw    ! sal*volume of water trapped into ridges 
    523       REAL(wp), POINTER, DIMENSION(:) ::   oirdg1, oirdg2   ! ice age of ice ridged 
    524  
    525       REAL(wp), POINTER, DIMENSION(:) ::   afrft            ! fraction of category area rafted 
    526       REAL(wp), POINTER, DIMENSION(:) ::   arft1 , arft2    ! area of ice rafted and new rafted zone 
    527       REAL(wp), POINTER, DIMENSION(:) ::   virft , vsrft    ! ice & snow volume of rafting ice 
     508      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 
    528521      ! MV MP 2016 
    529       REAL(wp), POINTER, DIMENSION(:) ::   vprft            ! pond volume of rafting ice 
    530       REAL(wp), POINTER, DIMENSION(:) ::   aprft1           ! pond area of rafted ice 
    531       REAL(wp), POINTER, DIMENSION(:) ::   aprft2           ! pond area of new rafted ice 
     522      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 
    532525      ! END MV MP 2016 
    533       REAL(wp), POINTER, DIMENSION(:) ::   esrft , smrft    ! snow energy & salinity of rafting ice 
    534       REAL(wp), POINTER, DIMENSION(:) ::   oirft1, oirft2   ! ice age of ice rafted 
    535  
    536       REAL(wp), POINTER, DIMENSION(:,:) ::   eirft      ! ice energy of rafting ice 
    537       REAL(wp), POINTER, DIMENSION(:,:) ::   erdg1      ! enth*volume of ice ridged 
    538       REAL(wp), POINTER, DIMENSION(:,:) ::   erdg2      ! enth*volume of new ridges 
    539       REAL(wp), POINTER, DIMENSION(:,:) ::   ersw       ! enth of water trapped into ridges 
     526      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 
    540533      !!---------------------------------------------------------------------- 
    541  
    542       CALL wrk_alloc( jpij,        indxi, indxj ) 
    543       CALL wrk_alloc( jpij,        zswitch, fvol ) 
    544       ! MV MP 2016 
    545       !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 2016 
    548       CALL wrk_alloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
    549       ! MV MP 2016 
    550       !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 2016 
    554       CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 
    555534 
    556535      !------------------------------------------------------------------------------- 
     
    794773      ! SIMIP diagnostics 
    795774      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(:,:)       
    811776      ! 
    812777   END SUBROUTINE lim_itd_me_ridgeshift 
     
    831796      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing 
    832797      REAL(wp)            ::   zp, z1_3    ! local scalars 
    833       REAL(wp), POINTER, DIMENSION(:,:) ::   zworka           ! temporary array used here 
    834       REAL(wp), POINTER, DIMENSION(:,:) ::   zstrp1, zstrp2   ! strength at previous time steps 
     798      REAL(wp), DIMENSION(jpi,jpj) ::   zworka           ! temporary array used here 
     799      REAL(wp), DIMENSION(jpi,jpj) ::   zstrp1, zstrp2   ! strength at previous time steps 
    835800      !!---------------------------------------------------------------------- 
    836  
    837       CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 
    838801 
    839802      !------------------------------------------------------------------------------! 
     
    966929 
    967930      ENDIF ! ksmooth 
    968  
    969       CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 
    970931      ! 
    971932   END SUBROUTINE lim_itd_me_icestrength 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90

    r8369 r8373  
    249249       !!------------------------------------------------------------------- 
    250250 
    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 
    273272       !!------------------------------------------------------------------- 
    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  
    279273        z1_rhofw       = 1. / rhofw  
    280274        z1_zpnd_aspect = 1. / zpnd_aspect 
     
    390384 
    391385        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   ) 
    396386 
    397387   END SUBROUTINE lim_mp_cesm 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r8324 r8373  
    123123      REAL(wp) ::   zfac_x, zfac_y 
    124124       
    125       REAL(wp), POINTER, DIMENSION(:,:) ::   z1_e1t0, z1_e2t0                ! scale factors 
    126       REAL(wp), POINTER, DIMENSION(:,:) ::   zp_delt                         ! P/delta at T points 
    127       ! 
    128       REAL(wp), POINTER, DIMENSION(:,:) ::   zaU   , zaV                     ! ice fraction on U/V points 
    129       REAL(wp), POINTER, DIMENSION(:,:) ::   zmU_t, zmV_t                    ! ice/snow mass/dt on U/V points 
    130       REAL(wp), POINTER, DIMENSION(:,:) ::   zmf                             ! coriolis parameter at T points 
    131       REAL(wp), POINTER, DIMENSION(:,:) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points 
    132       REAL(wp), POINTER, DIMENSION(:,:) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points 
    133       REAL(wp), POINTER, DIMENSION(:,:) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                            
    134       REAL(wp), POINTER, DIMENSION(:,:) ::   zfU   , zfV                     ! internal stresses 
     125      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 
    135135       
    136       REAL(wp), POINTER, DIMENSION(:,:) ::   zds                             ! shear 
    137       REAL(wp), POINTER, DIMENSION(:,:) ::   zs1, zs2, zs12                  ! stress tensor components 
    138       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr           ! check convergence 
    139       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: 
    140140                                                                             !   ocean surface (ssh_m) if ice is not embedded 
    141141                                                                             !   ice top surface if ice is embedded    
    142       REAL(wp), POINTER, DIMENSION(:,:) ::   zCorx, zCory                    ! Coriolis stress array 
    143       REAL(wp), POINTER, DIMENSION(:,:) ::   ztaux_oi, ztauy_oi              ! Ocean-to-ice stress array 
    144  
    145       REAL(wp), POINTER, DIMENSION(:,:) ::   zswitchU, zswitchV              ! dummy arrays 
    146       REAL(wp), POINTER, DIMENSION(:,:) ::   zmaskU, zmaskV                  ! mask for ice presence 
    147       REAL(wp), POINTER, DIMENSION(:,:) ::   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 
     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 
    151151      !!------------------------------------------------------------------- 
    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) 
    160152 
    161153#if defined key_agrif  
     
    762754         ENDIF 
    763755      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      ! 
    774757   END SUBROUTINE lim_rhg 
    775758 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r8324 r8373  
    106106      CHARACTER(len=25) ::   znam 
    107107      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      !!---------------------------------------------------------------------- 
    112110 
    113111      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1 
     
    355353      ENDIF 
    356354      ! 
    357       CALL wrk_dealloc( jpi, jpj, z2d ) 
    358355      ! 
    359356   END SUBROUTINE lim_rst_write 
     
    366363      !! ** purpose  :   read of sea-ice variable restart in a netcdf file 
    367364      !!---------------------------------------------------------------------- 
    368       INTEGER :: ji, jj, jk, jl 
    369       REAL(wp) ::   zfice, ziter 
    370       REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
     365      INTEGER  :: ji, jj, jk, jl 
     366      REAL(wp) :: zfice, ziter 
     367      REAL(wp), DIMENSION(jpi,jpj) ::   z2d 
    371368      CHARACTER(len=25) ::   znam 
    372369      CHARACTER(len=2)  ::   zchar, zchar1 
     
    374371      LOGICAL           ::   llok 
    375372      !!---------------------------------------------------------------------- 
    376  
    377       CALL wrk_alloc( jpi, jpj, z2d ) 
    378373 
    379374      IF(lwp) THEN 
     
    638633      !CALL iom_close( numrir ) !clem: closed in icestp.F90 
    639634      ! 
    640       CALL wrk_dealloc( jpi, jpj, z2d ) 
    641       ! 
    642635   END SUBROUTINE lim_rst_read 
    643636 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r8371 r8373  
    8787      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
    8888      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) 
    9090      ! 
    9191      !!------------------------------------------------------------------- 
    9292 
    9393      IF( nn_timing == 1 )   CALL timing_start('limthd') 
    94  
    95       CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) 
    9694 
    9795      IF( kt == nit000 .AND. lwp ) THEN 
     
    322320 
    323321      IF( ln_ctl )       CALL lim_prt3D( 'limthd' )  ! Control print 
    324       ! 
    325       CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric ) 
    326322      ! 
    327323      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r8370 r8373  
    8585      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean 
    8686 
    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 melt  
    95       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre   ! snow precipitation  
    96       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_sub   ! snow sublimation 
    97  
    98       REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah 
    99       REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness 
    100       INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting  
    101  
    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 blowing 
     87      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 
    104104 
    105105      REAL(wp) :: zswitch_sal 
     
    107107      ! Heat conservation  
    108108      INTEGER  ::   num_iter_max 
    109  
    110109      !!------------------------------------------------------------------ 
    111110 
    112111      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 
    113112      SELECT CASE( nn_icesal )                  ! varying salinity or not 
    114          CASE( 1, 3 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
    115          CASE( 2 )    ;   zswitch_sal = 1       ! varying salinity profile 
     113         CASE( 1, 3 ) ;   zswitch_sal = 0._wp   ! prescribed salinity profile 
     114         CASE( 2 )    ;   zswitch_sal = 1._wp   ! varying salinity profile 
    116115      END SELECT 
    117116 
    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 
    133121      END DO 
    134122 
    135123      ! initialize layer thicknesses and enthalpies 
    136       h_i_old (:,0:nlay_i+1) = 0._wp 
    137       eh_i_old(:,0:nlay_i+1) = 0._wp 
     124      h_i_old (1:nidx,0:nlay_i+1) = 0._wp 
     125      eh_i_old(1:nidx,0:nlay_i+1) = 0._wp 
    138126      DO jk = 1, nlay_i 
    139127         DO ji = 1, nidx 
     
    204192      CALL lim_thd_snwblow( 1. - at_i_1d(1:nidx), zsnw(1:nidx) ) ! snow distribution over ice after wind blowing 
    205193 
    206       zdeltah(:,:) = 0._wp 
     194      zdeltah(1:nidx,:) = 0._wp 
    207195      DO ji = 1, nidx 
    208196         !----------- 
     
    239227 
    240228      ! If heat still available (zq_su > 0), then melt more snow 
    241       zdeltah(:,:) = 0._wp 
     229      zdeltah(1:nidx,:) = 0._wp 
    242230      DO jk = 1, nlay_s 
    243231         DO ji = 1, nidx 
     
    263251      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    264252      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 
    265       zdeltah(:,:) = 0._wp 
     253      zdeltah(1:nidx,:) = 0._wp 
    266254      DO ji = 1, nidx 
    267255         zdh_s_sub(ji)  = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 
     
    303291      ! 3.4 Surface ice ablation  
    304292      !-------------------------- 
    305       zdeltah(:,:) = 0._wp ! important 
     293      zdeltah(1:nidx,:) = 0._wp ! important 
    306294      DO jk = 1, nlay_i 
    307295         DO ji = 1, nidx 
     
    498486      ! 4.2 Basal melt 
    499487      !---------------- 
    500       zdeltah(:,:) = 0._wp ! important 
     488      zdeltah(1:nidx,:) = 0._wp ! important 
    501489      DO jk = nlay_i, 1, -1 
    502490         DO ji = 1, nidx 
     
    583571      ! If heat still available for melting and snow remains, then melt more snow 
    584572      !------------------------------------------- 
    585       zdeltah(:,:) = 0._wp ! important 
     573      zdeltah(1:nidx,:) = 0._wp ! important 
    586574      DO ji = 1, nidx 
    587575         zq_rema(ji)     = zq_su(ji) + zq_bo(ji)  
     
    668656      DO ji = 1, nidx 
    669657         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          
    677659      ! 
    678660   END SUBROUTINE lim_thd_dh 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r8369 r8373  
    9595      INTEGER ::   iconv_max = 50 ! max number of iterations in iterative procedure 
    9696       
    97       INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation 
    98       INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation 
     97      INTEGER, DIMENSION(jpij) ::   numeqmin   ! reference number of top equation 
     98      INTEGER, DIMENSION(jpij) ::   numeqmax   ! reference number of bottom equation 
    9999       
    100100      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
     
    110110      REAL(wp) ::   zdti_bnd = 1.e-4_wp       ! maximal authorized error on temperature  
    111111       
    112       REAL(wp), POINTER, DIMENSION(:)     ::   isnow       ! switch for presence (1) or absence (0) of snow 
    113       REAL(wp), POINTER, DIMENSION(:)     ::   ztsub       ! old surface temperature (before the iterative procedure ) 
    114       REAL(wp), POINTER, DIMENSION(:)     ::   ztsubit     ! surface temperature at previous iteration 
    115       REAL(wp), POINTER, DIMENSION(:)     ::   zh_i        ! ice layer thickness 
    116       REAL(wp), POINTER, DIMENSION(:)     ::   zh_s        ! snow layer thickness 
    117       REAL(wp), POINTER, DIMENSION(:)     ::   zfsw        ! solar radiation absorbed at the surface 
    118       REAL(wp), POINTER, DIMENSION(:)     ::   zqns_ice_b  ! solar radiation absorbed at the surface 
    119       REAL(wp), POINTER, DIMENSION(:)     ::   zf          ! surface flux function 
    120       REAL(wp), POINTER, DIMENSION(:)     ::   dzf         ! derivative of the surface flux function 
    121       REAL(wp), POINTER, DIMENSION(:)     ::   zdti        ! current error on temperature 
    122       REAL(wp), POINTER, DIMENSION(:)     ::   zdifcase    ! case of the equation resolution (1->4) 
    123       REAL(wp), POINTER, DIMENSION(:)     ::   zftrice     ! solar radiation transmitted through the ice 
    124       REAL(wp), POINTER, DIMENSION(:)     ::   zihic 
     112      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 
    125125       
    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 
    149148       
    150149      ! 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 
    163159      !!------------------------------------------------------------------      
    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 ) 
    174160 
    175161      ! --- diag error on heat diffusion - PART 1 --- ! 
     
    808794      END DO    
    809795      ! 
    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  
    819796   END SUBROUTINE lim_thd_dif 
    820797 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r8342 r8373  
    7373      INTEGER  :: jk0, jk1   !  old/new layer indices 
    7474      ! 
    75       REAL(wp), POINTER, DIMENSION(:,:) :: zeh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces 
    76       REAL(wp), POINTER, DIMENSION(:,:) :: zeh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces 
    77       REAL(wp), POINTER, DIMENSION(:)   :: zhnew               ! new layers thicknesses 
     75      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 
    7878      !!------------------------------------------------------------------- 
    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 ) 
    8379 
    8480      !-------------------------------------------------------------------------- 
     
    142138      END DO 
    143139       
    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       ! 
    149140   END SUBROUTINE lim_thd_ent 
    150141 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r8342 r8373  
    8383      REAL(wp) ::   zv_newfra 
    8484   
    85       INTEGER , POINTER, DIMENSION(:) ::   jcat        ! indexes of categories where new ice grows 
    86       REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not 
    87  
    88       REAL(wp), POINTER, DIMENSION(:) ::   zv_newice   ! volume of accreted ice 
    89       REAL(wp), POINTER, DIMENSION(:) ::   za_newice   ! fractional area of accreted ice 
    90       REAL(wp), POINTER, DIMENSION(:) ::   zh_newice   ! thickness of accreted ice 
    91       REAL(wp), POINTER, DIMENSION(:) ::   ze_newice   ! heat content of accreted ice 
    92       REAL(wp), POINTER, DIMENSION(:) ::   zs_newice   ! salinity of accreted ice 
    93       REAL(wp), POINTER, DIMENSION(:) ::   zo_newice   ! age of accreted ice 
    94       REAL(wp), POINTER, DIMENSION(:) ::   zdv_res     ! residual volume in case of excessive heat budget 
    95       REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget 
    96       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_1d    ! total ice fraction     
    97       REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb    ! accretion of frazil ice at the ice bottom 
    98       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 jl 
    101       REAL(wp), POINTER, DIMENSION(:,:) ::   za_b      ! old area of ice in category jl 
    102       REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i 
    103       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i 
    104       REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
    105  
    106       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d !: 1-D version of e_i 
    107  
    108       REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel     ! relative ice / frazil velocity 
     85      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 
    109109 
    110110      REAL(wp) :: zcai = 1.4e-3_wp                     ! ice-air drag (clem: should be dependent on coupling/forcing used) 
    111111      !!-----------------------------------------------------------------------! 
    112  
    113       CALL wrk_alloc( jpij, jcat )   ! integer 
    114       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 ) 
    119112 
    120113      CALL lim_var_agg(1) 
     
    211204         END DO  
    212205         !  
    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.  ) 
    215207 
    216208      ENDIF ! End of computation of frazil ice collection thickness 
     
    234226      END DO 
    235227 
    236       ! debug point to follow 
    237       jiindex_1d = 0 
    238       IF( ln_limctl ) THEN 
    239          DO ji = mi0(iiceprt), mi1(iiceprt) 
    240             DO jj = mj0(jiceprt), mj1(jiceprt) 
    241                IF ( qlead(ji,jj)  <  0._wp ) THEN 
    242                   jiindex_1d = (jj - 1) * jpi + ji 
    243                ENDIF 
    244             END DO 
    245          END DO 
    246       ENDIF 
    247     
    248       IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nidx = ', nidx 
    249  
    250228      !------------------------------ 
    251229      ! Move from 2-D to 1-D vectors 
     
    497475      ENDIF ! nidx > 0 
    498476      ! 
    499       CALL wrk_dealloc( jpij, jcat )   ! integer 
    500       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       ! 
    506477   END SUBROUTINE lim_thd_lac 
    507478 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r8321 r8373  
    7171      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
    7272      REAL(wp) ::    zdv, zda 
    73       REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold, zsmvold  
    74       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax, zviold, zvsold 
     73      REAL(wp), DIMENSION(jpi,jpj)           ::   zatold, zeiold, zesold, zsmvold  
     74      REAL(wp), DIMENSION(jpi,jpj,jpl)       ::   zhimax, zviold, zvsold 
    7575      ! --- ultimate macho only --- ! 
    7676      REAL(wp)                               ::   zdt 
     
    8888      !!--------------------------------------------------------------------- 
    8989      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 ) 
    9390  
    9491      IF( kt == nit000 .AND. lwp ) THEN 
     
    134131            END DO 
    135132         END DO 
    136          CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 
    137133      END DO 
     134      CALL lbc_lnk( zhimax(:,:,:), 'T', 1. ) 
    138135          
    139136      ! --- If ice drift field is too fast, use an appropriate time step for advection --- !         
     
    523520      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 
    524521      ! 
    525       CALL wrk_dealloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold ) 
    526       CALL wrk_dealloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold ) 
    527       ! 
    528522      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
    529523      ! 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r8355 r8373  
    141141      END DO 
    142142      !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. ) 
    145144      !mask velocities 
    146145      u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r8360 r8373  
    302302      REAL(wp) ::   zfac0, zfac1, zsal 
    303303      REAL(wp) ::   zswi0, zswi01, zargtemp , zs_zero    
    304       REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha 
     304      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_slope_s, zalpha 
    305305      REAL(wp), PARAMETER :: zsi0 = 3.5_wp 
    306306      REAL(wp), PARAMETER :: zsi1 = 4.5_wp 
    307307      !!------------------------------------------------------------------ 
    308  
    309       CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha ) 
    310308 
    311309      !--------------------------------------- 
     
    391389      ENDIF ! nn_icesal 
    392390      ! 
    393       CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha ) 
    394       ! 
    395391   END SUBROUTINE lim_var_salprof 
    396392 
     
    444440      REAL(wp) ::   zalpha, zswi0, zswi01, zs_zero              !   -      - 
    445441      ! 
    446       REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s 
     442      REAL(wp), DIMENSION(jpij) ::   z_slope_s 
    447443      REAL(wp), PARAMETER :: zsi0 = 3.5_wp 
    448444      REAL(wp), PARAMETER :: zsi1 = 4.5_wp 
    449445      !!--------------------------------------------------------------------- 
    450  
    451       CALL wrk_alloc( jpij, z_slope_s ) 
    452446 
    453447      !--------------------------------------- 
     
    511505      ENDIF 
    512506      ! 
    513       CALL wrk_dealloc( jpij, z_slope_s ) 
    514       ! 
    515507   END SUBROUTINE lim_var_salprof1d 
    516508 
     
    652644      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables 
    653645      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables 
    654       INTEGER , POINTER, DIMENSION(:)         ::   itest 
     646      INTEGER , DIMENSION(4)                  ::   itest 
    655647  
    656       CALL wrk_alloc( 4, itest ) 
    657648      !-------------------------------------------------------------------- 
    658649      ! initialisation of variables 
     
    777768         ENDDO 
    778769      ENDDO 
    779  
    780       CALL wrk_dealloc( 4, itest ) 
    781770      ! 
    782771    END SUBROUTINE lim_var_itd 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r8316 r8373  
    5555      REAL(wp) ::  z2da, z2db, ztmp, zrho1, zrho2, zmiss_val 
    5656      REAL(wp) ::  zs12, zshear 
    57       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zswi2, zmiss2 
    58       REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, zswi, zmiss !  2D workspace 
    59       REAL(wp), POINTER, DIMENSION(:,:)   ::  zfb              ! ice freeboard 
    60       REAL(wp), POINTER, DIMENSION(:,:)   ::  zamask, zamask15 ! 15% concentration mask 
    61       REAL(wp), POINTER, DIMENSION(:,:)   ::  zsig1, zsig2, zsig3 
     57      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 
    6262 
    6363      ! Global ice diagnostics (SIMIP) 
     
    7272 
    7373      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 ) 
    7974 
    8075      !---------------------------------------- 
     
    428423      !     not yet implemented 
    429424       
    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  
    435425      IF( nn_timing == 1 )  CALL timing_stop('limwri') 
    436426       
Note: See TracChangeset for help on using the changeset viewer.