Changeset 233 for trunk/NEMO/OPA_SRC/lib_mpp.F90
- Timestamp:
- 2005-03-22T11:13:51+01:00 (19 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/lib_mpp.F90 (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lib_mpp.F90
r219 r233 38 38 !! ! 98 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 39 39 !! 9.0 ! 03 (J.-M. Molines, G. Madec) F90, free form 40 !! ! 04 (R. Bourdalle Badie) isend option in mpi 41 !! ! 05 (G. Madec, S. Masson) npolj=5,6 F-point & ice cases 40 42 !!---------------------------------------------------------------------- 41 43 !! OPA 9.0 , LODYC-IPSL (2003) … … 286 288 CALL pvmfmytid( npvm_mytid ) 287 289 IF( mynode_print /= 0 ) THEN 288 WRITE(num mpp,*) 'mynode, npvm_ipas =', npvm_ipas, ' nprocmax=', nprocmax289 WRITE(num mpp,*) 'mynode, npvm_mytid=', npvm_mytid, ' after pvmfmytid'290 WRITE(numout,*) 'mynode, npvm_ipas =', npvm_ipas, ' nprocmax=', nprocmax 291 WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid, ' after pvmfmytid' 290 292 ENDIF 291 293 … … 295 297 CALL mpparent( iparent_tid ) 296 298 IF( mynode_print /= 0 ) THEN 297 WRITE(num mpp,*) 'mynode, npvm_mytid=', npvm_mytid, &299 WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid, & 298 300 & ' after mpparent, npvm_tids(0) = ', & 299 301 & npvm_tids(0), ' iparent_tid=', iparent_tid 300 302 ENDIF 301 303 IF( iparent_tid < 0 ) THEN 302 WRITE(num mpp,*) 'mynode, npvm_mytid=', npvm_mytid, &304 WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid, & 303 305 & ' after mpparent, npvm_tids(0) = ', & 304 306 & npvm_tids(0), ' iparent_tid=', iparent_tid … … 306 308 npvm_me = 0 307 309 IF( ndim_mpp > nprocmax ) THEN 308 WRITE(num mpp,*) 'npvm_mytid=', npvm_mytid, ' too great'310 WRITE(numout,*) 'npvm_mytid=', npvm_mytid, ' too great' 309 311 STOP ' mynode ' 310 312 ELSE … … 322 324 323 325 IF( mynode_print /= 0 ) THEN 324 WRITE(num mpp,*) 'mynode, npvm_mytid=',npvm_mytid, &326 WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, & 325 327 & ' maitre=',executable,' info=', info & 326 328 & ,' npvm_nproc=',npvm_nproc 327 WRITE(num mpp,*) 'mynode, npvm_mytid=',npvm_mytid, &329 WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, & 328 330 & ' npvm_tids ',(npvm_tids(ji),ji=0,npvm_nproc-1) 329 331 ENDIF … … 342 344 ! receive the tids array and set me 343 345 ! --------------------------------- 344 IF( mynode_print /= 0 ) WRITE(num mpp,*) 'mynode, npvm_mytid=',npvm_mytid, ' pvmfrecv'346 IF( mynode_print /= 0 ) WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, ' pvmfrecv' 345 347 CALL pvmfrecv( iparent_tid, 10, info ) 346 IF( mynode_print /= 0 ) WRITE(num mpp,*) 'mynode, npvm_mytid=',npvm_mytid, " fin pvmfrecv"348 IF( mynode_print /= 0 ) WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, " fin pvmfrecv" 347 349 CALL pvmfunpack( jpvmint, npvm_nproc, 1 , 1, info ) 348 350 CALL pvmfunpack( jpvmint, npvm_tids , npvm_nproc, 1, info ) 349 351 IF( mynode_print /= 0 ) THEN 350 WRITE(num mpp,*) 'mynode, npvm_mytid=',npvm_mytid, &352 WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, & 351 353 & ' esclave=', executable,' info=', info,' npvm_nproc=',npvm_nproc 352 WRITE(num mpp,*) 'mynode, npvm_mytid=', npvm_mytid, &354 WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid, & 353 355 & 'npvm_tids', ( npvm_tids(ji), ji = 0, npvm_nproc-1 ) 354 356 ENDIF … … 368 370 IF( ji == npvm_me ) THEN 369 371 CALL pvmfjoingroup ( opaall, npvm_inum ) 370 IF( npvm_inum /= npvm_me ) WRITE(num mpp,*) 'mynode not arrived in the good order for opaall'372 IF( npvm_inum /= npvm_me ) WRITE(numout,*) 'mynode not arrived in the good order for opaall' 371 373 ENDIF 372 374 CALL pvmfbarrier( "bidon", npvm_nproc, info ) … … 383 385 imyhost = npvm_tids(0) 384 386 IF( mynode_print /= 0 ) THEN 385 WRITE(num mpp,*)'mynode: npvm_mytid=', npvm_mytid, ' npvm_me=', npvm_me, &387 WRITE(numout,*)'mynode: npvm_mytid=', npvm_mytid, ' npvm_me=', npvm_me, & 386 388 & ' npvm_nproc=', npvm_nproc , ' npvm_ipas=', npvm_ipas 387 389 ENDIF … … 413 415 CALL pvmfgetpe( nt3d_mytid, it3d_my_pe ) 414 416 IF( mpparent_print /= 0 ) THEN 415 WRITE(num mpp,*) 'mpparent: nt3d_mytid= ', nt3d_mytid ,' it3d_my_pe=',it3d_my_pe417 WRITE(numout,*) 'mpparent: nt3d_mytid= ', nt3d_mytid ,' it3d_my_pe=',it3d_my_pe 416 418 ENDIF 417 419 IF( it3d_my_pe == 0 ) THEN … … 421 423 kparent_tid = -1 422 424 IF(mpparent_print /= 0 ) THEN 423 WRITE(num mpp,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' kparent_tid=',kparent_tid425 WRITE(numout,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' kparent_tid=',kparent_tid 424 426 ENDIF 425 427 ! --- END receive dimension --- 426 428 IF( ndim_mpp > nprocmax ) THEN 427 WRITE(num mpp,*) 'mytid=',nt3d_mytid,' too great'429 WRITE(numout,*) 'mytid=',nt3d_mytid,' too great' 428 430 STOP ' mpparent ' 429 431 ELSE … … 431 433 ENDIF 432 434 IF( mpparent_print /= 0 ) THEN 433 WRITE(num mpp,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_nproc=', nt3d_nproc435 WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_nproc=', nt3d_nproc 434 436 ENDIF 435 437 !-------- receive tids from others process -------- … … 438 440 CALL pvmfunpack( jpvmint, nt3d_tids(ji), 1, 1, info ) 439 441 IF( mpparent_print /= 0 ) THEN 440 WRITE(num mpp,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' receive=', nt3d_tids(ji), ' from = ', ji442 WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' receive=', nt3d_tids(ji), ' from = ', ji 441 443 ENDIF 442 444 END DO 443 445 nt3d_tids(0) = nt3d_mytid 444 446 IF( mpparent_print /= 0 ) THEN 445 WRITE(num mpp,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_tids(ji) =', (nt3d_tids(ji), &447 WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_tids(ji) =', (nt3d_tids(ji), & 446 448 ji = 0, nt3d_nproc-1 ) 447 WRITE(num mpp,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' kparent_tid=', kparent_tid449 WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' kparent_tid=', kparent_tid 448 450 ENDIF 449 451 … … 727 729 SELECT CASE ( npolj ) 728 730 729 CASE ( 4 ) ! T pivot731 CASE ( 3 , 4 ) ! T pivot 730 732 iloc = jpiglo - 2 * ( nimpp - 1 ) 731 733 … … 769 771 DO ji = 1, nlci-1 770 772 iju=iloc-ji+1 771 ptab(ji,nlcj-1,jk) = p tab(iju,nlcj-2,jk)772 ptab(ji,nlcj ,jk) = p tab(iju,nlcj-3,jk)773 ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-2,jk) 774 ptab(ji,nlcj ,jk) = psgn * ptab(iju,nlcj-3,jk) 773 775 END DO 774 776 END DO … … 776 778 END SELECT 777 779 778 CASE ( 6 ) ! F pivot780 CASE ( 5 , 6 ) ! F pivot 779 781 iloc=jpiglo-2*(nimpp-1) 780 782 … … 813 815 DO ji = 1, nlci-1 814 816 iju=iloc-ji 815 ptab(ji,nlcj,jk) = ptab(iju,nlcj-2,jk) 816 ptab(ji,nlcj ,jk) = ptab(iju,nlcj-3,jk) 817 ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-2,jk) 817 818 END DO 818 819 DO ji = nlci/2+1, nlci-1 … … 1161 1162 SELECT CASE ( npolj ) 1162 1163 1163 CASE ( 4 ) ! T pivot1164 CASE ( 3 , 4 ) ! T pivot 1164 1165 iloc = jpiglo - 2 * ( nimpp - 1 ) 1165 1166 … … 1196 1197 DO ji = 1, nlci-1 1197 1198 iju=iloc-ji+1 1198 pt2d(ji,nlcj-1) = p t2d(iju,nlcj-2)1199 pt2d(ji,nlcj ) = p t2d(iju,nlcj-3)1199 pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-2) 1200 pt2d(ji,nlcj ) = psgn * pt2d(iju,nlcj-3) 1200 1201 END DO 1201 1202 … … 1209 1210 END SELECT 1210 1211 1211 CASE ( 6)! F pivot1212 CASE ( 5 , 6 ) ! F pivot 1212 1213 iloc=jpiglo-2*(nimpp-1) 1213 1214 … … 1239 1240 DO ji = 1, nlci-1 1240 1241 iju=iloc-ji 1241 pt2d(ji,nlcj) = pt2d(iju,nlcj-2) 1242 pt2d(ji,nlcj ) = pt2d(iju,nlcj-3) 1242 pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-2) 1243 1243 END DO 1244 1244 DO ji = nlci/2+1, nlci-1 … … 1248 1248 1249 1249 CASE ( 'I' ) ! ice U-V point 1250 pt2d( 2 ,nlcj) = 0.e0 !!bug ???1251 DO ji = 1 , nlci-1 !!bug rob= 2,jpim11252 ijt = iloc - ji !!bug rob= ijt=jpi-ji+2 ???1250 pt2d( 2 ,nlcj) = 0.e0 1251 DO ji = 2 , nlci-1 1252 ijt = iloc - ji + 2 1253 1253 pt2d(ji,nlcj)= 0.5 * ( pt2d(ji,nlcj-1) + psgn * pt2d(ijt,nlcj-1) ) 1254 1254 END DO … … 1393 1393 CASE ( 4 ) 1394 1394 DO ji = 1, nlci 1395 ptab(ji,nlcj-2) = ptab(ji,nlcj-2) +t2p1(ji,1,1)1395 ptab(ji,nlcj-2) = ptab(ji,nlcj-2) + t2p1(ji,1,1) 1396 1396 END DO 1397 1397 CASE ( 6 ) 1398 1398 DO ji = 1, nlci 1399 ptab(ji,nlcj-1) = ptab(ji,nlcj-1) +t2p1(ji,1,1)1399 ptab(ji,nlcj-1) = ptab(ji,nlcj-1) + t2p1(ji,1,1) 1400 1400 END DO 1401 1401 … … 3186 3186 DO jj = nlcj - ijpj +1, nlcj 3187 3187 ij = jj - nlcj + ijpj 3188 znorthloc(:,ij,jk) =pt3d(:,jj,jk)3188 znorthloc(:,ij,jk) = pt3d(:,jj,jk) 3189 3189 END DO 3190 3190 END DO … … 3271 3271 DO ji = 1, jpiglo-1 3272 3272 iju = jpiglo-ji+1 3273 ztab(ji,ijpj-1,jk) = ztab(iju,ijpj-2,jk)3274 ztab(ji,ijpj ,jk) = ztab(iju,ijpj-3,jk)3273 ztab(ji,ijpj-1,jk) = psgn * ztab(iju,ijpj-2,jk) 3274 ztab(ji,ijpj ,jk) = psgn * ztab(iju,ijpj-3,jk) 3275 3275 END DO 3276 3276 … … 3309 3309 DO ji = 1, jpiglo-1 3310 3310 iju = jpiglo-ji 3311 ztab(ji,ijpj ,jk) = ztab(iju,ijpj-2,jk)3311 ztab(ji,ijpj ,jk) = psgn * ztab(iju,ijpj-2,jk) 3312 3312 END DO 3313 3313 DO ji = jpiglo/2+1, jpiglo-1 3314 3314 iju = jpiglo-ji 3315 ztab(ji,ijpjm1,jk) = ztab(iju,ijpjm1,jk)3315 ztab(ji,ijpjm1,jk) = psgn * ztab(iju,ijpjm1,jk) 3316 3316 END DO 3317 3317 … … 3486 3486 END DO 3487 3487 3488 CASE ( 'U' ) ! U-point3488 CASE ( 'U' ) ! U-point 3489 3489 DO ji = 1, jpiglo-1 3490 3490 iju = jpiglo-ji+1 … … 3496 3496 END DO 3497 3497 3498 CASE ( 'V' ) ! V-point3498 CASE ( 'V' ) ! V-point 3499 3499 DO ji = 2, jpiglo 3500 3500 ijt = jpiglo-ji+2 … … 3506 3506 DO ji = 1, jpiglo-1 3507 3507 iju = jpiglo-ji+1 3508 ztab(ji,ijpj-1) = ztab(iju,ijpj-2)3509 ztab(ji,ijpj ) = ztab(iju,ijpj-3)3508 ztab(ji,ijpj-1) = psgn * ztab(iju,ijpj-2) 3509 ztab(ji,ijpj ) = psgn * ztab(iju,ijpj-3) 3510 3510 END DO 3511 3511 3512 CASE ( 'I' ) ! ice U-V point3512 CASE ( 'I' ) ! ice U-V point 3513 3513 ztab(2,ijpj) = psgn * ztab(3,ijpj-1) 3514 3514 DO ji = 3, jpiglo … … 3526 3526 SELECT CASE ( cd_type ) 3527 3527 3528 CASE ( 'T' , 'W' ,'S' ) ! T-, W-point3528 CASE ( 'T' , 'W' ,'S' ) ! T-, W-point 3529 3529 DO ji = 1, jpiglo 3530 3530 ijt = jpiglo-ji+1 … … 3532 3532 END DO 3533 3533 3534 CASE ( 'U' ) ! U-point3534 CASE ( 'U' ) ! U-point 3535 3535 DO ji = 1, jpiglo-1 3536 3536 iju = jpiglo-ji … … 3538 3538 END DO 3539 3539 3540 CASE ( 'V' ) ! V-point3540 CASE ( 'V' ) ! V-point 3541 3541 DO ji = 1, jpiglo 3542 3542 ijt = jpiglo-ji+1 … … 3551 3551 DO ji = 1, jpiglo-1 3552 3552 iju = jpiglo-ji 3553 ztab(ji,ijpj ) = ztab(iju,ijpj-2)3553 ztab(ji,ijpj ) = psgn * ztab(iju,ijpj-2) 3554 3554 END DO 3555 3555 DO ji = jpiglo/2+1, jpiglo-1 3556 3556 iju = jpiglo-ji 3557 ztab(ji,ijpjm1) = ztab(iju,ijpjm1)3557 ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1) 3558 3558 END DO 3559 3559 3560 CASE ( 'I' ) ! ice U-V point 3561 ztab( 2 ,ijpj) = 0.e0 3562 DO ji = 2 , jpiglo-1 3563 ijt = jpi - ji + 2 3564 ztab(ji,ijpj)= 0.5 * ( ztab(ji,ijpj-1) + psgn * ztab(ijt,ijpj-1) ) 3565 END DO 3566 3560 3567 END SELECT 3561 3568 … … 3564 3571 SELECT CASE ( cd_type) 3565 3572 3566 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points3573 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 3567 3574 ztab(:, 1 ) = 0.e0 3568 3575 ztab(:,ijpj) = 0.e0 3569 3576 3570 CASE ( 'F' ) ! F-point3577 CASE ( 'F' ) ! F-point 3571 3578 ztab(:,ijpj) = 0.e0 3572 3579 3573 CASE ( 'I' ) ! ice U-V point3580 CASE ( 'I' ) ! ice U-V point 3574 3581 ztab(:, 1 ) = 0.e0 3575 3582 ztab(:,ijpj) = 0.e0
Note: See TracChangeset
for help on using the changeset viewer.
