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.
lbc_lnk_multi_generic.h90 in branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_multi_generic.h90 @ 9115

Last change on this file since 9115 was 9115, checked in by acc, 6 years ago

Branch 2017/dev_merge_2017. Tidier version of sbcwave.F90 with associated changes in modules. References and schemes for Stokes drift parameterisations have been updated. Choices now are the original Breivik 2014 scheme and the latest Li et al 2017 scheme (which is based on the Breivik et al 2016 Phillips spectrum but with a depth averaged profile). This has been compiled but not yet tested. Also removed trailing spaces in lbc_lnk_multi_generic.h90
File size: 4.6 KB
Line 
1#if defined DIM_2d
2#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j)
3#   define PTR_TYPE              TYPE(PTR_2D)
4#   define PTR_ptab              pt2d
5#endif
6#if defined DIM_3d
7#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k)
8#   define PTR_TYPE              TYPE(PTR_3D)
9#   define PTR_ptab              pt3d
10#endif
11#if defined DIM_4d
12#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k,l)
13#   define PTR_TYPE              TYPE(PTR_4D)
14#   define PTR_ptab              pt4d
15#endif
16   SUBROUTINE ROUTINE_MULTI( pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   &
17      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   &
18      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval)
19      !!---------------------------------------------------------------------
20      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied
21      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::   pt2  ,  pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9
22      CHARACTER(len=1)                     , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points
23      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::   cdna2,  cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9
24      REAL(wp)                             , INTENT(in   ) ::   psgn1   ! sign used across the north fold
25      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   psgn2,  psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9   
26      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only
27      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries)
28      !!
29      INTEGER                         ::   kfld        ! number of elements that will be attributed
30      PTR_TYPE         , DIMENSION(9) ::   ptab_ptr    ! pointer array
31      CHARACTER(len=1) , DIMENSION(9) ::   cdna_ptr    ! nature of ptab_ptr grid-points
32      REAL(wp)         , DIMENSION(9) ::   psgn_ptr    ! sign used across the north fold boundary
33      !!---------------------------------------------------------------------
34      !
35      kfld = 0          ! initial array of pointer size
36      !
37      !                 ! Load the first array
38      CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
39      !
40      !                 ! Look if more arrays are added
41      IF( PRESENT(psgn2) )   CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
42      IF( PRESENT(psgn3) )   CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
43      IF( PRESENT(psgn4) )   CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
44      IF( PRESENT(psgn5) )   CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
45      IF( PRESENT(psgn6) )   CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
46      IF( PRESENT(psgn7) )   CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
47      IF( PRESENT(psgn8) )   CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
48      IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
49      !
50      CALL lbc_lnk_ptr( ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
51      !
52   END SUBROUTINE ROUTINE_MULTI
53
54
55   SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
56      !!---------------------------------------------------------------------
57      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
58      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
59      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
60      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
61      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
62      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
63      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
64      !!---------------------------------------------------------------------
65      !
66      kfld                    =  kfld + 1
67      ptab_ptr(kfld)%PTR_ptab => ptab
68      cdna_ptr(kfld)          =  cdna
69      psgn_ptr(kfld)          =  psgn
70      !
71   END SUBROUTINE ROUTINE_LOAD
72#undef ARRAY_TYPE
73#undef PTR_TYPE
74#undef PTR_ptab
Note: See TracBrowser for help on using the repository browser.