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 5621 for branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90 – NEMO

Ignore:
Timestamp:
2015-07-21T13:25:36+02:00 (9 years ago)
Author:
mathiot
Message:

UKMO_ISF: upgrade to NEMO_3.6_STABLE (r5554)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r5134 r5621  
    3131   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3232   USE limthd_ent 
     33   USE limvar 
    3334 
    3435   IMPLICIT NONE 
     
    105106      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i 
    106107      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i 
    107       REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i 
    108108      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
    109109 
     
    118118      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    119119      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
    120       CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
    121       CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     120      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 
     121      CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d ) 
    122122      CALL wrk_alloc( jpi,jpj, zvrel ) 
    123123 
     124      CALL lim_var_agg(1) 
     125      CALL lim_var_glo2eqv 
    124126      !------------------------------------------------------------------------------| 
    125127      ! 2) Convert units for ice internal energy 
     
    289291            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    290292            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    291             CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    292293            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    293294            DO jk = 1, nlay_i 
    294295               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    295             END DO ! jk 
    296          END DO ! jl 
     296            END DO 
     297         END DO 
    297298 
    298299         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
     
    355356         DO ji = 1, nbpac 
    356357            zo_newice(ji) = 0._wp 
    357          END DO ! ji 
     358         END DO 
    358359 
    359360         !------------------- 
     
    477478         ENDDO 
    478479 
    479          !------------ 
    480          ! Update age  
    481          !------------ 
    482          DO jl = 1, jpl 
    483             DO ji = 1, nbpac 
    484                rswitch          = MAX( 0._wp , SIGN( 1._wp , za_i_1d(ji,jl) - epsi20 ) )  ! 0 if no ice and 1 if yes 
    485                zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch    
    486             END DO  
    487          END DO    
    488  
    489480         !----------------- 
    490481         ! Update salinity 
     
    503494            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 
    504495            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 
    505             CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj ) 
    506496            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 
    507497            DO jk = 1, nlay_i 
     
    535525      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    536526      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
    537       CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
    538       CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     527      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 
     528      CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d ) 
    539529      CALL wrk_dealloc( jpi,jpj, zvrel ) 
    540530      ! 
Note: See TracChangeset for help on using the changeset viewer.