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 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r2528 r2715  
    1111   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    13    !!---------------------------------------------------------------------- 
    1413   !!   lim_thd_zdf_2 : vertical accr./abl. and lateral ablation of sea ice 
    1514   !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    1715   USE par_oce          ! ocean parameters 
    1816   USE phycst           ! ??? 
     
    2119   USE limistate_2 
    2220   USE in_out_manager 
     21   USE lib_mpp          ! MPP library 
    2322   USE cpl_oasis3, ONLY : lk_cpl 
    2423       
     
    3534   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    3635   !! $Id$ 
    37    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3837   !!---------------------------------------------------------------------- 
    39  
    4038CONTAINS 
    4139 
     
    6967      !!              Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268   
    7068      !!------------------------------------------------------------------ 
     69      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     70      USE wrk_nemo, ONLY: wrk_1d_1,  wrk_1d_2,  wrk_1d_3,  wrk_1d_4,  wrk_1d_5  
     71      USE wrk_nemo, ONLY: wrk_1d_6,  wrk_1d_7,  wrk_1d_8,  wrk_1d_9,  wrk_1d_10 
     72      USE wrk_nemo, ONLY: wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15 
     73      USE wrk_nemo, ONLY: wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20 
     74      USE wrk_nemo, ONLY: wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25 
     75      USE wrk_nemo, ONLY: wrk_1d_26, wrk_1d_27 
     76      !! 
    7177      INTEGER, INTENT(in) ::   kideb    ! Start point on which the  the computation is applied 
    7278      INTEGER, INTENT(in) ::   kiut     ! End point on which the  the computation is applied 
    7379      !! 
    7480      INTEGER ::   ji       ! dummy loop indices 
    75       REAL(wp), DIMENSION(jpij,2) ::   zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 ) 
    76       REAL(wp), DIMENSION(jpij) ::  & 
     81      REAL(wp), POINTER, DIMENSION(:) ::   zqcmlts        ! energy due to surface melting 
     82      REAL(wp), POINTER, DIMENSION(:) ::   zqcmltb        ! energy due to bottom melting 
     83      REAL(wp), POINTER, DIMENSION(:) ::  & 
    7784         ztsmlt      &    ! snow/ice surface melting temperature 
    7885         ,ztbif      &    ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.  
     
    8895         , zts_old   &    ! previous surface temperature 
    8996         , zidsn , z1midsn , zidsnic ! tempory variables 
    90       REAL(wp), DIMENSION(jpij) ::   & 
     97      REAL(wp), POINTER, DIMENSION(:) ::   & 
    9198          zfnet       &  ! net heat flux at the top surface( incl. conductive heat flux) 
    9299          , zsprecip  &    ! snow accumulation 
     
    160167       !!---------------------------------------------------------------------- 
    161168 
     169       IF(wrk_in_use(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10, & 
     170          &             11,12,13,14,15,16,17,18,19,20, & 
     171          &             21,22,23,24,25,26,27) ) THEN 
     172          CALL ctl_stop('lim_thd_zdf_2 : requested workspace arrays unavailable')   ;   RETURN 
     173       ENDIF 
     174 
     175       ztsmlt  => wrk_1d_1(1:jpij) 
     176       ztbif   => wrk_1d_2(1:jpij)   
     177       zksn    => wrk_1d_3(1:jpij)   
     178       zkic    => wrk_1d_4(1:jpij)    
     179       zksndh  => wrk_1d_5(1:jpij)    
     180       zfcsu   => wrk_1d_6(1:jpij)    
     181       zfcsudt => wrk_1d_7(1:jpij)   
     182       zi0     => wrk_1d_8(1:jpij)    
     183       z1mi0   => wrk_1d_9(1:jpij)     
     184       zqmax   => wrk_1d_10(1:jpij)     
     185       zrcpdt  => wrk_1d_11(1:jpij)   
     186       zts_old => wrk_1d_12(1:jpij)   
     187       zidsn   => wrk_1d_13(1:jpij)  
     188       z1midsn => wrk_1d_14(1:jpij)  
     189       zidsnic => wrk_1d_15(1:jpij) 
     190 
     191       zfnet     => wrk_1d_16(1:jpij) 
     192       zsprecip  => wrk_1d_17(1:jpij)   
     193       zhsnw_old => wrk_1d_18(1:jpij)  
     194       zdhictop  => wrk_1d_19(1:jpij)  
     195       zdhicbot  => wrk_1d_20(1:jpij) 
     196       zqsup     => wrk_1d_21(1:jpij)   
     197       zqocea    => wrk_1d_22(1:jpij) 
     198       zfrl_old  => wrk_1d_23(1:jpij)  
     199       zfrld_1d  => wrk_1d_24(1:jpij)  
     200       zep       => wrk_1d_25(1:jpij)  
     201 
     202       zqcmlts   => wrk_1d_26(1:jpij) 
     203       zqcmltb   => wrk_1d_27(1:jpij) 
     204 
    162205       !----------------------------------------------------------------------- 
    163206       !  1. Boundaries conditions for snow/ice system internal temperature 
     
    171214          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) ) 
    172215          !--computation of energy due to surface melting 
    173           zqcmlt(ji,1) = ( MAX ( zzero ,  & 
     216          zqcmlts(ji) = ( MAX ( zzero ,  & 
    174217             &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 
    175218          !--computation of energy due to bottom melting 
    176           zqcmlt(ji,2) = ( MAX( zzero , & 
     219          zqcmltb(ji) = ( MAX( zzero , & 
    177220             &                  rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 
    178221             &           + MAX( zzero , & 
     
    467510          zhsnw_old(ji) =  h_snow_1d(ji) 
    468511          !--computation of the energy needed to melt snow 
    469           zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlt(ji,1) 
     512          zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlts(ji) 
    470513          !--change in snow thickness due to melt 
    471514          zdhsmlt = - zqsnw_mlt / xlsn 
     
    587630 
    588631          !---treatment of the case of melting/growing 
    589           zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmlt(ji,2) )   & 
    590              &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmlt(ji,2)  ) 
     632          zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmltb(ji) )   & 
     633             &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji)  ) 
    591634          qstbif_1d(ji) =         zibmlt   * qstbif_1d(ji)   & 
    592635             &           + ( 1.0 - zibmlt ) * zqstbif_bot 
     
    762805       END DO 
    763806       !  
     807       IF( wrk_not_released(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10,   & 
     808           &                   11,12,13,14,15,16,17,18,19,20,   & 
     809           &                   21,22,23,24,25,26,27)        )   & 
     810           CALL ctl_stop('lim_thd_zdf_2 : failed to release workspace arrays.') 
     811       ! 
    764812    END SUBROUTINE lim_thd_zdf_2 
    765813 
Note: See TracChangeset for help on using the changeset viewer.