- Timestamp:
- 2011-11-15T21:55:40+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3104 r3116 27 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 30 31 !!---------------------------------------------------------------------- 31 32 … … 46 47 USE domain ! domain initialization (dom_init routine) 47 48 USE obcini ! open boundary cond. initialization (obc_ini routine) 48 USE bdyini ! unstructured open boundary cond. initialization (bdy_init routine) 49 USE bdyini ! open boundary cond. initialization (bdy_init routine) 50 USE bdydta ! open boundary cond. initialization (bdy_dta_init routine) 51 USE bdytides ! open boundary cond. initialization (tide_init routine) 49 52 USE istate ! initial state setting (istate_init routine) 50 53 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) … … 67 70 USE c1d ! 1D configuration 68 71 USE step_c1d ! Time stepping loop for the 1D configuration 72 USE dynnept ! simplified form of Neptune effect 69 73 #if defined key_top 70 74 USE trcini ! passive tracer initialisation … … 246 250 IF( Agrif_Root() ) THEN 247 251 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 252 #if defined key_nemocice_decomp 253 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 254 #else 248 255 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 256 #endif 249 257 jpk = jpkdta ! third dim 250 258 jpim1 = jpi-1 ! inner domain indices … … 293 301 CALL dom_init ! Domain 294 302 303 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 304 295 305 IF( ln_ctl ) CALL prt_ctl_init ! Print control 296 306 297 307 IF( lk_obc ) CALL obc_init ! Open boundaries 298 IF( lk_bdy ) CALL bdy_init ! Unstructured open boundaries 308 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 309 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 310 IF( lk_bdy ) CALL tide_init ! Open boundaries initialisation of tidal harmonic forcing 311 312 CALL flush(numout) 313 CALL dyn_nept_init ! simplified form of Neptune effect 314 CALL flush(numout) 299 315 300 316 CALL istate_init ! ocean initial state (Dynamics and tracers) … … 623 639 END SUBROUTINE factorise 624 640 641 #if defined key_mpp_mpi 642 SUBROUTINE nemo_northcomms 643 !!====================================================================== 644 !! *** ROUTINE nemo_northcomms *** 645 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 646 !!===================================================================== 647 !!---------------------------------------------------------------------- 648 !! 649 !! ** Purpose : Initialization of the northern neighbours lists. 650 !!---------------------------------------------------------------------- 651 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 652 !!---------------------------------------------------------------------- 653 654 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 655 INTEGER :: ijpj ! number of rows involved in north-fold exchange 656 INTEGER :: northcomms_alloc ! allocate return status 657 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 658 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 659 660 IF(lwp) WRITE(numout,*) 661 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 662 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 663 664 !!---------------------------------------------------------------------- 665 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 666 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 667 IF( northcomms_alloc /= 0 ) THEN 668 WRITE(numout,cform_war) 669 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 670 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 671 ENDIF 672 nsndto = 0 673 isendto = -1 674 ijpj = 4 675 ! 676 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 677 ! However, these first few exchanges have to use the mpi_allgather method to 678 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 679 ! Consequently, set l_north_nogather to be false here and set it true only after 680 ! the lists have been established. 681 ! 682 l_north_nogather = .FALSE. 683 ! 684 ! Exchange and store ranks on northern rows 685 686 DO jtyp = 1,4 687 688 lrankset = .FALSE. 689 znnbrs = narea 690 SELECT CASE (jtyp) 691 CASE(1) 692 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 693 CASE(2) 694 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 695 CASE(3) 696 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 697 CASE(4) 698 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 699 END SELECT 700 701 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 702 DO jj = nlcj-ijpj+1, nlcj 703 ij = jj - nlcj + ijpj 704 DO ji = 1,jpi 705 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 706 & lrankset(INT(znnbrs(ji,jj))) = .true. 707 END DO 708 END DO 709 710 DO jj = 1,jpnij 711 IF ( lrankset(jj) ) THEN 712 nsndto(jtyp) = nsndto(jtyp) + 1 713 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 714 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 715 & ' jpmaxngh will need to be increased ') 716 ENDIF 717 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 718 ENDIF 719 END DO 720 ENDIF 721 722 END DO 723 724 ! 725 ! Type 5: I-point 726 ! 727 ! ICE point exchanges may involve some averaging. The neighbours list is 728 ! built up using two exchanges to ensure that the whole stencil is covered. 729 ! lrankset should not be reset between these 'J' and 'K' point exchanges 730 731 jtyp = 5 732 lrankset = .FALSE. 733 znnbrs = narea 734 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 735 736 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 737 DO jj = nlcj-ijpj+1, nlcj 738 ij = jj - nlcj + ijpj 739 DO ji = 1,jpi 740 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 741 & lrankset(INT(znnbrs(ji,jj))) = .true. 742 END DO 743 END DO 744 ENDIF 745 746 znnbrs = narea 747 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 748 749 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 750 DO jj = nlcj-ijpj+1, nlcj 751 ij = jj - nlcj + ijpj 752 DO ji = 1,jpi 753 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 754 & lrankset( INT(znnbrs(ji,jj))) = .true. 755 END DO 756 END DO 757 758 DO jj = 1,jpnij 759 IF ( lrankset(jj) ) THEN 760 nsndto(jtyp) = nsndto(jtyp) + 1 761 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 762 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 763 & ' jpmaxngh will need to be increased ') 764 ENDIF 765 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 766 ENDIF 767 END DO 768 ! 769 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 770 ! can use peer to peer communications at the north fold 771 ! 772 l_north_nogather = .TRUE. 773 ! 774 ENDIF 775 DEALLOCATE( znnbrs ) 776 DEALLOCATE( lrankset ) 777 778 END SUBROUTINE nemo_northcomms 779 #else 780 SUBROUTINE nemo_northcomms ! Dummy routine 781 WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 782 END SUBROUTINE nemo_northcomms 783 #endif 625 784 !!====================================================================== 626 785 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.