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