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 1857 for branches/DEV_r1837_mass_heat_salt_fluxes/NEMO/LIM_SRC_3/limtab.F90 – NEMO

Ignore:
Timestamp:
2010-05-03T13:59:46+02:00 (14 years ago)
Author:
gm
Message:

ticket:#665 Reverting previous commit and going back to revision 1850

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_r1837_mass_heat_salt_fluxes/NEMO/LIM_SRC_3/limtab.F90

    r1855 r1857  
    22   !!====================================================================== 
    33   !!                       ***  MODULE limtab   *** 
    4    !!   LIM-3 ice model : transform 1D (2D) array to a 2D (1D) array 
     4   !!              transform 1D (2D) array to a 2D (1D) table 
    55   !!====================================================================== 
    66#if defined key_lim3 
    77   !!---------------------------------------------------------------------- 
    8    !!   'key_lim3' :                                  LIM 2.0 sea-ice model 
     8   !!   'key_lim3'                                      LIM3 sea-ice model 
    99   !!---------------------------------------------------------------------- 
    1010   !!   tab_2d_1d  : 2-D to 1-D 
    1111   !!   tab_1d_2d  : 1-D to 2-D 
    1212   !!---------------------------------------------------------------------- 
     13   !! * Modules used 
    1314   USE par_kind 
    1415 
     
    1617   PRIVATE 
    1718 
    18    PUBLIC   tab_2d_1d   ! called by lim_thd 
    19    PUBLIC   tab_1d_2d   ! called by lim_thd 
     19   !! * Routine accessibility 
     20   PUBLIC tab_2d_1d  ! called by lim_ther 
     21   PUBLIC tab_1d_2d  ! called by lim_ther 
    2022 
    2123   !!---------------------------------------------------------------------- 
    22    !! NEMO/LIM 3.3,  UCL-LOCEAN-IPSL (2010)  
     24   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)  
    2325   !! $Id$ 
    2426   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     
    2628CONTAINS 
    2729 
    28    SUBROUTINE tab_2d_1d( kdim1d, ptab1d, ptab2d, kdim2d_i, kdim2d_j, ptab_ind ) 
    29       !!------------------------------------------------------------------- 
    30       INTEGER , INTENT(in   )                                ::   kdim1d 
    31       INTEGER , INTENT(in   )                                ::   kdim2d_i, kdim2d_j 
    32       REAL(wp), INTENT(in   ), DIMENSION(kdim2d_i, kdim2d_j) ::   ptab2d 
    33       INTEGER , INTENT(in   ), DIMENSION(kdim1d)             ::   ptab_ind 
    34       REAL(wp), INTENT(  out), DIMENSION(kdim1d)             ::   ptab1d 
    35       !! 
    36       INTEGER ::   jn , jid, jjd   ! dummy loop indices 
    37       !!------------------------------------------------------------------- 
    38       !  
    39       DO jn = 1, kdim1d 
    40          jid = MOD( ptab_ind(jn) - 1, kdim2d_i ) + 1 
    41          jjd = ( ptab_ind(jn) - 1 ) / kdim2d_i + 1 
    42          ptab1d(jn) = ptab2d(jid,jjd) 
    43       END DO  
    44       ! 
     30   SUBROUTINE tab_2d_1d ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 
     31 
     32      INTEGER, INTENT(in) :: & 
     33         ndim1d, ndim2d_x, ndim2d_y 
     34 
     35      REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT(in) ::  & 
     36         tab2d 
     37 
     38      INTEGER, DIMENSION ( ndim1d), INTENT ( in) :: & 
     39         tab_ind 
     40 
     41      REAL(wp), DIMENSION(ndim1d), INTENT ( out) ::  &  
     42         tab1d 
     43 
     44      INTEGER ::  & 
     45         jn , jid, jjd 
     46 
     47      DO jn = 1, ndim1d 
     48         jid        = MOD( tab_ind(jn) - 1, ndim2d_x ) + 1 
     49         jjd        = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 
     50         tab1d( jn) = tab2d( jid, jjd) 
     51      END DO 
     52 
    4553   END SUBROUTINE tab_2d_1d 
    4654 
    4755 
    48    SUBROUTINE tab_1d_2d( kdim1d, ptab2d, ptab_ind, ptab1d, kdim2d_i, kdim2d_j ) 
    49       !!------------------------------------------------------------------- 
    50       INTEGER , INTENT(in   )                                ::   kdim1d 
    51       INTEGER , INTENT(in   )                                ::   kdim2d_i, kdim2d_j 
    52       INTEGER , INTENT(in   ), DIMENSION(kdim1d)             ::   ptab_ind 
    53       REAL(wp), INTENT(in   ), DIMENSION(kdim1d)             ::   ptab1d 
    54       REAL(wp), INTENT(  out), DIMENSION(kdim2d_i, kdim2d_j) ::   ptab2d 
    55       !! 
    56       INTEGER ::   jn, jid, jjd   ! dummy loop indices 
    57       !!------------------------------------------------------------------- 
    58       ! 
    59       DO jn = 1, kdim1d 
    60          jid = MOD( ptab_ind(jn) - 1, kdim2d_i) + 1 
    61          jjd =    ( ptab_ind(jn) - 1 ) / kdim2d_i  + 1 
    62          ptab2d(jid,jjd) = ptab1d(jn) 
     56   SUBROUTINE tab_1d_2d ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 
     57 
     58      INTEGER, INTENT ( in) :: & 
     59         ndim1d, ndim2d_x, ndim2d_y 
     60 
     61      INTEGER, DIMENSION (ndim1d) , INTENT (in) :: & 
     62         tab_ind 
     63 
     64      REAL(wp), DIMENSION(ndim1d), INTENT (in) ::  & 
     65         tab1d   
     66 
     67      REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT ( out) :: & 
     68         tab2d 
     69 
     70      INTEGER :: & 
     71         jn, jid, jjd 
     72 
     73      DO jn = 1, ndim1d 
     74         jid             = MOD( tab_ind(jn) - 1, ndim2d_x) + 1 
     75         jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1 
     76         tab2d(jid, jjd) = tab1d( jn) 
    6377      END DO 
    64       ! 
     78 
    6579   END SUBROUTINE tab_1d_2d 
    6680 
    67 #else 
    68    !!---------------------------------------------------------------------- 
    69    !!   Default option          Dummy module       NO LIM 2.0 sea-ice model 
    70    !!---------------------------------------------------------------------- 
    7181#endif 
    72  
    73    !!====================================================================== 
    7482END MODULE limtab 
Note: See TracChangeset for help on using the changeset viewer.