Changeset 2648 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

Timestamp:

2011-03-03T17:13:18+01:00 (13 years ago)

Author:

cetlod

Message:

Changed OFF_SRC component to use dynamic memory

File:

• branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90 (modified) (5 diffs)

branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

@@ -5 +5 @@
    !!======================================================================
    !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line: phasing with the on-line
+   !!            4.0  ! 2011-01  (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation
    !!----------------------------------------------------------------------
 
@@ -26 +27 @@
    USE trabbl          ! bottom boundary layer          (tra_bbl_init routine)
    USE zdfini          ! vertical physics: initialization
+   USE sbcmod          ! surface boundary condition       (sbc_init     routine)
    USE phycst          ! physical constant                  (par_cst routine)
    USE dtadyn          ! Lecture and Interpolation of the dynamical fields
@@ -137 +139 @@
       !                             !--------------------------------------------!
 #if defined key_iomput
-      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server
-      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection
+      CALL  init_ioclient( ilocal_comm )                 ! exchange io_server nemo local communicator with the io_server
+      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection
 #else
-      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt)
+      ilocal_comm = 0
+      narea = mynode( cltxt, numnam, nstop )                 ! Nodes selection (control print return in cltxt)
 #endif
+
       narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 )
 
       lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
+
+      ! Decide on size of grid now that we have our communicator size
+      ! If we're not using dynamic memory then mpp_partition does nothing.
+
+#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+      CALL nemo_partition(mppsize)
+#else
+      jpni = 1
+      jpnj = 1
+      jpnij = jpni*jpnj
+#endif
+      ! Calculate domain dimensions given calculated jpni and jpnj
+      ! This used to be done in par_oce.F90 when they were parameters rather
+      ! than variables
+      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci !: first  dim.
+      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dim.
+      jpim1 = jpi-1                                          !: inner domain indices
+      jpjm1 = jpj-1                                          !:   "           "
+      jpkm1 = jpk-1                                          !:   "           "
+      jpij  = jpi*jpj                                        !:  jpi x j
+
+      ! Now we know the dimensions of the grid, allocate arrays
+      CALL nemo_alloc()
 
       IF(lwp) THEN                            ! open listing units
@@ -182 +209 @@
 
       !                                     ! Ocean physics
+                            CALL     sbc_init   ! Forcings : surface module
 #if ! defined key_degrad
                             CALL ldf_tra_init   ! Lateral ocean tracer physics
@@ -307 +335 @@
    END SUBROUTINE nemo_closefile
 
+   SUBROUTINE nemo_alloc
+     !!----------------------------------------------------------------------
+     !!                     ***  ROUTINE nemo_alloc  ***
+     !!
+     !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+     !!
+     !! ** Method  :
+     !!----------------------------------------------------------------------
+     USE diawri,       ONLY: dia_wri_alloc
+     USE dom_oce,      ONLY: dom_oce_alloc
+     USE zdf_oce,      ONLY: zdf_oce_alloc
+     USE zdfmxl,       ONLY: zdf_mxl_alloc
+     USE ldftra_oce,   ONLY: ldftra_oce_alloc
+     USE trc_oce,      ONLY: trc_oce_alloc
+
+      USE wrk_nemo,    ONLY: wrk_alloc
+
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+
+      ierr =        oce_alloc       ()          ! ocean 
+      ierr = ierr + dia_wri_alloc   ()
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
+      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
+      ierr = ierr + zdf_mxl_alloc   ()          ! ocean vertical physics
+      !
+      ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges
+      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
+      ierr = ierr + wrk_alloc(numout, lwp)
+
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE par_oce
+      INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
+      ! Local variables
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: i
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+
+      ierr = 0
+
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO i=1,nfact-1,2
+            idiff = ABS(ifact(i) - ifact(i+1))
+            IF(idiff < mindiff)THEN
+               mindiff = idiff
+               imin = i
+            END IF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      jpnij = jpni*jpnj
+
+      WRITE(*,*) 'ARPDBG: jpni = ',jpni,'jpnj = ',jpnj,'jpnij = ',jpnij
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( ifax, maxfax, nfax, n, ierr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                nfax factors are returned in array ifax which is of 
+      !!                maximum dimension maxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: n, maxfax
+      INTEGER, INTENT(Out) :: ierr, nfax
+      INTEGER, INTENT(out) :: ifax(maxfax)
+      ! Local variables.
+      INTEGER :: i, ifac, l, nu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER :: lfax(ntest)
+
+      ! lfax contains the set of allowed factors.
+      data (lfax(i),i=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
+         &                         128,   64,   32,   16,    8,   4,   2  /
+      !!----------------------------------------------------------------------
+
+      ! Clear the error flag and initialise output vars
+      ierr = 0
+      ifax = 1
+      nfax = 0
+
+      ! Find the factors of n.
+      IF( n == 1 ) GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! nfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+
+      nu   = n
+      nfax = 0
+
+      DO l = ntest, 1, -1
+         !
+         ifac = lfax(l)
+         IF(ifac > nu)CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(nu,ifac) == 0 ) THEN
+            !
+            nfax = nfax+1            ! Add the factor to the list
+            IF( nfax > maxfax ) THEN
+               ierr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ',nfax
+               return
+            ENDIF
+            ifax(nfax) = ifac
+            ! Store the other factor that goes with this one
+            nfax = nfax + 1
+            ifax(nfax) = nu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',nfax-1,' & ',nfax,' are ', &
+            !            ifax(nfax-1),' and ',ifax(nfax)
+         ENDIF
+         !
+      END DO
+
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+      RETURN
+      !
+   END SUBROUTINE factorise
    !!======================================================================
 END MODULE nemogcm