Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • nemo/nemo
  • sparonuz/nemo
  • hatfield/nemo
  • extdevs/nemo
4 results
Show changes
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 1097 additions and 981 deletions
src/OCE/LBC/lbc_lnk_call_generic.h90
View file @ 31ad4c69
...@@ -27,7 +27,7 @@ ...@@ -27,7 +27,7 @@
& , pt21, cdna21, psgn21, pt22, cdna22, psgn22, pt23, cdna23, psgn23, pt24, cdna24, psgn24 & & , pt21, cdna21, psgn21, pt22, cdna22, psgn22, pt23, cdna23, psgn23, pt24, cdna24, psgn24 &
& , pt25, cdna25, psgn25, pt26, cdna26, psgn26, pt27, cdna27, psgn27, pt28, cdna28, psgn28 & & , pt25, cdna25, psgn25, pt26, cdna26, psgn26, pt27, cdna27, psgn27, pt28, cdna28, psgn28 &
& , pt29, cdna29, psgn29, pt30, cdna30, psgn30 & & , pt29, cdna29, psgn29, pt30, cdna30, psgn30 &
& , kfillmode, pfillval, khls, lsend, lrecv, ld4only ) & , kfillmode, pfillval, lsend, lrecv, ld4only )
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
REAL(PRECISION), DIMENSION(DIMS) , TARGET, CONTIGUOUS, INTENT(inout) :: pt1 ! arrays on which the lbc is applied REAL(PRECISION), DIMENSION(DIMS) , TARGET, CONTIGUOUS, INTENT(inout) :: pt1 ! arrays on which the lbc is applied
...@@ -50,7 +50,6 @@ ...@@ -50,7 +50,6 @@
& psgn30 & psgn30
INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
INTEGER , OPTIONAL , INTENT(in ) :: khls ! halo size, default = nn_hls
LOGICAL, DIMENSION(8), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out LOGICAL, DIMENSION(8), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out
LOGICAL , OPTIONAL , INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) LOGICAL , OPTIONAL , INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners)
!! !!
...@@ -96,15 +95,11 @@ ...@@ -96,15 +95,11 @@
IF( PRESENT(psgn29) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt29, cdna29, psgn29, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) IF( PRESENT(psgn29) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt29, cdna29, psgn29, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
IF( PRESENT(psgn30) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt30, cdna30, psgn30, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) IF( PRESENT(psgn30) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt30, cdna30, psgn30, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
! !
#if ! defined key_mpi2
IF( nn_comm == 1 ) THEN IF( nn_comm == 1 ) THEN
CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
ELSE ELSE
CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
ENDIF ENDIF
#else
CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
#endif
! !
END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION
......
src/OCE/LBC/lbc_lnk_neicoll_generic.h90
View file @ 31ad4c69
This diff is collapsed.
src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
View file @ 31ad4c69
This diff is collapsed.
src/OCE/LBC/lbc_nfd_generic.h90
View file @ 31ad4c69
This diff is collapsed.
src/OCE/LBC/lbclnk.F90
View file @ 31ad4c69
...@@ -38,11 +38,9 @@ MODULE lbclnk ...@@ -38,11 +38,9 @@ MODULE lbclnk
MODULE PROCEDURE lbc_lnk_pt2pt_sp, lbc_lnk_pt2pt_dp MODULE PROCEDURE lbc_lnk_pt2pt_sp, lbc_lnk_pt2pt_dp
END INTERFACE END INTERFACE
#if ! defined key_mpi2
INTERFACE lbc_lnk_neicoll INTERFACE lbc_lnk_neicoll
MODULE PROCEDURE lbc_lnk_neicoll_sp ,lbc_lnk_neicoll_dp MODULE PROCEDURE lbc_lnk_neicoll_sp ,lbc_lnk_neicoll_dp
END INTERFACE END INTERFACE
#endif
! !
INTERFACE lbc_lnk_icb INTERFACE lbc_lnk_icb
MODULE PROCEDURE mpp_lnk_2d_icb_dp, mpp_lnk_2d_icb_sp MODULE PROCEDURE mpp_lnk_2d_icb_dp, mpp_lnk_2d_icb_sp
...@@ -51,10 +49,10 @@ MODULE lbclnk ...@@ -51,10 +49,10 @@ MODULE lbclnk
PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions
PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions
REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp, buffrcv_dp ! MPI send/recv buffers REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp, buffrcv_dp ! MPI send/recv buffers
REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp, buffrcv_sp ! REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp, buffrcv_sp !
INTEGER, DIMENSION(8) :: nreq_p2p ! request id for MPI_Isend in point-2-point communication INTEGER, DIMENSION(8) :: nreq_p2p = MPI_REQUEST_NULL ! request id for MPI_Isend in point-2-point communication
INTEGER :: nreq_nei = MPI_REQUEST_NULL ! request id for mpi_neighbor_ialltoallv
!! * Substitutions !! * Substitutions
!!# include "do_loop_substitute.h90" !!# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
...@@ -134,9 +132,7 @@ CONTAINS ...@@ -134,9 +132,7 @@ CONTAINS
# define BUFFSND buffsnd_sp # define BUFFSND buffsnd_sp
# define BUFFRCV buffrcv_sp # define BUFFRCV buffrcv_sp
# include "lbc_lnk_pt2pt_generic.h90" # include "lbc_lnk_pt2pt_generic.h90"
#if ! defined key_mpi2
# include "lbc_lnk_neicoll_generic.h90" # include "lbc_lnk_neicoll_generic.h90"
#endif
# undef MPI_TYPE # undef MPI_TYPE
# undef BUFFSND # undef BUFFSND
# undef BUFFRCV # undef BUFFRCV
...@@ -149,9 +145,7 @@ CONTAINS ...@@ -149,9 +145,7 @@ CONTAINS
# define BUFFSND buffsnd_dp # define BUFFSND buffsnd_dp
# define BUFFRCV buffrcv_dp # define BUFFRCV buffrcv_dp
# include "lbc_lnk_pt2pt_generic.h90" # include "lbc_lnk_pt2pt_generic.h90"
#if ! defined key_mpi2
# include "lbc_lnk_neicoll_generic.h90" # include "lbc_lnk_neicoll_generic.h90"
#endif
# undef MPI_TYPE # undef MPI_TYPE
# undef BUFFSND # undef BUFFSND
# undef BUFFRCV # undef BUFFRCV
......
src/OCE/LBC/lbcnfd.F90
View file @ 31ad4c69
...@@ -23,8 +23,11 @@ MODULE lbcnfd ...@@ -23,8 +23,11 @@ MODULE lbcnfd
PRIVATE PRIVATE
INTERFACE lbc_nfd ! called by mpp_nfd, lbc_lnk_pt2pt or lbc_lnk_neicoll INTERFACE lbc_nfd ! called by mpp_nfd, lbc_lnk_pt2pt or lbc_lnk_neicoll
MODULE PROCEDURE lbc_nfd_sp, lbc_nfd_ext_sp MODULE PROCEDURE lbc_nfd_sp, lbc_nfd_dp
MODULE PROCEDURE lbc_nfd_dp, lbc_nfd_ext_dp END INTERFACE
INTERFACE lbc_nfd_ext ! called by mpp_lnk_2d_icb
MODULE PROCEDURE lbc_nfd_ext_sp, lbc_nfd_ext_dp
END INTERFACE END INTERFACE
INTERFACE mpp_nfd ! called by lbc_lnk_pt2pt or lbc_lnk_neicoll INTERFACE mpp_nfd ! called by lbc_lnk_pt2pt or lbc_lnk_neicoll
...@@ -33,11 +36,13 @@ MODULE lbcnfd ...@@ -33,11 +36,13 @@ MODULE lbcnfd
PUBLIC mpp_nfd ! mpi north fold conditions PUBLIC mpp_nfd ! mpi north fold conditions
PUBLIC lbc_nfd ! north fold conditions PUBLIC lbc_nfd ! north fold conditions
PUBLIC lbc_nfd_ext ! north fold conditions, called by mpp_lnk_2d_icb
INTEGER, PUBLIC :: nfd_nbnei INTEGER, PUBLIC :: nfd_nbnei
INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (: ) :: nfd_rknei INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (: ) :: nfd_rknei
INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: nfd_rksnd INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: nfd_rksnd
INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: nfd_jisnd INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: nfd_jisnd
LOGICAL, PUBLIC, ALLOCATABLE, DIMENSION (:,: ) :: lnfd_same
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018) !! NEMO/OCE 4.0 , NEMO Consortium (2018)
......
src/OCE/LBC/lib_mpp.F90
View file @ 31ad4c69
...@@ -142,10 +142,10 @@ MODULE lib_mpp ...@@ -142,10 +142,10 @@ MODULE lib_mpp
INTEGER :: MPI_SUMDD INTEGER :: MPI_SUMDD
! Neighbourgs informations ! Neighbourgs informations
INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 3 INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 2
INTEGER, DIMENSION( 8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg) INTEGER, DIMENSION( 8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg)
INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiSnei !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg) INTEGER, DIMENSION(0:n_hlsmax,8), PUBLIC :: mpiSnei !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg)
INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiRnei !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg) INTEGER, DIMENSION(0:n_hlsmax,8), PUBLIC :: mpiRnei !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg)
INTEGER, PARAMETER, PUBLIC :: jpwe = 1 !: WEst INTEGER, PARAMETER, PUBLIC :: jpwe = 1 !: WEst
INTEGER, PARAMETER, PUBLIC :: jpea = 2 !: EAst INTEGER, PARAMETER, PUBLIC :: jpea = 2 !: EAst
INTEGER, PARAMETER, PUBLIC :: jpso = 3 !: SOuth INTEGER, PARAMETER, PUBLIC :: jpso = 3 !: SOuth
...@@ -1127,7 +1127,7 @@ CONTAINS ...@@ -1127,7 +1127,7 @@ CONTAINS
INTEGER :: ierr INTEGER :: ierr
LOGICAL, PARAMETER :: ireord = .FALSE. LOGICAL, PARAMETER :: ireord = .FALSE.
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
#if ! defined key_mpi_off && ! defined key_mpi2 #if ! defined key_mpi_off
iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 ) iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 )
iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 ) iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 )
...@@ -1141,10 +1141,19 @@ CONTAINS ...@@ -1141,10 +1141,19 @@ CONTAINS
iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 ) iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 )
iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 ) iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 )
! Isolated processes (i.e., processes WITH no outgoing or incoming edges, that is, processes that have specied
! indegree and outdegree as zero and thus DO not occur as source or destination rank in the graph specication)
! are allowed.
# if ! defined key_mpi2
CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED, & CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED, &
& MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr ) & MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr )
CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED, & CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED, &
& MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr) & MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr)
# else
mpi_nc_com4(khls) = -1
mpi_nc_com8(khls) = -1
# endif
DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 ) DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 )
#endif #endif
...@@ -1307,7 +1316,7 @@ CONTAINS ...@@ -1307,7 +1316,7 @@ CONTAINS
IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1 IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1
jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2)) jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2))
END DO END DO
WRITE(numcom,'(A,I3)') ' 3D Exchanged halos : ', jk WRITE(numcom,'(A,I3)') ' 3D or 4D Exchanged halos : ', jk
WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf
WRITE(numcom,'(A,I3)') ' from which 3D : ', jj WRITE(numcom,'(A,I3)') ' from which 3D : ', jj
WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj
......
src/OCE/LBC/mpp_lbc_north_icb_generic.h90
View file @ 31ad4c69
...@@ -92,7 +92,7 @@ ...@@ -92,7 +92,7 @@
! 2. North-Fold boundary conditions ! 2. North-Fold boundary conditions
! ---------------------------------- ! ----------------------------------
CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj ) CALL lbc_nfd_ext( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
ij = 1 - kextj ij = 1 - kextj
!! Scatter back to pt2d !! Scatter back to pt2d
......
src/OCE/LBC/mpp_lnk_icb_generic.h90
View file @ 31ad4c69
...@@ -87,7 +87,7 @@ ...@@ -87,7 +87,7 @@
IF( l_IdoNFold ) THEN IF( l_IdoNFold ) THEN
! !
SELECT CASE ( jpni ) SELECT CASE ( jpni )
CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) CASE ( 1 ) ; CALL lbc_nfd_ext ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
CASE DEFAULT ; CALL LBCNORTH ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) CASE DEFAULT ; CALL LBCNORTH ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
END SELECT END SELECT
! !
......
src/OCE/LBC/mpp_loc_generic.h90
View file @ 31ad4c69
...@@ -47,6 +47,7 @@ ...@@ -47,6 +47,7 @@
! !
INTEGER :: ierror, ii, idim INTEGER :: ierror, ii, idim
INTEGER :: index0 INTEGER :: index0
INTEGER :: ihls, ipiglo, ipjglo
INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs
REAL(PRECISION) :: zmin ! local minimum REAL(PRECISION) :: zmin ! local minimum
REAL(PRECISION), DIMENSION(2,1) :: zain, zaout REAL(PRECISION), DIMENSION(2,1) :: zain, zaout
...@@ -60,6 +61,9 @@ ...@@ -60,6 +61,9 @@
ENDIF ENDIF
! !
idim = SIZE(kindex) idim = SIZE(kindex)
ihls = ( SIZE(ARRAY_IN(:,:,:), 1) - Ni_0 ) / 2
ipiglo = Ni0glo + 2*ihls
ipjglo = Nj0glo + 2*ihls
! !
IF ( ANY( MASK_IN(:,:,:) ) ) THEN ! there is at least 1 valid point... IF ( ANY( MASK_IN(:,:,:) ) ) THEN ! there is at least 1 valid point...
! !
...@@ -68,9 +72,9 @@ ...@@ -68,9 +72,9 @@
ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) ) ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) )
zmin = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3)) zmin = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
! !
kindex(1) = mig( ilocs(1) ) kindex(1) = mig( ilocs(1), ihls )
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
kindex(2) = mjg( ilocs(2) ) kindex(2) = mjg( ilocs(2), ihls )
#endif #endif
#if defined DIM_3d /* avoid warning when kindex has 2 elements */ #if defined DIM_3d /* avoid warning when kindex has 2 elements */
kindex(3) = ilocs(3) kindex(3) = ilocs(3)
...@@ -80,10 +84,10 @@ ...@@ -80,10 +84,10 @@
! !
index0 = kindex(1)-1 ! 1d index starting at 0 index0 = kindex(1)-1 ! 1d index starting at 0
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
index0 = index0 + jpiglo * (kindex(2)-1) index0 = index0 + ipiglo * (kindex(2)-1)
#endif #endif
#if defined DIM_3d /* avoid warning when kindex has 2 elements */ #if defined DIM_3d /* avoid warning when kindex has 2 elements */
index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) index0 = index0 + ipiglo * ipjglo * (kindex(3)-1)
#endif #endif
ELSE ELSE
! special case for land processors ! special case for land processors
...@@ -105,20 +109,20 @@ ...@@ -105,20 +109,20 @@
pmin = zaout(1,1) pmin = zaout(1,1)
index0 = NINT( zaout(2,1) ) index0 = NINT( zaout(2,1) )
#if defined DIM_3d /* avoid warning when kindex has 2 elements */ #if defined DIM_3d /* avoid warning when kindex has 2 elements */
kindex(3) = index0 / (jpiglo*jpjglo) kindex(3) = index0 / (ipiglo*ipjglo)
index0 = index0 - kindex(3) * (jpiglo*jpjglo) index0 = index0 - kindex(3) * (ipiglo*ipjglo)
#endif #endif
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
kindex(2) = index0 / jpiglo kindex(2) = index0 / ipiglo
index0 = index0 - kindex(2) * jpiglo index0 = index0 - kindex(2) * ipiglo
#endif #endif
kindex(1) = index0 kindex(1) = index0
kindex(:) = kindex(:) + 1 ! start indices at 1 kindex(:) = kindex(:) + 1 ! start indices at 1
IF( .NOT. llhalo ) THEN IF( .NOT. llhalo ) THEN
kindex(1) = kindex(1) - nn_hls kindex(1) = kindex(1) - ihls
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
kindex(2) = kindex(2) - nn_hls kindex(2) = kindex(2) - ihls
#endif #endif
ENDIF ENDIF
......
src/OCE/LBC/mpp_nfd_generic.h90
View file @ 31ad4c69
This diff is collapsed.
src/OCE/LBC/mppini.F90
View file @ 31ad4c69
This diff is collapsed.
src/OCE/OBS/mpp_map.F90
View file @ 31ad4c69
...@@ -10,8 +10,8 @@ MODULE mpp_map ...@@ -10,8 +10,8 @@ MODULE mpp_map
!! mppmap_init : Initialize mppmap. !! mppmap_init : Initialize mppmap.
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
USE par_kind, ONLY : wp ! Precision variables USE par_kind, ONLY : wp ! Precision variables
USE par_oce , ONLY : jpi, jpj, Nis0, Nie0, Njs0, Nje0 ! Ocean parameters USE par_oce , ONLY : jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls ! Ocean parameters
USE dom_oce , ONLY : mig, mjg, narea ! Ocean space and time domain variables USE dom_oce , ONLY : mig, mjg, narea ! Ocean space and time domain variables
#if ! defined key_mpi_off #if ! defined key_mpi_off
USE lib_mpp , ONLY : mpi_comm_oce ! MPP library USE lib_mpp , ONLY : mpi_comm_oce ! MPP library
#endif #endif
...@@ -64,7 +64,7 @@ INCLUDE 'mpif.h' ...@@ -64,7 +64,7 @@ INCLUDE 'mpif.h'
imppmap(:,:) = 0 imppmap(:,:) = 0
! ! Setup local grid points ! ! Setup local grid points
imppmap(mig(1):mig(jpi),mjg(1):mjg(jpj)) = narea imppmap(mig(1,nn_hls):mig(jpi,nn_hls),mjg(1,nn_hls):mjg(jpj,nn_hls)) = narea
! Get global data ! Get global data
......
src/OCE/OBS/obs_grd_bruteforce.h90
View file @ 31ad4c69
...@@ -111,9 +111,9 @@ ...@@ -111,9 +111,9 @@
zmskg(:,:) = -1.e+10 zmskg(:,:) = -1.e+10
DO jj = kldj, klej DO jj = kldj, klej
DO ji = kldi, klei DO ji = kldi, klei
zlamg(mig(ji),mjg(jj)) = pglam(ji,jj) zlamg(mig(ji,nn_hls),mjg(jj,nn_hls)) = pglam(ji,jj)
zphig(mig(ji),mjg(jj)) = pgphi(ji,jj) zphig(mig(ji,nn_hls),mjg(jj,nn_hls)) = pgphi(ji,jj)
zmskg(mig(ji),mjg(jj)) = pmask(ji,jj) zmskg(mig(ji,nn_hls),mjg(jj,nn_hls)) = pmask(ji,jj)
END DO END DO
END DO END DO
CALL mpp_global_max( zlamg ) CALL mpp_global_max( zlamg )
......
src/OCE/OBS/obs_grid.F90
View file @ 31ad4c69
...@@ -280,9 +280,9 @@ CONTAINS ...@@ -280,9 +280,9 @@ CONTAINS
! Add various grids here. ! Add various grids here.
DO jj = 1, jpj DO jj = 1, jpj
DO ji = 1, jpi DO ji = 1, jpi
zlamg(mig(ji),mjg(jj)) = glamt(ji,jj) zlamg(mig(ji,nn_hls),mjg(jj,nn_hls)) = glamt(ji,jj)
zphig(mig(ji),mjg(jj)) = gphit(ji,jj) zphig(mig(ji,nn_hls),mjg(jj,nn_hls)) = gphit(ji,jj)
zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1) zmskg(mig(ji,nn_hls),mjg(jj,nn_hls)) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_global_max( zlamg ) CALL mpp_global_max( zlamg )
......
src/OCE/OBS/obs_inter_sup.F90
View file @ 31ad4c69
...@@ -279,8 +279,8 @@ CONTAINS ...@@ -279,8 +279,8 @@ CONTAINS
! Pack interpolation data to be sent ! Pack interpolation data to be sent
DO ji = 1, itot DO ji = 1, itot
ii = mi1(igrdij_recv(2*ji-1)) ii = mi1(igrdij_recv(2*ji-1),nn_hls)
ij = mj1(igrdij_recv(2*ji)) ij = mj1(igrdij_recv(2*ji ),nn_hls)
DO jk = 1, kpk DO jk = 1, kpk
zsend(jk,ji) = pval(ii,ij,jk) zsend(jk,ji) = pval(ii,ij,jk)
END DO END DO
......
src/OCE/OBS/obs_write.F90
View file @ 31ad4c69
...@@ -245,8 +245,8 @@ CONTAINS ...@@ -245,8 +245,8 @@ CONTAINS
fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar) fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar) fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
ELSE ELSE
fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar)) fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar),nn_hls)
fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar)) fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar),nn_hls)
ENDIF ENDIF
END DO END DO
CALL greg2jul( 0, & CALL greg2jul( 0, &
...@@ -511,8 +511,8 @@ CONTAINS ...@@ -511,8 +511,8 @@ CONTAINS
fbdata%iobsi(jo,1) = surfdata%mi(jo) fbdata%iobsi(jo,1) = surfdata%mi(jo)
fbdata%iobsj(jo,1) = surfdata%mj(jo) fbdata%iobsj(jo,1) = surfdata%mj(jo)
ELSE ELSE
fbdata%iobsi(jo,1) = mig(surfdata%mi(jo)) fbdata%iobsi(jo,1) = mig(surfdata%mi(jo),nn_hls)
fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo)) fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo),nn_hls)
ENDIF ENDIF
CALL greg2jul( 0, & CALL greg2jul( 0, &
& surfdata%nmin(jo), & & surfdata%nmin(jo), &
......
src/OCE/SBC/cpl_oasis3.F90
View file @ 31ad4c69
...@@ -64,7 +64,6 @@ MODULE cpl_oasis3 ...@@ -64,7 +64,6 @@ MODULE cpl_oasis3
INTEGER :: nrcv ! total number of fields received INTEGER :: nrcv ! total number of fields received
INTEGER :: nsnd ! total number of fields sent INTEGER :: nsnd ! total number of fields sent
INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
INTEGER, PUBLIC, PARAMETER :: nmaxfld=62 ! Maximum number of coupling fields
INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields
INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields
...@@ -78,7 +77,7 @@ MODULE cpl_oasis3 ...@@ -78,7 +77,7 @@ MODULE cpl_oasis3
INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received
END TYPE FLD_CPL END TYPE FLD_CPL
TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields TYPE(FLD_CPL), DIMENSION(:), ALLOCATABLE, PUBLIC :: srcv, ssnd !: Coupling fields
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving
...@@ -153,15 +152,6 @@ CONTAINS ...@@ -153,15 +152,6 @@ CONTAINS
CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN
ENDIF ENDIF
nrcv = krcv
IF( nrcv > nmaxfld ) THEN
CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN
ENDIF
nsnd = ksnd
IF( nsnd > nmaxfld ) THEN
CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN
ENDIF
! !
! ... Define the shape for the area that excludes the halo as we don't want them to be "seen" by oasis ! ... Define the shape for the area that excludes the halo as we don't want them to be "seen" by oasis
! !
...@@ -181,11 +171,11 @@ CONTAINS ...@@ -181,11 +171,11 @@ CONTAINS
! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis
! ----------------------------------------------------------------- ! -----------------------------------------------------------------
paral(1) = 2 ! box partitioning paral(1) = 2 ! box partitioning
paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos paral(2) = Ni0glo * mjg(nn_hls,0) + mig(nn_hls,0) ! NEMO lower left corner global offset, without halos
paral(3) = Ni_0 ! local extent in i, excluding halos paral(3) = Ni_0 ! local extent in i, excluding halos
paral(4) = Nj_0 ! local extent in j, excluding halos paral(4) = Nj_0 ! local extent in j, excluding halos
paral(5) = Ni0glo ! global extent in x, excluding halos paral(5) = Ni0glo ! global extent in x, excluding halos
IF( sn_cfctl%l_oasout ) THEN IF( sn_cfctl%l_oasout ) THEN
WRITE(numout,*) ' multiexchg: paral (1:5)', paral WRITE(numout,*) ' multiexchg: paral (1:5)', paral
...@@ -419,6 +409,7 @@ CONTAINS ...@@ -419,6 +409,7 @@ CONTAINS
IF( .NOT. ll_1st ) THEN IF( .NOT. ll_1st ) THEN
CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )
ENDIF ENDIF
!!clem: mettre T instead of clgrid
ENDDO ENDDO
! !
......
src/OCE/SBC/sbc_ice.F90
View file @ 31ad4c69
...@@ -50,8 +50,8 @@ MODULE sbc_ice ...@@ -50,8 +50,8 @@ MODULE sbc_ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice !: heat conduction flux in the layer below surface [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice !: heat conduction flux in the layer below surface [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_top !: solar flux transmitted below the ice surface [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_top !: solar flux transmitted below the ice surface [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. T-pts [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. T-pts [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt
......
src/OCE/SBC/sbc_oce.F90
View file @ 31ad4c69
...@@ -103,34 +103,36 @@ MODULE sbc_oce ...@@ -103,34 +103,36 @@ MODULE sbc_oce
INTEGER , PUBLIC :: ncpl_qsr_freq = 0 !: qsr coupling frequency per days from atmosphere (used by top) INTEGER , PUBLIC :: ncpl_qsr_freq = 0 !: qsr coupling frequency per days from atmosphere (used by top)
! !
!! !! now ! before !! !! !! now ! before !!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau , utau_b !: sea surface i-stress (ocean referential) [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau !: sea surface i-stress (ocean referential) T-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau , vtau_b !: sea surface j-stress (ocean referential) [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau !: sea surface j-stress (ocean referential) T-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_icb, vtau_icb !: sea surface (i,j)-stress used by icebergs [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utauU , utau_b !: sea surface i-stress (ocean referential) U-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: taum !: module of sea surface stress (at T-point) [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtauV , vtau_b !: sea surface j-stress (ocean referential) V-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_icb, vtau_icb !: sea surface (i,j)-stress used by icebergs [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: taum !: module of sea surface stress (at T-point) [N/m2]
!! wndm is used compute surface gases exchanges in ice-free ocean or leads !! wndm is used compute surface gases exchanges in ice-free ocean or leads
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhoa !: air density at "rn_zu" m above the sea [kg/m3] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhoa !: air density at "rn_zu" m above the sea [kg/m3]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_tot !: total non solar heat flux (over sea and ice) [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_tot !: total non solar heat flux (over sea and ice) [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp , emp_b !: freshwater budget: volume flux [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp , emp_b !: freshwater budget: volume flux [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx , sfx_b !: salt flux [PSS.kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx , sfx_b !: salt flux [PSS.kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb , fwficb_b !: iceberg melting [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb , fwficb_b !: iceberg melting [Kg/m2/s]
!! !!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_hc , qsr_hc_b !: heat content trend due to qsr flux [K.m/s] jpi,jpj,jpk REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_hc , qsr_hc_b !: heat content trend due to qsr flux [K.m/s] jpi,jpj,jpk
!! !!
!! !!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tprecip !: total precipitation [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tprecip !: total precipitation [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-]
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
!! ABL Vertical Domain size !! ABL Vertical Domain size
...@@ -177,8 +179,8 @@ CONTAINS ...@@ -177,8 +179,8 @@ CONTAINS
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
ierr(:) = 0 ierr(:) = 0
! !
ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) , & ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , utauU(jpi,jpj) , taum(jpi,jpj) , &
& vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) ) & vtau(jpi,jpj) , vtau_b(jpi,jpj) , vtauV(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )
! !
ALLOCATE( qns_tot(jpi,jpj) , qns (jpi,jpj) , qns_b(jpi,jpj), & ALLOCATE( qns_tot(jpi,jpj) , qns (jpi,jpj) , qns_b(jpi,jpj), &
& qsr_tot(jpi,jpj) , qsr (jpi,jpj) , & & qsr_tot(jpi,jpj) , qsr (jpi,jpj) , &
...@@ -205,9 +207,10 @@ CONTAINS ...@@ -205,9 +207,10 @@ CONTAINS
END FUNCTION sbc_oce_alloc END FUNCTION sbc_oce_alloc
!!clem => this subroutine is never used in nemo
SUBROUTINE sbc_tau2wnd SUBROUTINE sbc_tau2wnd
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
!! *** ROUTINE sbc_tau2wnd *** !! *** ROUTINE ***
!! !!
!! ** Purpose : Estimation of wind speed as a function of wind stress !! ** Purpose : Estimation of wind speed as a function of wind stress
!! !!
...@@ -217,17 +220,14 @@ CONTAINS ...@@ -217,17 +220,14 @@ CONTAINS
USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE lbclnk ! ocean lateral boundary conditions (or mpp link)
REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
REAL(wp) :: ztx, zty, ztau, zcoef ! temporary variables REAL(wp) :: ztau, zcoef ! temporary variables
INTEGER :: ji, jj ! dummy indices INTEGER :: ji, jj ! dummy indices
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
zcoef = 0.5 / ( zrhoa * zcdrag ) zcoef = 0.5 / ( zrhoa * zcdrag )
DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
ztx = utau(ji-1,jj ) + utau(ji,jj) ztau = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) )
zty = vtau(ji ,jj-1) + vtau(ji,jj)
ztau = SQRT( ztx * ztx + zty * zty )
wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1) wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
END_2D END_2D
CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1.0_wp )
! !
END SUBROUTINE sbc_tau2wnd END SUBROUTINE sbc_tau2wnd
......