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 NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE – NEMO

source: NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icetab.F90 @ 11238

Last change on this file since 11238 was 10069, checked in by nicolasmartin, 6 years ago

Fix mistakes of previous commit on SVN keywords property

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