- Timestamp:
- 2020-08-18T17:58:08+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC/mpp_nfd_generic.h90
r13290 r13411 106 106 REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthglo 107 107 !!---------------------------------------------------------------------- 108 #if defined key_mpp_mpi 108 109 ! 109 110 ipk = K_SIZE(ptab) ! 3rd dimension … … 395 396 ENDIF ! l_north_nogather 396 397 ! 398 #endif 397 399 END SUBROUTINE ROUTINE_NFD 398 400 -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC/mppini.F90
r13305 r13411 62 62 !!---------------------------------------------------------------------- 63 63 ! 64 jpiglo = Ni0glo 65 jpjglo = Nj0glo 64 nn_hls = 1 65 jpiglo = Ni0glo + 2 * nn_hls 66 jpjglo = Nj0glo + 2 * nn_hls 66 67 jpimax = jpiglo 67 68 jpjmax = jpjglo … … 79 80 jpnj = 1 80 81 jpnij = jpni*jpnj 81 nn_hls = 182 82 nimpp = 1 83 83 njmpp = 1 … … 675 675 ! 676 676 END SUBROUTINE mpp_init 677 678 679 SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)680 !!----------------------------------------------------------------------681 !! *** ROUTINE mpp_basesplit ***682 !!683 !! ** Purpose : Lay out the global domain over processors.684 !!685 !! ** Method : Global domain is distributed in smaller local domains.686 !!687 !! ** Action : - set for all knbi*knbj domains:688 !! kimppt : longitudinal index689 !! kjmppt : latitudinal index690 !! klci : first dimension691 !! klcj : second dimension692 !!----------------------------------------------------------------------693 INTEGER, INTENT(in ) :: kiglo, kjglo694 INTEGER, INTENT(in ) :: khls695 INTEGER, INTENT(in ) :: knbi, knbj696 INTEGER, INTENT( out) :: kimax, kjmax697 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: kimppt, kjmppt698 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: klci, klcj699 !700 INTEGER :: ji, jj701 INTEGER :: i2hls702 INTEGER :: iresti, irestj, irm, ijpjmin703 !!----------------------------------------------------------------------704 i2hls = 2*khls705 !706 #if defined key_nemocice_decomp707 kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls ! first dim.708 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim.709 #else710 kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls ! first dim.711 kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls ! second dim.712 #endif713 IF( .NOT. PRESENT(kimppt) ) RETURN714 !715 ! 1. Dimension arrays for subdomains716 ! -----------------------------------717 ! Computation of local domain sizes klci() klcj()718 ! These dimensions depend on global sizes knbi,knbj and kiglo,kjglo719 ! The subdomains are squares lesser than or equal to the global720 ! dimensions divided by the number of processors minus the overlap array.721 !722 iresti = 1 + MOD( kiglo - i2hls - 1 , knbi )723 irestj = 1 + MOD( kjglo - i2hls - 1 , knbj )724 !725 ! Need to use kimax and kjmax here since jpi and jpj not yet defined726 #if defined key_nemocice_decomp727 ! Change padding to be consistent with CICE728 klci(1:knbi-1,: ) = kimax729 klci( knbi ,: ) = kiglo - (knbi - 1) * (kimax - i2hls)730 klcj(: ,1:knbj-1) = kjmax731 klcj(: , knbj ) = kjglo - (knbj - 1) * (kjmax - i2hls)732 #else733 klci(1:iresti ,:) = kimax734 klci(iresti+1:knbi ,:) = kimax-1735 IF( MINVAL(klci) < 2*i2hls ) THEN736 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls737 WRITE(ctmp2,*) ' We have ', MINVAL(klci)738 CALL ctl_stop( 'STOP', ctmp1, ctmp2 )739 ENDIF740 IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN741 ! minimize the size of the last row to compensate for the north pole folding coast742 IF( jperio == 3 .OR. jperio == 4 ) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos743 IF( jperio == 5 .OR. jperio == 6 ) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos744 irm = knbj - irestj ! total number of lines to be removed745 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row746 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove747 irestj = knbj - 1 - irm748 klcj(:, irestj+1:knbj-1) = kjmax-1749 ELSE750 klcj(:, irestj+1:knbj ) = kjmax-1751 ENDIF752 klcj(:,1:irestj) = kjmax753 IF( MINVAL(klcj) < 2*i2hls ) THEN754 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls755 WRITE(ctmp2,*) ' We have ', MINVAL(klcj)756 CALL ctl_stop( 'STOP', ctmp1, ctmp2 )757 ENDIF758 #endif759 760 ! 2. Index arrays for subdomains761 ! -------------------------------762 kimppt(:,:) = 1763 kjmppt(:,:) = 1764 !765 IF( knbi > 1 ) THEN766 DO jj = 1, knbj767 DO ji = 2, knbi768 kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls769 END DO770 END DO771 ENDIF772 !773 IF( knbj > 1 )THEN774 DO jj = 2, knbj775 DO ji = 1, knbi776 kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls777 END DO778 END DO779 ENDIF780 781 END SUBROUTINE mpp_basesplit782 677 783 678 … … 1027 922 ! 1028 923 END SUBROUTINE mpp_init_landprop 1029 1030 924 925 926 SUBROUTINE init_ioipsl 927 !!---------------------------------------------------------------------- 928 !! *** ROUTINE init_ioipsl *** 929 !! 930 !! ** Purpose : 931 !! 932 !! ** Method : 933 !! 934 !! History : 935 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 936 !! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij 937 !!---------------------------------------------------------------------- 938 INTEGER, DIMENSION(2) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 939 !!---------------------------------------------------------------------- 940 941 ! The domain is split only horizontally along i- or/and j- direction 942 ! So we need at the most only 1D arrays with 2 elements. 943 ! Set idompar values equivalent to the jpdom_local_noextra definition 944 ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 945 iglo( :) = (/ Ni0glo, Nj0glo /) 946 iloc( :) = (/ Ni_0 , Nj_0 /) 947 iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig0(Nis0) but mig0 is not yet defined! 948 iabsl(:) = iabsf(:) + iloc(:) - 1 949 ihals(:) = (/ 0 , 0 /) 950 ihale(:) = (/ 0 , 0 /) 951 idid( :) = (/ 1 , 2 /) 952 953 IF(lwp) THEN 954 WRITE(numout,*) 955 WRITE(numout,*) 'mpp init_ioipsl : iloc = ', iloc 956 WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf 957 WRITE(numout,*) ' ihals = ', ihals 958 WRITE(numout,*) ' ihale = ', ihale 959 ENDIF 960 ! 961 CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 962 ! 963 END SUBROUTINE init_ioipsl 964 965 966 SUBROUTINE init_nfdcom 967 !!---------------------------------------------------------------------- 968 !! *** ROUTINE init_nfdcom *** 969 !! ** Purpose : Setup for north fold exchanges with explicit 970 !! point-to-point messaging 971 !! 972 !! ** Method : Initialization of the northern neighbours lists. 973 !!---------------------------------------------------------------------- 974 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 975 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 976 !!---------------------------------------------------------------------- 977 INTEGER :: sxM, dxM, sxT, dxT, jn 978 !!---------------------------------------------------------------------- 979 ! 980 !initializes the north-fold communication variables 981 isendto(:) = 0 982 nsndto = 0 983 ! 984 IF ( njmpp == MAXVAL( njmppt ) ) THEN ! if I am a process in the north 985 ! 986 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 987 sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 988 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 989 dxM = jpiglo - nimppt(narea) + 2 990 ! 991 ! loop over the other north-fold processes to find the processes 992 ! managing the points belonging to the sxT-dxT range 993 ! 994 DO jn = 1, jpni 995 ! 996 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process 997 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process 998 ! 999 IF ( sxT < sxM .AND. sxM < dxT ) THEN 1000 nsndto = nsndto + 1 1001 isendto(nsndto) = jn 1002 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 1003 nsndto = nsndto + 1 1004 isendto(nsndto) = jn 1005 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 1006 nsndto = nsndto + 1 1007 isendto(nsndto) = jn 1008 ENDIF 1009 ! 1010 END DO 1011 ! 1012 ENDIF 1013 l_north_nogather = .TRUE. 1014 ! 1015 END SUBROUTINE init_nfdcom 1016 1017 #endif 1018 1019 SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 1020 !!---------------------------------------------------------------------- 1021 !! *** ROUTINE mpp_basesplit *** 1022 !! 1023 !! ** Purpose : Lay out the global domain over processors. 1024 !! 1025 !! ** Method : Global domain is distributed in smaller local domains. 1026 !! 1027 !! ** Action : - set for all knbi*knbj domains: 1028 !! kimppt : longitudinal index 1029 !! kjmppt : latitudinal index 1030 !! klci : first dimension 1031 !! klcj : second dimension 1032 !!---------------------------------------------------------------------- 1033 INTEGER, INTENT(in ) :: kiglo, kjglo 1034 INTEGER, INTENT(in ) :: khls 1035 INTEGER, INTENT(in ) :: knbi, knbj 1036 INTEGER, INTENT( out) :: kimax, kjmax 1037 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: kimppt, kjmppt 1038 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: klci, klcj 1039 ! 1040 INTEGER :: ji, jj 1041 INTEGER :: i2hls 1042 INTEGER :: iresti, irestj, irm, ijpjmin 1043 !!---------------------------------------------------------------------- 1044 i2hls = 2*khls 1045 ! 1046 #if defined key_nemocice_decomp 1047 kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 1048 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 1049 #else 1050 kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 1051 kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 1052 #endif 1053 IF( .NOT. PRESENT(kimppt) ) RETURN 1054 ! 1055 ! 1. Dimension arrays for subdomains 1056 ! ----------------------------------- 1057 ! Computation of local domain sizes klci() klcj() 1058 ! These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 1059 ! The subdomains are squares lesser than or equal to the global 1060 ! dimensions divided by the number of processors minus the overlap array. 1061 ! 1062 iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 1063 irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 1064 ! 1065 ! Need to use kimax and kjmax here since jpi and jpj not yet defined 1066 #if defined key_nemocice_decomp 1067 ! Change padding to be consistent with CICE 1068 klci(1:knbi-1,: ) = kimax 1069 klci( knbi ,: ) = kiglo - (knbi - 1) * (kimax - i2hls) 1070 klcj(: ,1:knbj-1) = kjmax 1071 klcj(: , knbj ) = kjglo - (knbj - 1) * (kjmax - i2hls) 1072 #else 1073 klci(1:iresti ,:) = kimax 1074 klci(iresti+1:knbi ,:) = kimax-1 1075 IF( MINVAL(klci) < 2*i2hls ) THEN 1076 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 1077 WRITE(ctmp2,*) ' We have ', MINVAL(klci) 1078 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 1079 ENDIF 1080 IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 1081 ! minimize the size of the last row to compensate for the north pole folding coast 1082 IF( jperio == 3 .OR. jperio == 4 ) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos 1083 IF( jperio == 5 .OR. jperio == 6 ) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos 1084 irm = knbj - irestj ! total number of lines to be removed 1085 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row 1086 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 1087 irestj = knbj - 1 - irm 1088 klcj(:, irestj+1:knbj-1) = kjmax-1 1089 ELSE 1090 klcj(:, irestj+1:knbj ) = kjmax-1 1091 ENDIF 1092 klcj(:,1:irestj) = kjmax 1093 IF( MINVAL(klcj) < 2*i2hls ) THEN 1094 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 1095 WRITE(ctmp2,*) ' We have ', MINVAL(klcj) 1096 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 1097 ENDIF 1098 #endif 1099 1100 ! 2. Index arrays for subdomains 1101 ! ------------------------------- 1102 kimppt(:,:) = 1 1103 kjmppt(:,:) = 1 1104 ! 1105 IF( knbi > 1 ) THEN 1106 DO jj = 1, knbj 1107 DO ji = 2, knbi 1108 kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls 1109 END DO 1110 END DO 1111 ENDIF 1112 ! 1113 IF( knbj > 1 )THEN 1114 DO jj = 2, knbj 1115 DO ji = 1, knbi 1116 kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls 1117 END DO 1118 END DO 1119 ENDIF 1120 1121 END SUBROUTINE mpp_basesplit 1122 1123 1031 1124 SUBROUTINE mpp_is_ocean( ldisoce ) 1032 1125 !!---------------------------------------------------------------------- … … 1044 1137 !! ** Method : read inbj strips (of length Ni0glo) of the land-sea mask 1045 1138 !!---------------------------------------------------------------------- 1046 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1139 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1047 1140 ! 1048 1141 INTEGER :: idiv, iimax, ijmax, iarea … … 1053 1146 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi 1054 1147 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj 1055 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1148 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1056 1149 !!---------------------------------------------------------------------- 1057 1150 ! do nothing if there is no land-sea mask … … 1086 1179 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1087 1180 CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip 1088 ! 1181 ! 1089 1182 IF( iarea == 1 ) THEN ! the first line was not read 1090 1183 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity … … 1097 1190 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity 1098 1191 CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce 1099 ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN ! north-pole folding T-pivot, T-point 1192 ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN ! north-pole folding T-pivot, T-point 1100 1193 lloce(2,iny) = lloce(2,iny-2) ! here we have 1 halo (even if nn_hls>1) 1101 1194 DO ji = 3,inx-1 … … 1131 1224 ENDIF 1132 1225 END DO 1133 1226 1134 1227 inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 1135 1228 CALL mpp_sum( 'mppini', inboce_1d ) … … 1139 1232 ! 1140 1233 END SUBROUTINE mpp_is_ocean 1141 1142 1143 SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce )1144 !!----------------------------------------------------------------------1145 !! *** ROUTINE readbot_strip ***1146 !!1147 !! ** Purpose : Read relevant bathymetric information in order to1148 !! provide a land/sea mask used for the elimination1149 !! of land domains, in an mpp computation.1150 !!1151 !! ** Method : read stipe of size (Ni0glo,...)1152 !!----------------------------------------------------------------------1153 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading1154 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read1155 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean1156 !1157 INTEGER :: inumsave ! local logical unit1158 REAL(wp), DIMENSION(Ni0glo,kjcnt) :: zbot, zbdy1159 !!----------------------------------------------------------------------1160 !1161 inumsave = numout ; numout = numnul ! redirect all print to /dev/null1162 !1163 IF( numbot /= -1 ) THEN1164 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1165 ELSE1166 zbot(:,:) = 1._wp ! put a non-null value1167 ENDIF1168 !1169 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists1170 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1171 zbot(:,:) = zbot(:,:) * zbdy(:,:)1172 ENDIF1173 !1174 ldoce(:,:) = zbot(:,:) > 0._wp1175 numout = inumsave1176 !1177 END SUBROUTINE readbot_strip1178 1234 1179 1235 … … 1231 1287 1232 1288 1233 SUBROUTINE init_ioipsl 1234 !!---------------------------------------------------------------------- 1235 !! *** ROUTINE init_ioipsl *** 1236 !! 1237 !! ** Purpose : 1238 !! 1239 !! ** Method : 1240 !! 1241 !! History : 1242 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 1243 !! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij 1244 !!---------------------------------------------------------------------- 1245 INTEGER, DIMENSION(2) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 1246 !!---------------------------------------------------------------------- 1247 1248 ! The domain is split only horizontally along i- or/and j- direction 1249 ! So we need at the most only 1D arrays with 2 elements. 1250 ! Set idompar values equivalent to the jpdom_local_noextra definition 1251 ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 1252 iglo( :) = (/ Ni0glo, Nj0glo /) 1253 iloc( :) = (/ Ni_0 , Nj_0 /) 1254 iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig0(Nis0) but mig0 is not yet defined! 1255 iabsl(:) = iabsf(:) + iloc(:) - 1 1256 ihals(:) = (/ 0 , 0 /) 1257 ihale(:) = (/ 0 , 0 /) 1258 idid( :) = (/ 1 , 2 /) 1259 1260 IF(lwp) THEN 1261 WRITE(numout,*) 1262 WRITE(numout,*) 'mpp init_ioipsl : iloc = ', iloc 1263 WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf 1264 WRITE(numout,*) ' ihals = ', ihals 1265 WRITE(numout,*) ' ihale = ', ihale 1266 ENDIF 1267 ! 1268 CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 1269 ! 1270 END SUBROUTINE init_ioipsl 1271 1272 1273 SUBROUTINE init_nfdcom 1274 !!---------------------------------------------------------------------- 1275 !! *** ROUTINE init_nfdcom *** 1276 !! ** Purpose : Setup for north fold exchanges with explicit 1277 !! point-to-point messaging 1278 !! 1279 !! ** Method : Initialization of the northern neighbours lists. 1280 !!---------------------------------------------------------------------- 1281 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 1282 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 1283 !!---------------------------------------------------------------------- 1284 INTEGER :: sxM, dxM, sxT, dxT, jn 1285 !!---------------------------------------------------------------------- 1286 ! 1287 !initializes the north-fold communication variables 1288 isendto(:) = 0 1289 nsndto = 0 1290 ! 1291 IF ( njmpp == MAXVAL( njmppt ) ) THEN ! if I am a process in the north 1292 ! 1293 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 1294 sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 1295 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 1296 dxM = jpiglo - nimppt(narea) + 2 1297 ! 1298 ! loop over the other north-fold processes to find the processes 1299 ! managing the points belonging to the sxT-dxT range 1300 ! 1301 DO jn = 1, jpni 1302 ! 1303 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process 1304 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process 1305 ! 1306 IF ( sxT < sxM .AND. sxM < dxT ) THEN 1307 nsndto = nsndto + 1 1308 isendto(nsndto) = jn 1309 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 1310 nsndto = nsndto + 1 1311 isendto(nsndto) = jn 1312 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 1313 nsndto = nsndto + 1 1314 isendto(nsndto) = jn 1315 ENDIF 1316 ! 1317 END DO 1318 ! 1319 ENDIF 1320 l_north_nogather = .TRUE. 1321 ! 1322 END SUBROUTINE init_nfdcom 1323 1324 #endif 1289 SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 1290 !!---------------------------------------------------------------------- 1291 !! *** ROUTINE readbot_strip *** 1292 !! 1293 !! ** Purpose : Read relevant bathymetric information in order to 1294 !! provide a land/sea mask used for the elimination 1295 !! of land domains, in an mpp computation. 1296 !! 1297 !! ** Method : read stipe of size (Ni0glo,...) 1298 !!---------------------------------------------------------------------- 1299 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading 1300 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read 1301 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1302 ! 1303 INTEGER :: inumsave ! local logical unit 1304 REAL(wp), DIMENSION(Ni0glo,kjcnt) :: zbot, zbdy 1305 !!---------------------------------------------------------------------- 1306 ! 1307 inumsave = numout ; numout = numnul ! redirect all print to /dev/null 1308 ! 1309 IF( numbot /= -1 ) THEN 1310 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1311 ELSE 1312 zbot(:,:) = 1._wp ! put a non-null value 1313 ENDIF 1314 ! 1315 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1316 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1317 zbot(:,:) = zbot(:,:) * zbdy(:,:) 1318 ENDIF 1319 ! 1320 ldoce(:,:) = zbot(:,:) > 0._wp 1321 numout = inumsave 1322 ! 1323 END SUBROUTINE readbot_strip 1324 1325 1325 1326 1326 SUBROUTINE init_doloop -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/USR/usrdef_hgr.F90
r13295 r13411 90 90 zcos_alpha = SQRT( 2._wp ) * 0.5_wp 91 91 ze1deg = ze1 / (ra * rad) 92 zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo - 2, wp )93 zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo - 2, wp )92 zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo, wp ) 93 zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo, wp ) 94 94 95 95 #if defined key_agrif -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/USR/usrdef_nam.F90
r13286 r13411 70 70 kk_cfg = nn_GYRE 71 71 ! 72 kpi = 30 * nn_GYRE + 2 !73 kpj = 20 * nn_GYRE + 272 kpi = 30 * nn_GYRE ! 73 kpj = 20 * nn_GYRE 74 74 #if defined key_agrif 75 75 IF( .NOT.Agrif_Root() ) THEN ! Global Domain size: add 1 land point on each side
Note: See TracChangeset
for help on using the changeset viewer.