Changeset 3294 for trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r2758 r3294 43 43 USE mod_ioclient 44 44 #endif 45 USE prtctl ! Print control (prt_ctl_init routine) 45 USE prtctl ! Print control (prt_ctl_init routine) 46 USE timing ! Timing 46 47 47 48 IMPLICIT NONE … … 110 111 ENDIF 111 112 ! 113 IF( nn_timing == 1 ) CALL timing_finalize 114 ! 112 115 CALL nemo_closefile 113 116 ! … … 128 131 !! 129 132 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 130 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 133 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 134 & nn_bench, nn_timing 131 135 !!---------------------------------------------------------------------- 132 136 ! … … 208 212 ENDIF 209 213 ! 214 IF( nn_timing == 1 ) CALL timing_init 215 ! 216 210 217 ! ! General initialization 218 IF( nn_timing == 1 ) CALL timing_start( 'nemo_init') 219 ! 211 220 CALL phy_cst ! Physical constants 212 221 CALL eos_init ! Equation of state … … 215 224 CALL istate_init ! ocean initial state (Dynamics and tracers) 216 225 226 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 217 227 218 228 IF( ln_ctl ) CALL prt_ctl_init ! Print control … … 236 246 237 247 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 248 ! 249 IF( nn_timing == 1 ) CALL timing_stop( 'nemo_init') 238 250 ! 239 251 END SUBROUTINE nemo_init … … 359 371 USE ldftra_oce, ONLY: ldftra_oce_alloc 360 372 USE trc_oce, ONLY: trc_oce_alloc 361 USE wrk_nemo, ONLY: wrk_alloc362 373 ! 363 374 INTEGER :: ierr … … 372 383 ierr = ierr + lib_mpp_alloc (numout) ! mpp exchanges 373 384 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays 374 ierr = ierr + wrk_alloc(numout, lwp)375 385 ! 376 386 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 493 503 END SUBROUTINE factorise 494 504 505 #if defined key_mpp_mpi 506 SUBROUTINE nemo_northcomms 507 !!====================================================================== 508 !! *** ROUTINE nemo_northcomms *** 509 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 510 !!===================================================================== 511 !!---------------------------------------------------------------------- 512 !! 513 !! ** Purpose : Initialization of the northern neighbours lists. 514 !!---------------------------------------------------------------------- 515 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 516 !!---------------------------------------------------------------------- 517 518 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 519 INTEGER :: ijpj ! number of rows involved in north-fold exchange 520 INTEGER :: northcomms_alloc ! allocate return status 521 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 522 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 523 524 IF(lwp) WRITE(numout,*) 525 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 526 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 527 528 !!---------------------------------------------------------------------- 529 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 530 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 531 IF( northcomms_alloc /= 0 ) THEN 532 WRITE(numout,cform_war) 533 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 534 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 535 ENDIF 536 nsndto = 0 537 isendto = -1 538 ijpj = 4 539 ! 540 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 541 ! However, these first few exchanges have to use the mpi_allgather method to 542 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 543 ! Consequently, set l_north_nogather to be false here and set it true only after 544 ! the lists have been established. 545 ! 546 l_north_nogather = .FALSE. 547 ! 548 ! Exchange and store ranks on northern rows 549 550 DO jtyp = 1,4 551 552 lrankset = .FALSE. 553 znnbrs = narea 554 SELECT CASE (jtyp) 555 CASE(1) 556 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 557 CASE(2) 558 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 559 CASE(3) 560 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 561 CASE(4) 562 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 563 END SELECT 564 565 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 566 DO jj = nlcj-ijpj+1, nlcj 567 ij = jj - nlcj + ijpj 568 DO ji = 1,jpi 569 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 570 & lrankset(INT(znnbrs(ji,jj))) = .true. 571 END DO 572 END DO 573 574 DO jj = 1,jpnij 575 IF ( lrankset(jj) ) THEN 576 nsndto(jtyp) = nsndto(jtyp) + 1 577 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 578 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 579 & ' jpmaxngh will need to be increased ') 580 ENDIF 581 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 582 ENDIF 583 END DO 584 ENDIF 585 586 END DO 587 588 ! 589 ! Type 5: I-point 590 ! 591 ! ICE point exchanges may involve some averaging. The neighbours list is 592 ! built up using two exchanges to ensure that the whole stencil is covered. 593 ! lrankset should not be reset between these 'J' and 'K' point exchanges 594 595 jtyp = 5 596 lrankset = .FALSE. 597 znnbrs = narea 598 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 599 600 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 601 DO jj = nlcj-ijpj+1, nlcj 602 ij = jj - nlcj + ijpj 603 DO ji = 1,jpi 604 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 605 & lrankset(INT(znnbrs(ji,jj))) = .true. 606 END DO 607 END DO 608 ENDIF 609 610 znnbrs = narea 611 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 612 613 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 614 DO jj = nlcj-ijpj+1, nlcj 615 ij = jj - nlcj + ijpj 616 DO ji = 1,jpi 617 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 618 & lrankset( INT(znnbrs(ji,jj))) = .true. 619 END DO 620 END DO 621 622 DO jj = 1,jpnij 623 IF ( lrankset(jj) ) THEN 624 nsndto(jtyp) = nsndto(jtyp) + 1 625 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 626 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 627 & ' jpmaxngh will need to be increased ') 628 ENDIF 629 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 630 ENDIF 631 END DO 632 ! 633 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 634 ! can use peer to peer communications at the north fold 635 ! 636 l_north_nogather = .TRUE. 637 ! 638 ENDIF 639 DEALLOCATE( znnbrs ) 640 DEALLOCATE( lrankset ) 641 642 END SUBROUTINE nemo_northcomms 643 #else 644 SUBROUTINE nemo_northcomms ! Dummy routine 645 WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 646 END SUBROUTINE nemo_northcomms 647 #endif 495 648 !!====================================================================== 496 649 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.