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

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icetab.F90 @ 8426

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

changing names

File size: 5.0 KB
Line 
1MODULE icetab
2   !!======================================================================
3   !!                       ***  MODULE icetab   ***
4   !!   LIM ice model : transform 1D (2D) array to a 2D (1D) table
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3'                                      LIM3 sea-ice model
9   !!----------------------------------------------------------------------
10   !!   tab_2d_1d  : 2-D <==> 1-D
11   !!   tab_1d_2d  : 1-D <==> 2-D
12   !!----------------------------------------------------------------------
13   USE par_kind
14   USE par_oce
15   USE ice, ONLY : jpl
16   
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC   tab_3d_2d
21   PUBLIC   tab_2d_1d
22   PUBLIC   tab_2d_3d
23   PUBLIC   tab_1d_2d
24
25   !!----------------------------------------------------------------------
26   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
27   !! $Id: icetab.F90 8369 2017-07-25 14:38:38Z clem $
28   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
29   !!----------------------------------------------------------------------
30CONTAINS
31
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
53   SUBROUTINE tab_2d_1d( ndim1d, tab_ind, tab1d, tab2d )
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tab_2d_1d  ***
56      !!----------------------------------------------------------------------
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
61      !
62      INTEGER ::   jn , jid, jjd
63      !!----------------------------------------------------------------------
64      DO jn = 1, ndim1d
65         jid        = MOD( tab_ind(jn) - 1 , jpi ) + 1
66         jjd        =    ( tab_ind(jn) - 1 ) / jpi + 1
67         tab1d( jn) = tab2d( jid, jjd)
68      END DO
69   END SUBROUTINE tab_2d_1d
70
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
90
91   SUBROUTINE tab_1d_2d( ndim1d, tab_ind, tab1d, tab2d )
92      !!----------------------------------------------------------------------
93      !!                  ***  ROUTINE tab_2d_1d  ***
94      !!----------------------------------------------------------------------
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
99      !
100      INTEGER ::   jn , jid, jjd
101      !!----------------------------------------------------------------------
102      DO jn = 1, ndim1d
103         jid             = MOD( tab_ind(jn) - 1 ,  jpi ) + 1
104         jjd             =    ( tab_ind(jn) - 1 ) / jpi  + 1
105         tab2d(jid, jjd) = tab1d( jn)
106      END DO
107   END SUBROUTINE tab_1d_2d
108
109#endif
110   !!======================================================================
111END MODULE icetab
Note: See TracBrowser for help on using the repository browser.