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

Last change on this file since 8506 was 8486, checked in by clem, 3 years ago

changes in style - part1 - (now the code looks better txs to Gurvan's comments)

File size: 5.3 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/ICE 4.0 , NEMO Consortium (2017)
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   SUBROUTINE tab_3d_2d( ndim1d, tab_ind, tab1d, tab2d )
33      !!----------------------------------------------------------------------
34      !!                  ***  ROUTINE tab_2d_1d  ***
35      !!----------------------------------------------------------------------
36      INTEGER                         , INTENT(in   ) ::   ndim1d   ! 1d size
37      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind  ! input index
38      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in   ) ::   tab2d    ! input 2D field
39      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(  out) ::   tab1d    ! output 1D field
40      !
41      INTEGER ::   jl, jn, jid, jjd
42      !!----------------------------------------------------------------------
43      DO jl = 1, jpl
44         DO jn = 1, ndim1d
45            jid          = MOD( tab_ind(jn) - 1 , jpi ) + 1
46            jjd          =    ( tab_ind(jn) - 1 ) / jpi + 1
47            tab1d(jn,jl) = tab2d(jid,jjd,jl)
48         END DO
49      END DO
50   END SUBROUTINE tab_3d_2d
51
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
72   SUBROUTINE tab_2d_3d( ndim1d, tab_ind, tab1d, tab2d )
73      !!----------------------------------------------------------------------
74      !!                  ***  ROUTINE tab_2d_1d  ***
75      !!----------------------------------------------------------------------
76      INTEGER                         , INTENT(in   ) ::   ndim1d    ! 1D size
77      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind   ! input index
78      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(in   ) ::   tab1d     ! input 1D field
79      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   tab2d     ! output 2D field
80      !
81      INTEGER ::   jl, jn, jid, jjd
82      !!----------------------------------------------------------------------
83      DO jl = 1, jpl
84         DO jn = 1, ndim1d
85            jid               = MOD( tab_ind(jn) - 1 ,  jpi ) + 1
86            jjd               =    ( tab_ind(jn) - 1 ) / jpi  + 1
87            tab2d(jid,jjd,jl) = tab1d(jn,jl)
88         END DO
89      END DO
90   END SUBROUTINE tab_2d_3d
91
92
93   SUBROUTINE tab_1d_2d( ndim1d, tab_ind, tab1d, tab2d )
94      !!----------------------------------------------------------------------
95      !!                  ***  ROUTINE tab_2d_1d  ***
96      !!----------------------------------------------------------------------
97      INTEGER                     , INTENT(in   ) ::   ndim1d    ! 1D size
98      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind   ! input index
99      REAL(wp), DIMENSION(ndim1d) , INTENT(in   ) ::   tab1d     ! input 1D field
100      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   tab2d     ! output 2D field
101      !
102      INTEGER ::   jn , jid, jjd
103      !!----------------------------------------------------------------------
104      DO jn = 1, ndim1d
105         jid             = MOD( tab_ind(jn) - 1 ,  jpi ) + 1
106         jjd             =    ( tab_ind(jn) - 1 ) / jpi  + 1
107         tab2d(jid, jjd) = tab1d( jn)
108      END DO
109   END SUBROUTINE tab_1d_2d
110
111#else
112   !!----------------------------------------------------------------------
113   !!   Default option           Dummy module      NO LIM 3.0 sea-ice model
114   !!----------------------------------------------------------------------
115#endif
116
117   !!======================================================================
118END MODULE icetab
Note: See TracBrowser for help on using the repository browser.