- Timestamp:
- 2012-11-19T16:51:17+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3294 r3609 67 67 PUBLIC mppobc, mpp_ini_ice, mpp_ini_znl 68 68 PUBLIC mppsize 69 PUBLIC mppsend, mpprecv ! needed by ICB routines 69 70 PUBLIC lib_mpp_alloc ! Called in nemogcm.F90 70 71 … … 143 144 144 145 ! Type of send : standard, buffered, immediate 145 CHARACTER(len=1) :: cn_mpi_send = 'S' ! type od mpi send/recieve (S=standard, B=bsend, I=isend)146 LOGICAL :: l_isend = .FALSE. ! isend use indicator (T if cn_mpi_send='I')147 INTEGER :: nn_buffer = 0 ! size of the buffer in case of mpi_bsend146 CHARACTER(len=1) :: cn_mpi_send = 'S' ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 147 LOGICAL , PUBLIC :: l_isend = .FALSE. ! isend use indicator (T if cn_mpi_send='I') 148 INTEGER :: nn_buffer = 0 ! size of the buffer in case of mpi_bsend 148 149 149 150 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend … … 159 160 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ew, t2we ! 2d for east-west & west-east 160 161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2p1, t2p2 ! 2d for north fold 161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo162 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tr2ew, tr2we ! 2d for east-west & west-east + extra outer halo163 162 164 163 ! Arrays used in mpp_lbc_north_3d() … … 207 206 & t2ew(jpj,jpreci ,2) , t2we(jpj,jpreci ,2) , & 208 207 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , & 209 !210 & tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) , &211 & tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) , &212 & tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) , &213 & tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) , &214 208 ! 215 209 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , & … … 947 941 948 942 949 SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )943 SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 950 944 !!---------------------------------------------------------------------- 951 945 !! *** routine mpp_lnk_2d_e *** … … 958 952 !! nlci : first dimension of the local subdomain 959 953 !! nlcj : second dimension of the local subdomain 960 !! jpr 2di: number of rows for extra outer halo961 !! jpr 2dj: number of columns for extra outer halo954 !! jpri : number of rows for extra outer halo 955 !! jprj : number of columns for extra outer halo 962 956 !! nbondi : mark for "east-west local boundary" 963 957 !! nbondj : mark for "north-south local boundary" … … 968 962 !! 969 963 !!---------------------------------------------------------------------- 970 REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) :: pt2d ! 2D array with extra halo 971 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 972 ! ! = T , U , V , F , W and I points 973 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the 974 !! ! north boundary, = 1. otherwise 964 INTEGER , INTENT(in ) :: jpri 965 INTEGER , INTENT(in ) :: jprj 966 REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) :: pt2d ! 2D array with extra halo 967 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 968 ! ! = T , U , V , F , W and I points 969 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the 970 !! ! north boundary, = 1. otherwise 975 971 INTEGER :: jl ! dummy loop indices 976 972 INTEGER :: imigr, iihom, ijhom ! temporary integers … … 978 974 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 979 975 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 980 !!---------------------------------------------------------------------- 981 982 ipreci = jpreci + jpr2di ! take into account outer extra 2D overlap area 983 iprecj = jprecj + jpr2dj 976 !! 977 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 978 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 979 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 980 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 981 !!---------------------------------------------------------------------- 982 983 ipreci = jpreci + jpri ! take into account outer extra 2D overlap area 984 iprecj = jprecj + jprj 984 985 985 986 … … 989 990 ! 990 991 ! !* North-South boundaries (always colsed) 991 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jpr 2dj : jprecj ) = 0.e0 ! south except at F-point992 pt2d(:,nlcj-jprecj+1:jpj+jpr 2dj) = 0.e0 ! north992 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jprj : jprecj ) = 0.e0 ! south except at F-point 993 pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0 ! north 993 994 994 995 ! ! East-West boundaries 995 996 ! !* Cyclic east-west 996 997 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 997 pt2d(1-jpr 2di: 1 ,:) = pt2d(jpim1-jpr2di: jpim1 ,:) ! east998 pt2d( jpi :jpi+jpr 2di,:) = pt2d( 2 :2+jpr2di,:) ! west998 pt2d(1-jpri: 1 ,:) = pt2d(jpim1-jpri: jpim1 ,:) ! east 999 pt2d( jpi :jpi+jpri,:) = pt2d( 2 :2+jpri,:) ! west 999 1000 ! 1000 1001 ELSE !* closed 1001 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpr 2di :jpreci ,:) = 0.e0 ! south except at F-point1002 pt2d(nlci-jpreci+1:jpi+jpr 2di,:) = 0.e0 ! north1002 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0.e0 ! south except at F-point 1003 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0 ! north 1003 1004 ENDIF 1004 1005 ! … … 1009 1010 ! 1010 1011 SELECT CASE ( jpni ) 1011 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jpr 2dj), cd_type, psgn, pr2dj=jpr2dj )1012 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 1012 1013 CASE DEFAULT ; CALL mpp_lbc_north_e( pt2d , cd_type, psgn ) 1013 1014 END SELECT … … 1021 1022 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 1022 1023 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 1023 iihom = nlci-nreci-jpr 2di1024 iihom = nlci-nreci-jpri 1024 1025 DO jl = 1, ipreci 1025 tr2ew(:,jl,1) = pt2d(jpreci+jl,:)1026 tr2we(:,jl,1) = pt2d(iihom +jl,:)1026 r2dew(:,jl,1) = pt2d(jpreci+jl,:) 1027 r2dwe(:,jl,1) = pt2d(iihom +jl,:) 1027 1028 END DO 1028 1029 END SELECT 1029 1030 ! 1030 1031 ! ! Migrations 1031 imigr = ipreci * ( jpj + 2*jpr 2dj)1032 imigr = ipreci * ( jpj + 2*jprj) 1032 1033 ! 1033 1034 SELECT CASE ( nbondi ) 1034 1035 CASE ( -1 ) 1035 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )1036 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )1036 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 1037 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 1037 1038 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1038 1039 CASE ( 0 ) 1039 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )1040 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )1041 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )1042 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe )1040 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 1041 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 1042 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 1043 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 1043 1044 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1044 1045 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1045 1046 CASE ( 1 ) 1046 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )1047 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe )1047 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 1048 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 1048 1049 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1049 1050 END SELECT … … 1055 1056 CASE ( -1 ) 1056 1057 DO jl = 1, ipreci 1057 pt2d(iihom+jl,:) = tr2ew(:,jl,2)1058 pt2d(iihom+jl,:) = r2dew(:,jl,2) 1058 1059 END DO 1059 1060 CASE ( 0 ) 1060 1061 DO jl = 1, ipreci 1061 pt2d(jl-jpr 2di,:) = tr2we(:,jl,2)1062 pt2d( iihom+jl,:) = tr2ew(:,jl,2)1062 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 1063 pt2d( iihom+jl,:) = r2dew(:,jl,2) 1063 1064 END DO 1064 1065 CASE ( 1 ) 1065 1066 DO jl = 1, ipreci 1066 pt2d(jl-jpr 2di,:) = tr2we(:,jl,2)1067 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 1067 1068 END DO 1068 1069 END SELECT … … 1074 1075 ! 1075 1076 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 1076 ijhom = nlcj-nrecj-jpr 2dj1077 ijhom = nlcj-nrecj-jprj 1077 1078 DO jl = 1, iprecj 1078 tr2sn(:,jl,1) = pt2d(:,ijhom +jl)1079 tr2ns(:,jl,1) = pt2d(:,jprecj+jl)1079 r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 1080 r2dns(:,jl,1) = pt2d(:,jprecj+jl) 1080 1081 END DO 1081 1082 ENDIF 1082 1083 ! 1083 1084 ! ! Migrations 1084 imigr = iprecj * ( jpi + 2*jpr 2di )1085 imigr = iprecj * ( jpi + 2*jpri ) 1085 1086 ! 1086 1087 SELECT CASE ( nbondj ) 1087 1088 CASE ( -1 ) 1088 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )1089 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )1089 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 1090 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 1090 1091 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1091 1092 CASE ( 0 ) 1092 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )1093 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )1094 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )1095 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso )1093 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 1094 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 1095 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 1096 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 1096 1097 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1097 1098 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1098 1099 CASE ( 1 ) 1099 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )1100 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso )1100 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 1101 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 1101 1102 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1102 1103 END SELECT … … 1108 1109 CASE ( -1 ) 1109 1110 DO jl = 1, iprecj 1110 pt2d(:,ijhom+jl) = tr2ns(:,jl,2)1111 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 1111 1112 END DO 1112 1113 CASE ( 0 ) 1113 1114 DO jl = 1, iprecj 1114 pt2d(:,jl-jpr 2dj) = tr2sn(:,jl,2)1115 pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)1115 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 1116 pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 1116 1117 END DO 1117 1118 CASE ( 1 ) 1118 1119 DO jl = 1, iprecj 1119 pt2d(:,jl-jpr 2dj) = tr2sn(:,jl,2)1120 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 1120 1121 END DO 1121 1122 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.
