Changeset 7312 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
- Timestamp:
- 2016-11-23T09:03:25+01:00 (7 years ago)
- Location:
- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS
- Files:
-
- 2 edited
-
crs.F90 (modified) (3 diffs)
-
crsdom.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r7256 r7312 33 33 INTEGER :: jpi_crsm1, jpj_crsm1 !: loop indices 34 34 INTEGER :: jpiglo_crsm1, jpjglo_crsm1 !: loop indices 35 INTEGER :: nperio_full, nperio_crs !: jperio of parent and coarse grids36 35 INTEGER :: npolj_full, npolj_crs !: north fold mark 37 36 INTEGER :: jpiglo_full, jpjglo_full !: jpiglo / jpjglo … … 359 358 jpim1 = jpim1_full 360 359 jpjm1 = jpjm1_full 361 nperio = nperio_full362 360 363 361 npolj = npolj_full … … 402 400 jpim1 = jpi_crsm1 403 401 jpjm1 = jpj_crsm1 404 nperio = nperio_crs405 402 406 403 npolj = npolj_crs -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r7256 r7312 142 142 DO ji = nldi_crs, nlei_crs 143 143 iji = mis_crs(ji) + 1 144 IF( ijj .GT. jpj )WRITE(narea+8000-1,*)"BUG ijj ",jj,mjs_crs(jj);CALL FLUSH(narea+8000-1) 144 145 p_gphi_crs(ji,jj) = p_gphi(iji,ijj) 145 146 p_glam_crs(ji,jj) = p_glam(iji,ijj) … … 386 387 INTEGER :: ji, jj, jk 387 388 INTEGER :: ijis, ijie, ijjs, ijje 389 INTEGER :: ini, inj 388 390 REAL(wp) :: zflcrs, zsfcrs 389 391 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask,ztabtmp … … 487 489 ! 488 490 DO jk = 1, jpk 491 489 492 DO jj = nldj_crs,nlej_crs 493 490 494 ijjs = mjs_crs(jj) 491 495 ijje = mje_crs(jj) 496 inj = ijje-ijjs+1 497 492 498 DO ji = nldi_crs, nlei_crs 493 499 ijis = mis_crs(ji) 494 500 ijie = mie_crs(ji) 495 496 ztmp(:,:)= p_fld(ijis:ijie,ijjs:ijje,jk) 501 ini = ijie-ijis+1 502 503 ztmp(1:ini,1:inj)= p_fld(ijis:ijie,ijjs:ijje,jk) 497 504 zdim1(1) = nn_factx*nn_facty 498 505 ztmp1(:) = RESHAPE( ztmp(:,:) , zdim1 ) … … 1080 1087 END SELECT 1081 1088 1082 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0 ) !cbr , pval=1.0 )1083 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0 ) !cbr , pval=1.0 )1089 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0 ) 1090 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0 ) 1084 1091 1085 1092 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) … … 1116 1123 jpj_crsm1 = jpj_crs - 1 1117 1124 1118 nperio_crs = jperio1119 1125 npolj_crs = npolj 1120 1126 … … 1160 1166 ENDDO 1161 1167 1162 !WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 1163 !WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 1164 !WRITE(narea+8000-1,*)"nowe noea",nowe,noea 1165 !WRITE(narea+8000-1,*)"noso nono",noso,nono 1166 !WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 1167 !WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 1168 !WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 1169 !WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 1170 !WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 1171 !WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi ,nlei ,nlci 1172 !WRITE(narea+8000-1,*)"glo jpi nldi,nlei ",jpi, nldi+nimpp-1,nlei+nimpp-1 1173 !WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj ,nlej ,nlcj 1174 !WRITE(narea+8000-1,*)"glo jpj nldj,nlej ",jpj, nldj+njmpp-1,nlej+njmpp-1 1175 !WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 1176 !WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 1177 !WRITE(narea+8000-1,*)"jpni jpnj jpnij ",jpni,jpnj,jpnij 1178 !WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 1168 WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 1169 WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 1170 WRITE(narea+8000-1,*)"jpni jpnj jpnij ",jpni,jpnj,jpnij 1171 WRITE(narea+8000-1,*)"nperio jperio ",nperio,jperio 1172 WRITE(narea+8000-1,*)"nowe noea",nowe,noea 1173 WRITE(narea+8000-1,*)"noso nono",noso,nono 1174 WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 1175 WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 1176 WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 1177 WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 1178 WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 1179 WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi ,nlei ,nlci 1180 WRITE(narea+8000-1,*)"glo jpi nldi,nlei ",jpi, nldi+nimpp-1,nlei+nimpp-1 1181 WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj ,nlej ,nlcj 1182 WRITE(narea+8000-1,*)"glo jpj nldj,nlej ",jpj, nldj+njmpp-1,nlej+njmpp-1 1183 WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 1184 WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 1185 WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 1179 1186 1180 1187 !========================================================================== … … 1182 1189 !========================================================================== 1183 1190 1184 SELECT CASE ( nperio ) 1185 1186 CASE ( 0, 1, 3, 4 ) ! 3, 4 : T-Pivot at North Fold 1191 !------------------------------------------------------------------------------------ 1192 !I-1 fill mis2_crs and mie2_crs: arrays to switch from physic grid to coarsened grid 1193 !------------------------------------------------------------------------------------ 1194 1195 ! !--------!--------!--------! 1196 ! ! ! ! ! 1197 ! ! ! ! ! 1198 ! ! ! ! ! 1199 ! !--------!--------!--------! 1200 ! ! ! ! ! 1201 ! ! ! ji,jj ! ! 1202 ! ! ! ! ! 1203 ! !--------!--------!--------! 1204 ! ! ! ! ! 1205 ! ! ! ! ! 1206 ! ! ! ! ! 1207 ! !--------!--------!--------! 1208 ! mis2_crs(ji) mie2_crs(ji) 1209 1210 1211 SELECT CASE ( jperio ) 1212 1213 CASE ( 0, 1 ) 1214 1215 DO ji=1,jpiglo_crs 1216 ijis=nn_factx*(ji-1)+1 1217 ijie=nn_factx*(ji-1)+3 1218 mis2_crs(ji)=ijis 1219 mie2_crs(ji)=ijie 1220 ENDDO 1221 1222 CASE ( 3, 4 ) ! 3, 4 : T-Pivot at North Fold: make correspondinf the pivot points of the 2 grids 1187 1223 1188 1224 DO ji=1,jpiglo_crs … … 1193 1229 ENDDO 1194 1230 1195 ji=1 1196 DO WHILE( mis2_crs(ji) - nimpp + 1 .LT. 1 ) 1197 ji=ji+1 1198 IF( ji==jpiglo_crs )EXIT 1199 END DO 1200 ijis=ji 1201 1202 !mjs2_crs(ijis)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 1203 !ijis =indice global ds la grille crs de la premire maille qui est ds le domaine intérieur 1204 !ii_start =indice local de mjs2_crs(jj) 1205 ii_start = mis2_crs(ijis)-nimpp+1 1206 nimpp_crs = ijis-1 1207 1208 nldi_crs = 2 1209 IF( nowe == -1 )THEN 1210 1211 mie2_crs(ijis-1) = mis2_crs(ijis)-1 1231 CASE DEFAULT 1232 WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported; narea: ',narea 1233 END SELECT 1234 1235 !------------------------------------------------------------------------------- 1236 ! I-2 find the first CRS cell which is inside the physic grid inner domain 1237 !------------------------------------------------------------------------------- 1238 ! ijis : global indice of the first CRS cell which inside the physic grid inner domain 1239 ! mis2_crs(ijis) : global indice of the bottom-left physic cell corresponding to ijis cell 1240 ! ii_start : local ndice of the bottom-left physic cell corresponding to ijis cell 1241 1242 ji=1 1243 DO WHILE( mis2_crs(ji) - nimpp + 1 .LT. 1 ) 1244 ji=ji+1 1245 IF( ji==jpiglo_crs )EXIT 1246 END DO 1247 1248 ijis=ji 1249 ii_start = mis2_crs(ijis)-nimpp+1 1250 1251 !---------------------------------------------------------------------------------------------- 1252 ! I-3 compute nldi_crs and compute mis2_crs and mie2_crs for the first cell of the local domain 1253 !--------------------------------------------------------------------------------------------- 1254 nldi_crs = 2 1255 IF( nowe == -1 .AND. ( (jperio==3 .OR. jperio==4 ) .OR. ( (jperio==0 .OR. jperio==1 ) .AND. iproci .NE. 1 )) )THEN 1256 1257 mie2_crs(ijis-1) = mis2_crs(ijis)-1 1212 1258 1213 SELECT CASE(ii_start) 1214 CASE(1) 1215 nldi_crs=2 1216 mie2_crs(ijis-1) = -1 1217 mis2_crs(ijis-1) = -1 1218 CASE(2) 1219 nldi_crs=2 1220 mis2_crs(ijis-1) = mie2_crs(ijis-1) 1221 CASE(3) 1222 nldi_crs=2 1223 mis2_crs(ijis-1) = mie2_crs(ijis-1) -1 1224 CASE DEFAULT 1225 WRITE(narea+8000-1,*)"WRONG VALUE FOR iistart ",ii_start 1226 END SELECT 1227 1259 SELECT CASE(ii_start) 1260 CASE(1) 1261 nldi_crs=2 1262 mie2_crs(ijis-1) = -1 1263 mis2_crs(ijis-1) = -1 1264 CASE(2) 1265 nldi_crs=2 1266 mis2_crs(ijis-1) = mie2_crs(ijis-1) 1267 CASE(3) 1268 nldi_crs=2 1269 mis2_crs(ijis-1) = mie2_crs(ijis-1) -1 1270 CASE DEFAULT 1271 WRITE(narea+8000-1,*)"WRONG VALUE FOR iistart ",ii_start 1272 END SELECT 1273 1274 ENDIF 1275 1276 !---------------------------------------------------------------------------------------------- 1277 ! I-4 compute nimpp_crs 1278 !--------------------------------------------------------------------------------------------- 1279 nimpp_crs = ijis-1 1280 IF( nimpp==1 )nimpp_crs=1 1281 1282 !------------------------------------------------------------------------------- 1283 ! I-5 find the last CRS cell which is inside the physic grid inner domain 1284 !------------------------------------------------------------------------------- 1285 ! ijie : global indice of the last CRS cell which inside the physic grid inner domain 1286 1287 ji=jpiglo_crs 1288 DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. jpi ) 1289 ji=ji-1 1290 IF( ji==1 )EXIT 1291 END DO 1292 ijie=ji 1293 1294 !------------------------------------------------------------------------------- 1295 ! I-6 compute nlei_crs and nlci_crs 1296 !------------------------------------------------------------------------------- 1297 nlei_crs=ijie-nimpp_crs+1 1298 nlci_crs=nlei_crs+jpreci 1299 IF( iproci == jpni )nlei_crs=nlci_crs 1300 1301 !------------------------------------------------------------------------------- 1302 ! I-7 local to global and global to local indices for CRS grid 1303 !------------------------------------------------------------------------------- 1304 DO ji = 1, jpi_crs 1305 mig_crs(ji) = ji + nimpp_crs - 1 1306 ENDDO 1307 DO ji = 1, jpiglo_crs 1308 mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 1309 mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs ) ) 1310 ENDDO 1311 1312 !--------------------------------------------------------------------------------------- 1313 ! I-8 CRS to physic grid: local indices mis_crs and mie_crs and local coarsening factor 1314 !--------------------------------------------------------------------------------------- 1315 DO ji = 1, nlei_crs 1316 mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 1317 mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 1318 IF( iproci == jpni .AND. ji == nlei_crs )THEN 1319 mie_crs(ji) = nlei 1320 mie2_crs(mig_crs(ji)) = mig(nlei) 1228 1321 ENDIF 1229 1230 IF( nimpp==1 )nimpp_crs=1 1231 1232 !---------------------------------------- 1233 ji=jpiglo_crs 1234 DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. jpi ) 1235 ji=ji-1 1236 IF( ji==1 )EXIT 1237 END DO 1238 ijie=ji 1239 nlei_crs=ijie-nimpp_crs+1 1240 nlci_crs=nlei_crs+jpreci 1241 1242 !---------------------------------------- 1243 DO ji = 1, jpi_crs 1244 mig_crs(ji) = ji + nimpp_crs - 1 1245 ENDDO 1246 DO ji = 1, jpiglo_crs 1247 mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 1248 mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs ) ) 1249 ENDDO 1250 1251 !---------------------------------------- 1252 DO ji = 1, nlei_crs 1253 mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 1254 mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 1255 nfactx(ji) = mie_crs(ji)-mie_crs(ji)+1 1256 ENDDO 1257 1258 IF( iproci == jpni )THEN 1259 nlei_crs=nlci_crs 1260 mis_crs(nlei_crs)=mis_crs(nlei_crs-1) 1261 mie_crs(nlei_crs)=mie_crs(nlei_crs-1) 1262 ENDIF 1263 1264 !---------------------------------------- 1265 1266 CASE DEFAULT 1267 WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 1268 END SELECT 1322 nfactx(ji) = mie_crs(ji)-mis_crs(ji)+1 1323 ENDDO 1269 1324 1270 1325 !========================================================================== 1271 ! coarsened domain: dimensions along I1326 ! coarsened domain: dimensions along J 1272 1327 !========================================================================== 1273 SELECT CASE ( nperio ) 1274 CASE ( 0, 1, 3, 4 ) ! 3, 4 : T-Pivot at North Fold 1328 1329 !----------------------------------------------------------------------------------- 1330 !J-1 fill mjs2_crs and mje2_crs: arrays to switch from physic grid to coarsened grid 1331 !----------------------------------------------------------------------------------- 1332 1333 ! !--------!--------!--------! 1334 ! ! ! ! ! 1335 ! ! ! ! ! 1336 ! ! ! ! ! mje2_crs(jj) 1337 ! !--------!--------!--------! 1338 ! ! ! ! ! 1339 ! ! ! ji,jj ! ! 1340 ! ! ! ! ! 1341 ! !--------!--------!--------! 1342 ! ! ! ! ! 1343 ! ! ! ! ! mjs2_crs(jj) 1344 ! ! ! ! ! 1345 ! !--------!--------!--------! 1346 1347 SELECT CASE ( jperio ) 1348 1349 CASE ( 0, 1 ) ! 1350 1351 DO jj=1,jpjglo_crs 1352 ijjs=nn_facty*(jj-1)+1 1353 ijje=nn_facty*(jj-1)+3 1354 mjs2_crs(jj)=ijjs 1355 mje2_crs(jj)=ijje 1356 ENDDO 1357 1358 CASE ( 3, 4 ) ! 3, 4 : T-Pivot at North Fold 1275 1359 1276 1360 DO jj=1,jpjglo_crs … … 1281 1365 ENDDO 1282 1366 1283 jj=1 1284 DO WHILE( mjs2_crs(jj) - njmpp + 1 .LT. 1 ) 1285 jj=jj+1 1286 IF( jj==jpjglo_crs )EXIT 1287 END DO 1288 ijjs=jj 1289 1290 !mjs2_crs(jj)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 1291 !ijjs =indice global ds la grille crs de la premire maille qui est ds le domaine intérieur 1292 !ij_start =indice local de mjs2_crs(jj) 1293 ij_start = mjs2_crs(ijjs)-njmpp+1 1294 njmpp_crs = ijjs-1 1295 1296 nldj_crs = 2 1367 CASE DEFAULT 1368 WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported; narea: ',narea 1369 END SELECT 1370 1371 !------------------------------------------------------------------------------- 1372 ! J-2 find the first CRS cell which is inside the physic grid inner domain 1373 !------------------------------------------------------------------------------- 1374 ! ijjs : global indice of the first CRS cell which inside the physic grid inner domain 1375 ! mis2_crs(ijjs) : global indice of the bottom-left physic cell corresponding to ijis cell 1376 ! ij_start : local ndice of the bottom-left physic cell corresponding to ijis cell 1377 1378 jj=1 1379 DO WHILE( mjs2_crs(jj) - njmpp + 1 .LT. 1 ) 1380 jj=jj+1 1381 IF( jj==jpjglo_crs )EXIT 1382 END DO 1383 1384 ijjs=jj 1385 ij_start = mjs2_crs(ijjs)-njmpp+1 1386 1387 !---------------------------------------------------------------------------------------------- 1388 ! J-3 compute nldj_crs and compute mjs2_crs and mje2_crs for the first cell of the local domain 1389 !--------------------------------------------------------------------------------------------- 1390 nldj_crs = 2 1391 1392 IF( jperio==3 .OR. jperio==4 )THEN 1393 1297 1394 IF( noso == -1 )THEN 1298 1395 … … 1315 1412 1316 1413 ENDIF 1317 IF( njmpp==1 )njmpp_crs=1 1318 1319 !---------------------------------------- 1320 jj=jpjglo_crs 1321 DO WHILE( mje2_crs(jj) - njmpp + 1 .GT. nlcj ) 1322 jj=jj-1 1323 IF( jj==1 )EXIT 1324 END DO 1325 ijje=jj 1326 1327 nlej_crs=ijje-njmpp_crs+1 1328 1329 !---------------------------------------- 1330 nlcj_crs=nlej_crs+jprecj 1331 IF( iprocj == jpnj )THEN 1414 ENDIF 1415 1416 !---------------------------------------------------------------------------------------------- 1417 ! J-4 compute nimpp_crs 1418 !--------------------------------------------------------------------------------------------- 1419 njmpp_crs = ijjs-1 1420 IF( njmpp==1 )njmpp_crs=1 1421 1422 !------------------------------------------------------------------------------- 1423 ! J-5 find the last CRS cell which is inside the physic grid inner domain 1424 !------------------------------------------------------------------------------- 1425 ! ijje : global indice of the last CRS cell which inside the physic grid inner domain 1426 1427 jj=jpjglo_crs 1428 DO WHILE( mje2_crs(jj) - njmpp + 1 .GT. nlcj ) 1429 jj=jj-1 1430 IF( jj==1 )EXIT 1431 END DO 1432 ijje=jj 1433 1434 !------------------------------------------------------------------------------- 1435 ! J-6 compute nlej_crs and nlcj_crs 1436 !------------------------------------------------------------------------------- 1437 nlej_crs=ijje-njmpp_crs+1 1438 nlcj_crs=nlej_crs+jprecj 1439 1440 IF( iprocj == jpnj )THEN 1441 IF( jperio==3 .OR. jperio==4 )THEN 1332 1442 nlej_crs=jpj_crs 1333 1443 nlcj_crs=nlej_crs 1444 ELSE 1445 nlej_crs= nlej_crs+1 1446 nlcj_crs= nlcj_crs+1 1334 1447 ENDIF 1335 1336 !---------------------------------------- 1337 DO jj = 1, jpj_crs 1338 mjg_crs(jj) = jj + njmpp_crs - 1 1339 ENDDO 1340 DO jj = 1, jpjglo_crs 1341 mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 1342 mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs ) ) 1343 ENDDO 1344 1345 !---------------------------------------- 1346 DO jj = 1, nlej_crs 1347 mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 1348 mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 1349 nfacty(jj) = mje_crs(jj)-mje_crs(jj)+1 1350 ENDDO 1351 1352 IF( iprocj == jpnj )THEN 1353 mjs_crs(nlej_crs)=mjs_crs(nlej_crs-1) 1354 mje_crs(nlej_crs)=mje_crs(nlej_crs-1) 1448 ENDIF 1449 1450 !------------------------------------------------------------------------------- 1451 ! J-7 local to global and global to local indices for CRS grid 1452 !------------------------------------------------------------------------------- 1453 DO jj = 1, jpj_crs 1454 mjg_crs(jj) = jj + njmpp_crs - 1 1455 ENDDO 1456 DO jj = 1, jpjglo_crs 1457 mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 1458 mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs ) ) 1459 ENDDO 1460 1461 !--------------------------------------------------------------------------------------- 1462 ! J-8 CRS to physic grid: local indices mis_crs and mie_crs and local coarsening factor 1463 !--------------------------------------------------------------------------------------- 1464 DO jj = 1, nlej_crs 1465 mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 1466 mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 1467 IF( iprocj == jpnj .AND. jj == nlej_crs )THEN 1468 mjs_crs(jj) = nlej 1469 mjs2_crs(mjg_crs(jj)) = mjg(nlej) 1470 mje_crs(jj) = nlej 1471 mje2_crs(mjg_crs(jj)) = mjg(nlej) 1355 1472 ENDIF 1356 1357 !---------------------------------------- 1358 1359 CASE DEFAULT 1360 WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 1361 END SELECT 1473 nfacty(jj) = mje_crs(jj)-mjs_crs(jj)+1 1474 ENDDO 1362 1475 1363 1476 !========================================================================== … … 1402 1515 !WRITE(narea+8000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs ,nlej_crs ,nlcj_crs 1403 1516 !WRITE(narea+8000-1,*)"glo crs jpj nldj,nlej ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 1404 !============================================================================================== 1517 1405 1518 IF( jpizoom /= 1 .OR. jpjzoom /= 1) STOP !cbr mettre un ctlstp et ailleurs ( crsini ) 1406 1519 … … 1412 1525 jpim1_full = jpim1 1413 1526 jpjm1_full = jpjm1 1414 nperio_full = nperio1415 1527 npolj_full = npolj 1416 1528 jpiglo_full = jpiglo … … 1475 1587 1476 1588 IF( nresty == 0 )THEN 1477 IF( jperio == 3 .OR. jperio == 4 ) nperio_crs = jperio + 21478 IF( jperio == 5 .OR. jperio == 6 ) nperio_crs = jperio - 21479 1589 IF( npolj == 3 ) npolj_crs = 5 1480 1590 IF( npolj == 5 ) npolj_crs = 3
Note: See TracChangeset
for help on using the changeset viewer.
