Newer
Older
MODULE icetab
!!======================================================================
!! *** MODULE icetab ***
!! sea-ice : transform 1D (2D) array to a 2D (1D) table
!!======================================================================
!! History : 4.0 ! 2018 (C. Rousset) Original code SI3
!!----------------------------------------------------------------------
#if defined key_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_4d_3d
PUBLIC tab_3d_4d
PUBLIC tab_2d_3d
PUBLIC tab_1d_2d
!!----------------------------------------------------------------------
!! NEMO/ICE 4.0 , NEMO Consortium (2018)
!! $Id: icetab.F90 14072 2020-12-04 07:48:38Z laurent $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE tab_4d_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(:,:,:,:), INTENT(in ) :: tab2d ! input 2D field
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: tab1d ! output 1D field
!
INTEGER :: ipi, ipj, ipk, ji0, jj0, jk, jl, jn, jid, jjd
!!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
ipk = SIZE(tab2d,3) ! 3d dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
DO jl = 1, jpl
DO jk = 1, ipk
tab1d(jn,jk,jl) = tab2d(jid,jjd,jk,jl)
END DO
END DO
END DO
!
END SUBROUTINE tab_4d_3d
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(:,:,:) , INTENT(in ) :: tab2d ! input 2D field
REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(inout) :: tab1d ! output 1D field
!
INTEGER :: ipi, ipj, ji0, jj0, jl, jn, jid, jjd
!!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
DO jl = 1, jpl
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(:,:) , INTENT(in ) :: tab2d ! input 2D field
REAL(wp), DIMENSION(ndim1d) , INTENT(inout) :: tab1d ! output 1D field
!
INTEGER :: ipi, ipj, ji0, jj0, jn, jid, jjd
!!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab1d( jn) = tab2d( jid, jjd)
END DO
END SUBROUTINE tab_2d_1d
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
SUBROUTINE tab_3d_4d( 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(:,:,:) , INTENT(in ) :: tab1d ! input 1D field
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: tab2d ! output 2D field
!
INTEGER :: ipi, ipj, ipk, ji0, jj0, jk, jl, jn, jid, jjd
!!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
ipk = SIZE(tab2d,3) ! 3d dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
DO jl = 1, jpl
DO jk = 1, ipk
tab2d(jid,jjd,jk,jl) = tab1d(jn,jk,jl)
END DO
END DO
END DO
!
END SUBROUTINE tab_3d_4d
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(:,:,:) , INTENT(inout) :: tab2d ! output 2D field
INTEGER :: ipi, ipj, ji0, jj0, jl, jn, jid, jjd
!!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
DO jl = 1, jpl
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(:,:) , INTENT(inout) :: tab2d ! output 2D field
INTEGER :: ipi, ipj, ji0, jj0, jn, jid, jjd
!!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab2d(jid, jjd) = tab1d( jn)
END DO
END SUBROUTINE tab_1d_2d
#else
!!----------------------------------------------------------------------
!! Default option Dummy module NO SI3 sea-ice model
!!----------------------------------------------------------------------
#endif
!!======================================================================
END MODULE icetab