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/limtab_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/limtab_2.F90

    r2528 r2715  
    22   !!====================================================================== 
    33   !!                       ***  MODULE limtab_2   *** 
    4    !!             transform 1D (2D) array to a 2D (1D) table 
     4   !!   LIM : transform 1D (2D) array to a 2D (1D) table 
    55   !!====================================================================== 
    66#if defined key_lim2 
    77   !!---------------------------------------------------------------------- 
    8    !!   tab_2d_1d  : 2-D to 1-D 
    9    !!   tab_1d_2d  : 1-D to 2-D 
     8   !!   tab_2d_1d  : 2-D <==> 1-D 
     9   !!   tab_1d_2d  : 1-D <==> 2-D 
    1010   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1211   USE par_kind 
    1312 
    … …  
    1514   PRIVATE 
    1615 
    17    !! * Routine accessibility 
    18    PUBLIC tab_2d_1d_2  ! called by lim_ther 
    19    PUBLIC tab_1d_2d_2  ! called by lim_ther 
     16   PUBLIC   tab_2d_1d_2   ! called by limthd 
     17   PUBLIC   tab_1d_2d_2   ! called by limthd 
    2018 
    2119   !!---------------------------------------------------------------------- 
    22    !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     20   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010) 
    2321   !! $Id$ 
    24    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     22   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2523   !!---------------------------------------------------------------------- 
    2624CONTAINS 
    2725 
    2826   SUBROUTINE tab_2d_1d_2 ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 
    29  
    30       INTEGER, INTENT(in) :: & 
    31          ndim1d, ndim2d_x, ndim2d_y 
    32  
    33       REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT(in) ::  & 
    34          tab2d 
    35  
    36       INTEGER, DIMENSION ( ndim1d), INTENT ( in) :: & 
    37          tab_ind 
    38  
    39       REAL(wp), DIMENSION(ndim1d), INTENT ( out) ::  &  
    40          tab1d 
    41  
    42       INTEGER ::  & 
    43          jn , jid, jjd 
    44          
     27      !!---------------------------------------------------------------------- 
     28      !!                  ***  ROUTINE tab_2d_1d  *** 
     29      !!---------------------------------------------------------------------- 
     30      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1D & 2D sizes 
     31      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in   ) ::   tab2d                        ! input 2D field 
     32      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index 
     33      REAL(wp), DIMENSION(ndim1d)           , INTENT(  out) ::   tab1d                        ! output 1D field 
     34      ! 
     35      INTEGER ::   jn , jid, jjd 
     36      !!---------------------------------------------------------------------- 
    4537      DO jn = 1, ndim1d 
    46          jid        = MOD( tab_ind(jn) - 1, ndim2d_x ) + 1 
    47          jjd        = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 
     38         jid        = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 
     39         jjd        =    ( tab_ind(jn) - 1 ) / ndim2d_x + 1 
    4840         tab1d( jn) = tab2d( jid, jjd) 
    4941      END DO  
    50  
    5142   END SUBROUTINE tab_2d_1d_2 
    5243 
    5344 
    5445   SUBROUTINE tab_1d_2d_2 ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 
    55  
    56       INTEGER, INTENT ( in) :: & 
    57          ndim1d, ndim2d_x, ndim2d_y 
    58  
    59       INTEGER, DIMENSION (ndim1d) , INTENT (in) :: & 
    60          tab_ind 
    61  
    62       REAL(wp), DIMENSION(ndim1d), INTENT (in) ::  & 
    63          tab1d   
    64  
    65       REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT ( out) :: & 
    66          tab2d 
    67  
    68       INTEGER :: & 
    69          jn, jid, jjd 
    70  
     46      !!---------------------------------------------------------------------- 
     47      !!                  ***  ROUTINE tab_2d_1d  *** 
     48      !!---------------------------------------------------------------------- 
     49      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes 
     50      REAL(wp), DIMENSION(ndim1d)           , INTENT(in   ) ::   tab1d                        ! input 1D field 
     51      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index 
     52      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(  out) ::   tab2d                        ! output 2D field 
     53      ! 
     54      INTEGER ::   jn , jid, jjd 
     55      !!---------------------------------------------------------------------- 
    7156      DO jn = 1, ndim1d 
    72          jid             = MOD( tab_ind(jn) - 1, ndim2d_x) + 1 
     57         jid             = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 
    7358         jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1 
    7459         tab2d(jid, jjd) = tab1d( jn) 
    7560      END DO 
    76  
    7761   END SUBROUTINE tab_1d_2d_2 
    7862 
     63#else 
     64   !!---------------------------------------------------------------------- 
     65   !!   Default option        Dummy module             NO LIM sea-ice model 
     66   !!---------------------------------------------------------------------- 
    7967#endif 
     68   !!====================================================================== 
    8069END MODULE limtab_2 
Note: See TracChangeset for help on using the changeset viewer.