Ignore:
Timestamp:
2015-12-15T12:57:15+01:00 (5 years ago)
Author:
mcastril
Message:

Added routines in lbclnk to run in serial mode

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5546_CNRS19_HPC_scalability/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r5579 r6052  
    1111   !!                            the BDY/OBC communications 
    1212   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case   
     13   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi   
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_mpp_mpi 
     
    2425 
    2526   INTERFACE lbc_lnk_multi 
    26       MODULE PROCEDURE mpp_lnk_2d_9 , mpp_lnk_2d_multiple 
     27      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 
    2728   END INTERFACE 
    2829 
     
    8081   END INTERFACE 
    8182 
     83   INTERFACE lbc_lnk_multi 
     84      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 
     85   END INTERFACE 
     86 
    8287   INTERFACE lbc_bdy_lnk 
    8388      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 
     
    8792      MODULE PROCEDURE lbc_lnk_2d_e 
    8893   END INTERFACE 
     94    
     95   TYPE arrayptr 
     96      REAL , DIMENSION (:,:),  POINTER :: pt2d 
     97   END TYPE arrayptr 
     98   PUBLIC   arrayptr 
    8999 
    90100   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
    91101   PUBLIC   lbc_lnk_e  
     102   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions 
    92103   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    93104   PUBLIC   lbc_lnk_icb 
     
    171182      ! 
    172183   END SUBROUTINE lbc_lnk_2d 
     184    
     185   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
     186      !! 
     187      INTEGER :: num_fields 
     188      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     189      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
     190      !                                                               ! = T , U , V , F , W and I points 
     191      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
     192      !                                                               ! =  1. , the sign is kept 
     193      ! 
     194      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
     195      ! 
     196      DO ii = 1, num_fields 
     197        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
     198      END DO      
     199      ! 
     200   END SUBROUTINE lbc_lnk_2d_multiple 
     201 
     202   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
     203      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
     204      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
     205      !!--------------------------------------------------------------------- 
     206      ! Second 2D array on which the boundary condition is applied 
     207      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
     208      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
     209      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
     210      ! define the nature of ptab array grid-points 
     211      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
     212      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
     213      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
     214      ! =-1 the sign change across the north fold boundary 
     215      REAL(wp)                                      , INTENT(in   ) ::   psgnA 
     216      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
     217      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
     218      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     219      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     220      !! 
     221      !!--------------------------------------------------------------------- 
     222 
     223      !!The first array 
     224      CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     225 
     226      !! Look if more arrays to process 
     227      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     228      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
     229      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
     230      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
     231      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
     232      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
     233      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
     234      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
     235 
     236   END SUBROUTINE lbc_lnk_2d_9 
     237 
     238 
     239 
     240 
    173241 
    174242#else 
     
    372440      !     
    373441   END SUBROUTINE lbc_lnk_2d 
     442    
     443   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
     444      !! 
     445      INTEGER :: num_fields 
     446      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     447      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
     448      !                                                               ! = T , U , V , F , W and I points 
     449      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
     450      !                                                               ! =  1. , the sign is kept 
     451      ! 
     452      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
     453      ! 
     454      DO ii = 1, num_fields 
     455        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
     456      END DO      
     457      ! 
     458   END SUBROUTINE lbc_lnk_2d_multiple 
     459 
     460   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
     461      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
     462      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
     463      !!--------------------------------------------------------------------- 
     464      ! Second 2D array on which the boundary condition is applied 
     465      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
     466      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
     467      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
     468      ! define the nature of ptab array grid-points 
     469      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
     470      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
     471      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
     472      ! =-1 the sign change across the north fold boundary 
     473      REAL(wp)                                      , INTENT(in   ) ::   psgnA 
     474      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
     475      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
     476      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     477      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     478      !! 
     479      !!--------------------------------------------------------------------- 
     480 
     481      !!The first array 
     482      CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     483 
     484      !! Look if more arrays to process 
     485      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     486      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
     487      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
     488      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
     489      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
     490      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
     491      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
     492      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
     493 
     494   END SUBROUTINE lbc_lnk_2d_9 
     495 
    374496 
    375497#endif 
     
    441563   !!====================================================================== 
    442564END MODULE lbclnk 
     565 
Note: See TracChangeset for help on using the changeset viewer.