Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

Timestamp:

2012-01-28T17:44:18+01:00 (12 years ago)

Author:

rblod

Message:

Merge of 3.4beta into the trunk

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 (modified) (16 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

@@ -27 +27 @@
    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
-   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE
    !!----------------------------------------------------------------------
 
@@ -46 +47 @@
    USE domain          ! domain initialization             (dom_init routine)
    USE obcini          ! open boundary cond. initialization (obc_ini routine)
-   USE bdyini          ! unstructured open boundary cond. initialization (bdy_init routine)
+   USE bdyini          ! open boundary cond. initialization (bdy_init routine)
+   USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine)
+   USE bdytides        ! open boundary cond. initialization (tide_init routine)
    USE istate          ! initial state setting          (istate_init routine)
    USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
@@ -53 +56 @@
    USE phycst          ! physical constant                  (par_cst routine)
    USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
-   USE asminc          ! assimilation increments       (asm_inc_init routine)
    USE asmtrj          ! writing out state trajectory
-   USE sshwzv          ! vertical velocity used in asm
    USE diaptr          ! poleward transports           (dia_ptr_init routine)
+   USE diadct          ! sections transports           (dia_dct_init routine)
    USE diaobs          ! Observation diagnostics       (dia_obs_init routine)
    USE step            ! NEMO time-stepping                 (stp     routine)
@@ -171 +173 @@
       ENDIF
       !
+#if defined key_agrif
+      CALL Agrif_ParentGrid_To_ChildGrid()
+      IF( lk_diaobs ) CALL dia_obs_wri
+      IF( nn_timing == 1 )   CALL timing_finalize
+      CALL Agrif_ChildGrid_To_ParentGrid()
+#endif
+      IF( nn_timing == 1 )   CALL timing_finalize
+      !
       CALL nemo_closefile
 #if defined key_oasis3 || defined key_oasis4
@@ -192 +202 @@
       !!
       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
-         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_bench, nn_timing
       !!----------------------------------------------------------------------
       !
@@ -245 +256 @@
       IF( Agrif_Root() ) THEN
          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
+#if defined key_nemocice_decomp
+         jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+#else
          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
+#endif
          jpk = jpkdta                                             ! third dim
          jpim1 = jpi-1                                            ! inner domain indices
@@ -258 +273 @@
          !
          WRITE(numout,*)
-         WRITE(numout,*) '         CNRS - NERC - Met OFFICE - MERCATOR-ocean'
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.3  (2010) '
+         WRITE(numout,*) '                  version 3.4  (2011) '
          WRITE(numout,*)
          WRITE(numout,*)
@@ -286 +301 @@
       ENDIF
       !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
       !                                      ! General initialization
                             CALL     phy_cst    ! Physical constants
@@ -292 +309 @@
                             CALL     dom_init   ! Domain
 
+      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
+
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
 
       IF( lk_obc        )   CALL     obc_init   ! Open boundaries 
-      IF( lk_bdy        )   CALL     bdy_init   ! Unstructured open boundaries
+      IF( lk_bdy        )   CALL     bdy_init       ! Open boundaries initialisation
+      IF( lk_bdy        )   CALL     bdy_dta_init   ! Open boundaries initialisation of external data arrays
+      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing
+
+                            CALL flush(numout)
+                            CALL dyn_nept_init  ! simplified form of Neptune effect
+                            CALL flush(numout)
 
                             CALL  istate_init   ! ocean initial state (Dynamics and tracers)
@@ -320 +345 @@
                             CALL tra_bbc_init   ! bottom heat flux
       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
-      IF( lk_tradmp     )   CALL tra_dmp_init   ! internal damping trends
+      IF( ln_tradmp     )   CALL tra_dmp_init   ! internal damping trends
                             CALL tra_adv_init   ! horizontal & vertical advection
                             CALL tra_ldf_init   ! lateral mixing
@@ -341 +366 @@
 #endif
       !                                     ! Diagnostics
+      IF( lk_floats     )   CALL     flo_init   ! drifting Floats
                             CALL     iom_init   ! iom_put initialization
-      IF( lk_floats     )   CALL     flo_init   ! drifting Floats
       IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag
                             CALL dia_ptr_init   ! Poleward TRansports initialization
+      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports
                             CALL dia_hsb_init   ! heat content, salt content and volume budgets
                             CALL trd_mod_init   ! Mixed-layer/Vorticity/Integral constraints trends
@@ -394 +420 @@
       !
       IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
-         IF( lk_mpp ) THEN
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
          ELSE
@@ -456 +482 @@
       CALL iom_close                                 ! close all input/output files managed by iom_*
       !
