Changeset 3680 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

Timestamp:

2012-11-27T15:42:24+01:00 (11 years ago)

Author:

rblod

Message:

First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028

File:

• branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90 (modified) (2 diffs)

branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

@@ -17 +17 @@
    USE par_trc          ! TOP parameters
    USE oce_trc          ! ocean space and time domain variables
+   USE prtctl           ! print control for OPA
 
    IMPLICIT NONE
@@ -296 +297 @@
    END SUBROUTINE prt_ctl_trc_init
 
-
-   SUBROUTINE sub_dom
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sub_dom  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors. 
-      !!                CAUTION: 
-      !!                This part has been extracted from the mpp_init
-      !!                subroutine and names of variables/arrays have been 
-      !!                slightly changed to avoid confusion but the computation
-      !!                is exactly the same. Any modification about indices of
-      !!                each sub-domain in the mppini.F90 module should be reported 
-      !!                here.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!                Periodic condition is a function of the local domain position
-      !!                (global boundary or neighbouring domain) and of the global
-      !!                periodic
-      !!                Type :         jperio global periodic condition
-      !!                               nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlcil      : first dimension
-      !!                    nlcjl      : second dimension
-      !!                    nbondil    : mark for "east-west local boundary"
-      !!                    nbondjl    : mark for "north-south local boundary"
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, js               ! dummy loop indices
-      INTEGER ::   ii, ij                   ! temporary integers
-      INTEGER ::   irestil, irestjl         !    "          "
-      INTEGER ::   ijpi  , ijpj, nlcil      ! temporary logical unit
-      INTEGER ::   nlcjl , nbondil, nbondjl
-      INTEGER ::   nrecil, nrecjl, nldil, nleil, nldjl, nlejl
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
-      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
-      !
-      ! Dimension arrays for subdomains
-      ! -------------------------------
-      !  Computation of local domain sizes ilcitl() ilcjtl()
-      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-
-      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
-      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
-
-      nrecil  = 2 * jpreci
-      nrecjl  = 2 * jprecj
-      irestil = MOD( jpiglo - nrecil , isplt )
-      irestjl = MOD( jpjglo - nrecjl , jsplt )
-
-      IF(  irestil == 0 )   irestil = isplt
-      DO jj = 1, jsplt
-         DO ji = 1, irestil
-            ilcitl(ji,jj) = ijpi
-         END DO
-         DO ji = irestil+1, isplt
-            ilcitl(ji,jj) = ijpi -1
-         END DO
-      END DO
-      
-      IF( irestjl == 0 )   irestjl = jsplt
-      DO ji = 1, isplt
-         DO jj = 1, irestjl
-            ilcjtl(ji,jj) = ijpj
-         END DO
-         DO jj = irestjl+1, jsplt
-            ilcjtl(ji,jj) = ijpj -1
-         END DO
-      END DO
-      
-      zidom = nrecil
-      DO ji = 1, isplt
-         zidom = zidom + ilcitl(ji,1) - nrecil
-      END DO
-      
-      zjdom = nrecjl
-      DO jj = 1, jsplt
-         zjdom = zjdom + ilcjtl(1,jj) - nrecjl
-      END DO
-
-      ! Index arrays for subdomains
-      ! ---------------------------
-
-      iimpptl(:,:) = 1
-      ijmpptl(:,:) = 1
-      
-      IF( isplt > 1 ) THEN
-         DO jj = 1, jsplt
-            DO ji = 2, isplt
-               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil
-            END DO
-         END DO
-      ENDIF
-
-      IF( jsplt > 1 ) THEN
-         DO jj = 2, jsplt
-            DO ji = 1, isplt
-               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl
-            END DO
-         END DO
-      ENDIF
-      
-      ! Subdomain description
-      ! ---------------------
-
-      DO js = 1, ijsplt
-         ii = 1 + MOD( js-1, isplt )
-         ij = 1 + (js-1) / isplt
-         nimpptl(js) = iimpptl(ii,ij)
-         njmpptl(js) = ijmpptl(ii,ij)
-         nlcitl (js) = ilcitl (ii,ij)     
-         nlcil       = nlcitl (js)     
-         nlcjtl (js) = ilcjtl (ii,ij)     
-         nlcjl       = nlcjtl (js)
-         nbondjl = -1                                    ! general case
-         IF( js   >  isplt          )   nbondjl = 0      ! first row of processor
-         IF( js   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
-         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
-         ibonjtl(js) = nbondjl
-         
-         nbondil = 0                                     ! 
-         IF( MOD( js, isplt ) == 1 )   nbondil = -1      !
-         IF( MOD( js, isplt ) == 0 )   nbondil =  1      !
-         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
-         ibonitl(js) = nbondil
-         
-         nldil =  1   + jpreci
-         nleil = nlcil - jpreci
-         IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1
-         IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil
-         nldjl =  1   + jprecj
-         nlejl = nlcjl - jprecj
-         IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1
-         IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl
-         nlditl(js) = nldil
-         nleitl(js) = nleil
-         nldjtl(js) = nldjl
-         nlejtl(js) = nlejl
-      END DO
-      !
-      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
-      !
-   END SUBROUTINE sub_dom
- 
 #else
    !!----------------------------------------------------------------------