Changeset 6924


Ignore:
Timestamp:
2016-09-09T09:18:21+02:00 (5 years ago)
Author:
timgraham
Message:

Committing fixes for lbclnk when running without key_mpp_mpi (as developed by Miguel and added at a later revision of the trunk).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_HPC_Gyre_benchmark_test/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r6140 r6924  
    8282   END INTERFACE 
    8383   ! 
    84    INTERFACE lbc_sum 
    85       MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
    86    END INTERFACE 
    87  
     84!   INTERFACE lbc_sum 
     85!      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     86!   END INTERFACE 
     87   ! 
     88   INTERFACE lbc_lnk_multi 
     89      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 
     90   END INTERFACE 
     91   ! 
    8892   INTERFACE lbc_lnk_e 
    8993      MODULE PROCEDURE lbc_lnk_2d_e 
     
    97101      MODULE PROCEDURE lbc_lnk_2d_e 
    98102   END INTERFACE 
     103 
     104   TYPE arrayptr 
     105      REAL , DIMENSION (:,:),  POINTER :: pt2d 
     106   END TYPE arrayptr 
     107   PUBLIC   arrayptr 
    99108 
    100109   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
     
    102111   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    103112   PUBLIC   lbc_lnk_icb   ! 
     113   PUBLIC   lbc_lnk_multi 
    104114    
    105115   !!---------------------------------------------------------------------- 
     
    380390   END SUBROUTINE lbc_lnk_2d 
    381391 
     392   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
     393      !! 
     394      INTEGER :: num_fields 
     395      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     396      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
     397      !                                                               ! = T , U , V , F , W and I points 
     398      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
     399      !                                                               ! =  1. , the sign is kept 
     400      ! 
     401      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
     402      ! 
     403      DO ii = 1, num_fields 
     404        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
     405      END DO      
     406      ! 
     407   END SUBROUTINE lbc_lnk_2d_multiple 
     408 
     409   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
     410      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
     411      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
     412      !!--------------------------------------------------------------------- 
     413      ! Second 2D array on which the boundary condition is applied 
     414      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
     415      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
     416      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
     417      ! define the nature of ptab array grid-points 
     418      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
     419      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
     420      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
     421      ! =-1 the sign change across the north fold boundary 
     422      REAL(wp)                                      , INTENT(in   ) ::   psgnA 
     423      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
     424      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
     425      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     426      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     427      !! 
     428      !!--------------------------------------------------------------------- 
     429 
     430      !!The first array 
     431      CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     432 
     433      !! Look if more arrays to process 
     434      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     435      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
     436      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
     437      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
     438      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
     439      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
     440      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
     441      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
     442 
     443   END SUBROUTINE lbc_lnk_2d_9 
     444 
    382445#endif 
    383446 
Note: See TracChangeset for help on using the changeset viewer.