Changeset 888 for trunk/NEMO/OPA_SRC/lib_mpp.F90
- Timestamp:
- 2008-04-11T19:05:03+02:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/lib_mpp.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lib_mpp.F90
r869 r888 48 48 !!---------------------------------------------------------------------- 49 49 !! OPA 9.0 , LOCEAN-IPSL (2005) 50 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/lib_mpp.F90,v 1.21 2007/06/05 10:28:55 opalod Exp $50 !! $Id$ 51 51 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 52 52 !!--------------------------------------------------------------------- … … 278 278 !!---------------------------------------------------------------------- 279 279 !! OPA 9.0 , LOCEAN-IPSL (2005) 280 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/lib_mpp.F90,v 1.21 2007/06/05 10:28:55 opalod Exp $280 !! $Id$ 281 281 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 282 282 !!--------------------------------------------------------------------- … … 605 605 #endif 606 606 607 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp )607 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 608 608 !!---------------------------------------------------------------------- 609 609 !! *** routine mpp_lnk_3d *** … … 640 640 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 641 641 cd_mpp ! fill the overlap area only 642 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 642 643 643 644 !! * Local variables … … 646 647 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 647 648 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 649 REAL(wp) :: zland 648 650 !!---------------------------------------------------------------------- 649 651 650 652 ! 1. standard boundary treatment 651 653 ! ------------------------------ 654 655 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 656 zland = pval 657 ELSE 658 zland = 0.e0 659 ENDIF 652 660 653 661 IF( PRESENT( cd_mpp ) ) THEN … … 670 678 SELECT CASE ( cd_type ) 671 679 CASE ( 'T', 'U', 'V', 'W' ) 672 ptab( 1 :jpreci,:,:) = 0.e0673 ptab(nlci-jpreci+1:jpi ,:,:) = 0.e0680 ptab( 1 :jpreci,:,:) = zland 681 ptab(nlci-jpreci+1:jpi ,:,:) = zland 674 682 CASE ( 'F' ) 675 ptab(nlci-jpreci+1:jpi ,:,:) = 0.e0683 ptab(nlci-jpreci+1:jpi ,:,:) = zland 676 684 END SELECT 677 685 ENDIF … … 681 689 SELECT CASE ( cd_type ) 682 690 CASE ( 'T', 'U', 'V', 'W' ) 683 ptab(:, 1 :jprecj,:) = 0.e0684 ptab(:,nlcj-jprecj+1:jpj ,:) = 0.e0691 ptab(:, 1 :jprecj,:) = zland 692 ptab(:,nlcj-jprecj+1:jpj ,:) = zland 685 693 CASE ( 'F' ) 686 ptab(:,nlcj-jprecj+1:jpj ,:) = 0.e0694 ptab(:,nlcj-jprecj+1:jpj ,:) = zland 687 695 END SELECT 688 696 … … 1058 1066 1059 1067 1060 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp )1068 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 1061 1069 !!---------------------------------------------------------------------- 1062 1070 !! *** routine mpp_lnk_2d *** … … 1092 1100 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 1093 1101 cd_mpp ! fill the overlap area only 1102 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 1094 1103 1095 1104 !! * Local variables … … 1100 1109 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1101 1110 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 1111 REAL(wp) :: zland 1102 1112 !!---------------------------------------------------------------------- 1113 1114 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 1115 zland = pval 1116 ELSE 1117 zland = 0.e0 1118 ENDIF 1103 1119 1104 1120 ! 1. standard boundary treatment … … 1123 1139 SELECT CASE ( cd_type ) 1124 1140 CASE ( 'T', 'U', 'V', 'W' , 'I' ) 1125 pt2d( 1 :jpreci,:) = 0.e01126 pt2d(nlci-jpreci+1:jpi ,:) = 0.e01141 pt2d( 1 :jpreci,:) = zland 1142 pt2d(nlci-jpreci+1:jpi ,:) = zland 1127 1143 CASE ( 'F' ) 1128 pt2d(nlci-jpreci+1:jpi ,:) = 0.e01144 pt2d(nlci-jpreci+1:jpi ,:) = zland 1129 1145 END SELECT 1130 1146 ENDIF … … 1134 1150 SELECT CASE ( cd_type ) 1135 1151 CASE ( 'T', 'U', 'V', 'W' , 'I' ) 1136 pt2d(:, 1 :jprecj) = 0.e01137 pt2d(:,nlcj-jprecj+1:jpj ) = 0.e01152 pt2d(:, 1 :jprecj) = zland 1153 pt2d(:,nlcj-jprecj+1:jpj ) = zland 1138 1154 CASE ( 'F' ) 1139 pt2d(:,nlcj-jprecj+1:jpj ) = 0.e01155 pt2d(:,nlcj-jprecj+1:jpj ) = zland 1140 1156 END SELECT 1141 1157 … … 1402 1418 1403 1419 CASE ( 'I' ) ! ice U-V point 1404 pt2d( 2 ,nlcj) = 0.e01420 pt2d( 2 ,nlcj) = zland 1405 1421 DO ji = 2 , nlci-1 1406 1422 ijt = iloc - ji + 2 … … 3087 3103 INTEGER , INTENT( in ) :: kdim ! size of array 3088 3104 INTEGER , INTENT(inout), DIMENSION(kdim) :: ktab ! input array 3089 INTEGER , INTENT(in) , OPTIONAL:: kcom3105 INTEGER , INTENT(in) , OPTIONAL :: kcom 3090 3106 3091 3107 #if defined key_mpp_shmem … … 3197 3213 INTEGER , INTENT( in ) :: kdim ! size of array 3198 3214 INTEGER , INTENT(inout), DIMENSION(kdim) :: ktab ! input array 3199 INTEGER , INTENT( in), OPTIONAL :: kcom ! input array3215 INTEGER , INTENT( in ), OPTIONAL :: kcom ! input array 3200 3216 3201 3217 #if defined key_mpp_shmem … … 3538 3554 INTEGER , INTENT( in ) :: kdim 3539 3555 REAL(wp), INTENT(inout), DIMENSION(kdim) :: ptab 3540 INTEGER , INTENT( in ), OPTIONAL :: kcom3556 INTEGER , INTENT( in ), OPTIONAL :: kcom 3541 3557 3542 3558 #if defined key_mpp_shmem … … 3595 3611 !! * Arguments 3596 3612 REAL(wp), INTENT(inout) :: ptab ! ??? 3597 INTEGER , INTENT(in), OPTIONAL :: kcom ! ???3613 INTEGER , INTENT( in ), OPTIONAL :: kcom ! ??? 3598 3614 3599 3615 #if defined key_mpp_shmem … … 3703 3719 !! * Arguments 3704 3720 REAL(wp), INTENT( inout ) :: ptab ! 3705 INTEGER ,INTENT(in), OPTIONAL :: kcom3721 INTEGER , INTENT( in ), OPTIONAL :: kcom 3706 3722 3707 3723 #if defined key_mpp_shmem … … 3753 3769 INTEGER , INTENT( in ) :: kdim ! size of ptab 3754 3770 REAL(wp), DIMENSION(kdim), INTENT( inout ) :: ptab ! input array 3755 INTEGER , INTENT(in), OPTIONAL:: kcom3771 INTEGER , INTENT( in ), OPTIONAL :: kcom 3756 3772 3757 3773 #if defined key_mpp_shmem … … 3811 3827 !!----------------------------------------------------------------------- 3812 3828 REAL(wp), INTENT(inout) :: ptab ! input scalar 3813 INTEGER , INTENT(in), OPTIONAL :: kcom3829 INTEGER , INTENT( in ), OPTIONAL :: kcom 3814 3830 3815 3831 #if defined key_mpp_shmem … … 5454 5470 INTEGER :: kdim 5455 5471 INTEGER, OPTIONAL :: kcom 5456 WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1) 5472 WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 5457 5473 END SUBROUTINE mppmax_a_int 5458 5474 … … 5568 5584 END SUBROUTINE mppstop 5569 5585 5570 SUBROUTINE mpp_ini_lim 5571 WRITE(*,*) 'mpp_ini_north: You should not have seen this print! error?' 5572 END SUBROUTINE mpp_ini_lim 5586 SUBROUTINE mpp_ini_ice(kcom) 5587 INTEGER :: kcom 5588 WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?',kcom 5589 END SUBROUTINE mpp_ini_ice 5573 5590 5574 5591 SUBROUTINE mpp_comm_free(kcom) 5575 5592 INTEGER :: kcom 5576 WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?' 5593 WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?',kcom 5577 5594 END SUBROUTINE mpp_comm_free 5578 5595
Note: See TracChangeset
for help on using the changeset viewer.
