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.
limtab.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90 @ 8369

Last change on this file since 8369 was 8369, checked in by clem, 7 years ago

STEP4 (4): put all thermodynamics in 1D (limitd_th OK)
  • Property svn:keywords set to Id
File size: 5.2 KB
RevLine 
[825]1MODULE limtab
2   !!======================================================================
3   !!                       ***  MODULE limtab   ***
[3625]4   !!   LIM ice model : transform 1D (2D) array to a 2D (1D) table
[825]5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
[834]8   !!   'key_lim3'                                      LIM3 sea-ice model
9   !!----------------------------------------------------------------------
[2715]10   !!   tab_2d_1d  : 2-D <==> 1-D
11   !!   tab_1d_2d  : 1-D <==> 2-D
[825]12   !!----------------------------------------------------------------------
13   USE par_kind
[8342]14   USE par_oce
[8369]15   USE ice, ONLY : jpl
[8342]16   
[825]17   IMPLICIT NONE
18   PRIVATE
19
[8369]20   PUBLIC   tab_3d_2d
21   PUBLIC   tab_2d_1d
22   PUBLIC   tab_2d_3d
23   PUBLIC   tab_1d_2d
[825]24
25   !!----------------------------------------------------------------------
[4161]26   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
[1156]27   !! $Id$
[2715]28   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[825]29   !!----------------------------------------------------------------------
30CONTAINS
31
[8369]32
33   SUBROUTINE tab_3d_2d( ndim1d, tab_ind, tab1d, tab2d )
34      !!----------------------------------------------------------------------
35      !!                  ***  ROUTINE tab_2d_1d  ***
36      !!----------------------------------------------------------------------
37      INTEGER                         , INTENT(in   ) ::   ndim1d   ! 1d size
38      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind  ! input index
39      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in   ) ::   tab2d    ! input 2D field
40      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(  out) ::   tab1d    ! output 1D field
41      !
42      INTEGER ::   jl, jn, jid, jjd
43      !!----------------------------------------------------------------------
44      DO jl = 1, jpl
45         DO jn = 1, ndim1d
46            jid          = MOD( tab_ind(jn) - 1 , jpi ) + 1
47            jjd          =    ( tab_ind(jn) - 1 ) / jpi + 1
48            tab1d(jn,jl) = tab2d(jid,jjd,jl)
49         END DO
50      END DO
51   END SUBROUTINE tab_3d_2d
52
[8342]53   SUBROUTINE tab_2d_1d( ndim1d, tab_ind, tab1d, tab2d )
[2715]54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tab_2d_1d  ***
56      !!----------------------------------------------------------------------
[8342]57      INTEGER                     , INTENT(in   ) ::   ndim1d   ! 1d size
58      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind  ! input index
59      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   tab2d    ! input 2D field
60      REAL(wp), DIMENSION(ndim1d) , INTENT(  out) ::   tab1d    ! output 1D field
[2715]61      !
62      INTEGER ::   jn , jid, jjd
63      !!----------------------------------------------------------------------
[825]64      DO jn = 1, ndim1d
[8342]65         jid        = MOD( tab_ind(jn) - 1 , jpi ) + 1
66         jjd        =    ( tab_ind(jn) - 1 ) / jpi + 1
[825]67         tab1d( jn) = tab2d( jid, jjd)
[921]68      END DO
[825]69   END SUBROUTINE tab_2d_1d
70
[8369]71   SUBROUTINE tab_2d_3d( ndim1d, tab_ind, tab1d, tab2d )
72      !!----------------------------------------------------------------------
73      !!                  ***  ROUTINE tab_2d_1d  ***
74      !!----------------------------------------------------------------------
75      INTEGER                         , INTENT(in   ) ::   ndim1d    ! 1D size
76      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind   ! input index
77      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(in   ) ::   tab1d     ! input 1D field
78      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   tab2d     ! output 2D field
79      !
80      INTEGER ::   jl, jn, jid, jjd
81      !!----------------------------------------------------------------------
82      DO jl = 1, jpl
83         DO jn = 1, ndim1d
84            jid               = MOD( tab_ind(jn) - 1 ,  jpi ) + 1
85            jjd               =    ( tab_ind(jn) - 1 ) / jpi  + 1
86            tab2d(jid,jjd,jl) = tab1d(jn,jl)
87         END DO
88      END DO
89   END SUBROUTINE tab_2d_3d
[825]90
[8342]91   SUBROUTINE tab_1d_2d( ndim1d, tab_ind, tab1d, tab2d )
[2715]92      !!----------------------------------------------------------------------
93      !!                  ***  ROUTINE tab_2d_1d  ***
94      !!----------------------------------------------------------------------
[8342]95      INTEGER                     , INTENT(in   ) ::   ndim1d    ! 1D size
96      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind   ! input index
97      REAL(wp), DIMENSION(ndim1d) , INTENT(in   ) ::   tab1d     ! input 1D field
98      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   tab2d     ! output 2D field
[2715]99      !
100      INTEGER ::   jn , jid, jjd
101      !!----------------------------------------------------------------------
[825]102      DO jn = 1, ndim1d
[8342]103         jid             = MOD( tab_ind(jn) - 1 ,  jpi ) + 1
104         jjd             =    ( tab_ind(jn) - 1 ) / jpi  + 1
[825]105         tab2d(jid, jjd) = tab1d( jn)
106      END DO
107   END SUBROUTINE tab_1d_2d
108
[2715]109#else
110   !!----------------------------------------------------------------------
111   !!   Default option        Dummy module             NO LIM sea-ice model
112   !!----------------------------------------------------------------------
[825]113#endif
[2715]114   !!======================================================================
[825]115END MODULE limtab
Note: See TracBrowser for help on using the repository browser.