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 @ 8534

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

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