-      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
-      IF( numsol     /= -1 )   CLOSE( numsol     )   ! solver file
-      IF( numnam     /= -1 )   CLOSE( numnam     )   ! oce namelist
-      IF( numnam_ice /= -1 )   CLOSE( numnam_ice )   ! ice namelist
-      IF( numevo_ice /= -1 )   CLOSE( numevo_ice )   ! ice variables (temp. evolution)
-      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
+      IF( numstp      /= -1 )   CLOSE( numstp      )   ! time-step file
+      IF( numsol      /= -1 )   CLOSE( numsol      )   ! solver file
+      IF( numnam      /= -1 )   CLOSE( numnam      )   ! oce namelist
+      IF( numnam_ice  /= -1 )   CLOSE( numnam_ice  )   ! ice namelist
+      IF( numevo_ice  /= -1 )   CLOSE( numevo_ice  )   ! ice variables (temp. evolution)
+      IF( numout      /=  6 )   CLOSE( numout      )   ! standard model output file
+      IF( numdct_vol  /= -1 )   CLOSE( numdct_vol  )   ! volume transports
+      IF( numdct_heat /= -1 )   CLOSE( numdct_heat )   ! heat transports
+      IF( numdct_salt /= -1 )   CLOSE( numdct_salt )   ! salt transports
+
       !
       numout = 6                                     ! redefine numout in case it is used after this point...
@@ -481 +511 @@
       USE ldftra_oce, ONLY: ldftra_oce_alloc
       USE trc_oce   , ONLY: trc_oce_alloc
-      USE wrk_nemo  , ONLY: wrk_alloc
       !
       INTEGER :: ierr
@@ -495 +524 @@
       ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges
       ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
-      !
-      ierr = ierr + wrk_alloc(numout, lwp)      ! workspace
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
@@ -617 +644 @@
    END SUBROUTINE factorise
 
+#if defined key_mpp_mpi
+   SUBROUTINE nemo_northcomms
+      !!======================================================================
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !! 
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
+      !!----------------------------------------------------------------------
+
+      INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices
+      INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange
+      INTEGER ::   northcomms_alloc        ! allocate return status
+      REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace
+      LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc )
+      ALLOCATE( lrankset(jpnij), stat = northcomms_alloc )
+      IF( northcomms_alloc /= 0 ) THEN
+         WRITE(numout,cform_war)
+         WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays'
+         CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' )
+      ENDIF
+      nsndto = 0
+      isendto = -1
+      ijpj   = 4
+      !
+      ! This routine has been called because ln_nnogather has been set true ( nammpp )
+      ! However, these first few exchanges have to use the mpi_allgather method to
+      ! establish the neighbour lists to use in subsequent peer to peer exchanges.
+      ! Consequently, set l_north_nogather to be false here and set it true only after
+      ! the lists have been established.
+      !
+      l_north_nogather = .FALSE.
+      !
+      ! Exchange and store ranks on northern rows
+
+      DO jtyp = 1,4
+
+         lrankset = .FALSE.
+         znnbrs = narea
+         SELECT CASE (jtyp)
+            CASE(1)
+               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points
+            CASE(2)
+               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point
+            CASE(3)
+               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point
+            CASE(4)
+               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point
+         END SELECT
+
+         IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+            DO jj = nlcj-ijpj+1, nlcj
+               ij = jj - nlcj + ijpj
+               DO ji = 1,jpi
+                  IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+               &     lrankset(INT(znnbrs(ji,jj))) = .true.
+               END DO
+            END DO
+
+            DO jj = 1,jpnij
+               IF ( lrankset(jj) ) THEN
+                  nsndto(jtyp) = nsndto(jtyp) + 1
+                  IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                     CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+                  &                 ' jpmaxngh will need to be increased ')
+                  ENDIF
+                  isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+               ENDIF
+            END DO
+         ENDIF
+
+      END DO
+
+      !
+      ! Type 5: I-point
+      !
+      ! ICE point exchanges may involve some averaging. The neighbours list is
+      ! built up using two exchanges to ensure that the whole stencil is covered.
+      ! lrankset should not be reset between these 'J' and 'K' point exchanges
+
+      jtyp = 5
+      lrankset = .FALSE.
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+            &     lrankset(INT(znnbrs(ji,jj))) = .true.
+         END DO
+        END DO
+      ENDIF
+
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) &
+            &       lrankset( INT(znnbrs(ji,jj))) = .true.
+            END DO
+         END DO
+
+         DO jj = 1,jpnij
+            IF ( lrankset(jj) ) THEN
+               nsndto(jtyp) = nsndto(jtyp) + 1
+               IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                  CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+               &                 ' jpmaxngh will need to be increased ')
+               ENDIF
+               isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+            ENDIF
+         END DO
+         !
+         ! For northern row areas, set l_north_nogather so that all subsequent exchanges 
+         ! can use peer to peer communications at the north fold
+         !
+         l_north_nogather = .TRUE.
+         !
+      ENDIF
+      DEALLOCATE( znnbrs )
+      DEALLOCATE( lrankset )
+
+   END SUBROUTINE nemo_northcomms
+#else
+   SUBROUTINE nemo_northcomms      ! Dummy routine
+      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
+   END SUBROUTINE nemo_northcomms
+#endif
    !!======================================================================
 END MODULE nemogcm