Changeset 14072 for NEMO/trunk/src/OCE/LBC/mppini.F90

Timestamp:

2020-12-04T08:48:38+01:00 (3 years ago)

Author:

laurent

Message:

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369

File:

• NEMO/trunk/src/OCE/LBC/mppini.F90 (modified) (53 diffs)

NEMO/trunk/src/OCE/LBC/mppini.F90

@@ -9 +9 @@
    !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
    !!            3.4  !  2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)  add init_nfdcom
-   !!            3.   !  2013-06  (I. Epicoco, S. Mocavero, CMCC)  init_nfdcom: setup avoiding MPI communication 
+   !!            3.   !  2013-06  (I. Epicoco, S. Mocavero, CMCC)  init_nfdcom: setup avoiding MPI communication
    !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file
    !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2
@@ -16 +16 @@
    !!----------------------------------------------------------------------
    !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination
-   !!      init_ioipsl: IOIPSL initialization in mpp 
+   !!      init_ioipsl: IOIPSL initialization in mpp
    !!      init_nfdcom: Setup for north fold exchanges with explicit point-to-point messaging
-   !!      init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute 
+   !!      init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
-   USE bdy_oce        ! open BounDarY  
+   USE bdy_oce        ! open BounDarY
    !
-   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges 
+   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges
    USE lib_mpp        ! distribued memory computing library
-   USE iom            ! nemo I/O library 
+   USE iom            ! nemo I/O library
    USE ioipsl         ! I/O IPSL library
    USE in_out_manager ! I/O Manager
@@ -36 +36 @@
    PUBLIC   mpp_basesplit  ! called by prtctl
    PUBLIC   mpp_is_ocean   ! called by prtctl
-   
+
    INTEGER ::   numbot = -1   ! 'bottom_level' local logical unit
    INTEGER ::   numbdy = -1   ! 'bdy_msk'      local logical unit
-   
+
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -88 +88 @@
       l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
       !
-      CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls) 
+      CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls)
       !
       IF(lwp) THEN
@@ -94 +94 @@
          WRITE(numout,*) 'mpp_init : NO massively parallel processing'
          WRITE(numout,*) '~~~~~~~~ '
-         WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio 
+         WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio
          WRITE(numout,*) '     npolj  = ',   npolj , '      njmpp  = ', njmpp
       ENDIF
@@ -114 +114 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE mpp_init  ***
-      !!                    
+      !!
       !! ** Purpose :   Lay out the global domain over processors.
       !!      If land processors are to be eliminated, this program requires the
@@ -128 +128 @@
       !!
       !! ** Action : - set domain parameters
-      !!                    nimpp     : longitudinal index 
+      !!                    nimpp     : longitudinal index
       !!                    njmpp     : latitudinal  index
       !!                    narea     : number for local area
@@ -148 +148 @@
       INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       -
       INTEGER ::   iarea0                     !   -       -
-      INTEGER ::   ierr, ios                  ! 
+      INTEGER ::   ierr, ios                  !
       INTEGER ::   inbi, inbj, iimax,  ijmax, icnt1, icnt2
       LOGICAL ::   llbest, llauto
@@ -162 +162 @@
       NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           &
            &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
-           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &  
+           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
            &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
            &             cn_ice, nn_ice_dta,                                     &
@@ -177 +177 @@
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist' )
       READ  ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' )   
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' )
       !
       nn_hls = MAX(1, nn_hls)   ! nn_hls must be > 0
@@ -259 +259 @@
          ENDIF
       ENDIF
-      
+
       ! look for land mpi subdomains...
       ALLOCATE( llisoce(jpni,jpnj) )
@@ -333 +333 @@
       CALL mpp_sum( 'mppini', ierr )
       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' )
-      
+
 #if defined key_agrif
       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
@@ -354 +354 @@
       !   nfjpi (jn) =   ijpi(ii,ij)
       !END DO
-      nfproc(:) = ipproc(:,jpnj) 
-      nfimpp(:) = iimppt(:,jpnj) 
+      nfproc(:) = ipproc(:,jpnj)
+      nfimpp(:) = iimppt(:,jpnj)
       nfjpi (:) =   ijpi(:,jpnj)
       !
@@ -363 +363 @@
          WRITE(numout,*)
          WRITE(numout,*) '   defines mpp subdomains'
-         WRITE(numout,*) '      jpni = ', jpni  
+         WRITE(numout,*) '      jpni = ', jpni
          WRITE(numout,*) '      jpnj = ', jpnj
          WRITE(numout,*) '     jpnij = ', jpnij
@@ -370 +370 @@
          WRITE(numout,*) '      sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo
       ENDIF
-     
+
       ! 3. Subdomain description in the Regular Case
       ! --------------------------------------------
       ! specific cases where there is no communication -> must do the periodicity by itself
-      ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2  
+      ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2
       l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
       l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
-      
+
       DO jarea = 1, jpni*jpnj
          !
@@ -450 +450 @@
             ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057)
             ! --> for northern neighbours of northern row processors (in case of north-fold)
-            !     need to reverse the LOGICAL direction of communication 
+            !     need to reverse the LOGICAL direction of communication
             idir = 1                                           ! we are indeed the s neigbour of this n neigbour
             IF( ij == jpnj .AND. ijno == jpnj )   idir = -1    ! both are on the last row, we are in fact the n neigbour
@@ -478 +478 @@
          ENDIF
       END DO
-      
+
       ! 5. Subdomain print
       ! ------------------
@@ -504 +504 @@
  9404    FORMAT('           *  '   ,20('     ' ,i4,'   *   ') )
       ENDIF
-         
+
       ! just to save nono etc for all proc
       ! warning ii*ij (zone) /= nproc (processors)!
@@ -511 +511 @@
       ii_nono(:) = -1
       ii_noea(:) = -1
-      ii_nowe(:) = -1 
+      ii_nowe(:) = -1
       DO jproc = 1, jpnij
          ii = iin(jproc)
@@ -536 +536 @@
          ENDIF
       END DO
-    
+
       ! 6. Change processor name
       ! ------------------------
@@ -542 +542 @@
       ij = ijn(narea)
       !
-      jpi    = ijpi(ii,ij)  
+      jpi    = ijpi(ii,ij)
 !!$      Nis0  = iis0(ii,ij)
 !!$      Nie0  = iie0(ii,ij)
-      jpj    = ijpj(ii,ij)  
+      jpj    = ijpj(ii,ij)
 !!$      Njs0  = ijs0(ii,ij)
 !!$      Nje0  = ije0(ii,ij)
       nbondi = ibondi(ii,ij)
       nbondj = ibondj(ii,ij)
-      nimpp = iimppt(ii,ij)  
+      nimpp = iimppt(ii,ij)
       njmpp = ijmppt(ii,ij)
       jpk = jpkglo                              ! third dim
@@ -564 +564 @@
       noses = -1
       nosws = -1
-      
+
       noner = -1
       nonwr = -1
@@ -613 +613 @@
 
       !
-      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 
+      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls)
       !
       jpim1 = jpi-1                             ! inner domain indices
@@ -630 +630 @@
          ibonit(jproc) = ibondi(ii,ij)
          ibonjt(jproc) = ibondj(ii,ij)
-         nimppt(jproc) = iimppt(ii,ij)  
-         njmppt(jproc) = ijmppt(ii,ij) 
+         nimppt(jproc) = iimppt(ii,ij)
+         njmppt(jproc) = ijmppt(ii,ij)
       END DO
 
@@ -647 +647 @@
                &                                nis0all(jproc), njs0all(jproc),   &
                &                                nie0all(jproc), nje0all(jproc),   &
-               &                                nimppt (jproc), njmppt (jproc),   & 
+               &                                nimppt (jproc), njmppt (jproc),   &
                &                                ii_nono(jproc), ii_noso(jproc),   &
                &                                ii_nowe(jproc), ii_noea(jproc),   &
-               &                                ibonit (jproc), ibonjt (jproc) 
+               &                                ibonit (jproc), ibonjt (jproc)
          END DO
       END IF
@@ -707 +707 @@
       !
       CALL init_ioipsl       ! Prepare NetCDF output file (if necessary)
-      !      
+      !
       IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN
          CALL init_nfdcom     ! northfold neighbour lists
@@ -719 +719 @@
       ENDIF
       !
-      IF (llwrtlay) CLOSE(inum)   
+      IF (llwrtlay) CLOSE(inum)
       !
       DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    &
@@ -733 +733 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE mpp_basesplit  ***
-      !!                    
+      !!
       !! ** Purpose :   Lay out the global domain over processors.
       !!
@@ -752 +752 @@
       !
       INTEGER ::   ji, jj
-      INTEGER ::   i2hls 
+      INTEGER ::   i2hls
       INTEGER ::   iresti, irestj, irm, ijpjmin
       !!----------------------------------------------------------------------
@@ -759 +759 @@
 #if defined key_nemocice_decomp
       kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim.
-      kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim. 
+      kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim.
 #else
       kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim.
@@ -797 +797 @@
          irm = knbj - irestj                                       ! total number of lines to be removed
          klcj(:,knbj) = MAX( ijpjmin, kjmax-irm )                  ! we must have jpj >= ijpjmin in the last row
-         irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove 
+         irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove
          irestj = knbj - 1 - irm
          klcj(:, irestj+1:knbj-1) = kjmax-1
@@ -831 +831 @@
          END DO
       ENDIF
-      
+
    END SUBROUTINE mpp_basesplit
 
@@ -890 +890 @@
       ! get the list of knbi that gives a smaller jpimax than knbi-1
       ! get the list of knbj that gives a smaller jpjmax than knbj-1
-      DO ji = 1, inbijmax      
+      DO ji = 1, inbijmax
 #if defined key_nemocice_decomp
          iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim.
@@ -958 +958 @@
       ! extract only the partitions which reduce the subdomain size in comparison with smaller partitions
       ALLOCATE( indexok(isz1) )                                 ! to store indices of the best partitions
-      isz0 = 0                                                  ! number of best partitions     
+      isz0 = 0                                                  ! number of best partitions
       inbij = 1                                                 ! start with the min value of inbij1 => 1
       iszij = jpiglo*jpjglo+1                                   ! default: larger than global domain
@@ -1018 +1018 @@
          CALL mppstop( ld_abort = .TRUE. )
       ENDIF
-      
+
       DEALLOCATE( iszi0, iszj0 )
       inbij = inbijmax + 1        ! default: larger than possible
       ii = isz0+1                 ! start from the end of the list (smaller subdomains)
       DO WHILE( inbij > knbij )   ! while the number of ocean subdomains exceed the number of procs
-         ii = ii -1 
+         ii = ii -1
          ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) )
          CALL mpp_is_ocean( llisoce )            ! must be done by all core
@@ -1035 +1035 @@
       !
    END SUBROUTINE bestpartition
-   
-   
+
+
    SUBROUTINE mpp_init_landprop( propland )
       !!----------------------------------------------------------------------
@@ -1059 +1059 @@
       ENDIF
 
-      ! number of processes reading the bathymetry file 
+      ! number of processes reading the bathymetry file
       iproc = MINVAL( (/mppsize, Nj0glo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time
-      
+
       ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1
       IF( iproc == 1 ) THEN   ;   idiv = mppsize
@@ -1084 +1084 @@
       CALL mpp_sum( 'mppini', inboce )   ! total number of ocean points over the global domain
       !
-      propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp ) 
+      propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp )
       !
    END SUBROUTINE mpp_init_landprop
-   
-   
+
+
    SUBROUTINE mpp_is_ocean( ldisoce )
       !!----------------------------------------------------------------------
@@ -1104 +1104 @@
       !! ** Method  : read inbj strips (of length Ni0glo) of the land-sea mask
       !!----------------------------------------------------------------------
-      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point 
+      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point
       !
       INTEGER :: idiv, iimax, ijmax, iarea
@@ -1113 +1113 @@
       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi
       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj
-      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean 
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean
       !!----------------------------------------------------------------------
       ! do nothing if there is no land-sea mask
@@ -1146 +1146 @@
             isty = 1 + COUNT( (/ iarea == 1 /) )                       ! read from the first or the second line?
             CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) )   ! read the strip
-            ! 
+            !
             IF( iarea == 1    ) THEN                                   ! the first line was not read
                IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity
@@ -1157 +1157 @@
                IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity
                   CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) )       !      read the first line -> last line of lloce
-               ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point 
+               ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point
                   lloce(2,iny) = lloce(2,iny-2)                        !      here we have 1 halo (even if nn_hls>1)
                   DO ji = 3,inx-1
@@ -1191 +1191 @@
          ENDIF
       END DO
-   
+
       inboce_1d = RESHAPE(inboce, (/ inbi*inbj /))
       CALL mpp_sum( 'mppini', inboce_1d )
@@ -1199 +1199 @@
       !
    END SUBROUTINE mpp_is_ocean
-   
-   
+
+
    SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce )
       !!----------------------------------------------------------------------
@@ -1213 +1213 @@
       INTEGER                         , INTENT(in   ) ::   kjstr       ! starting j position of the reading
       INTEGER                         , INTENT(in   ) ::   kjcnt       ! number of lines to read
-      LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::   ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean 
+      LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::   ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean
       !
       INTEGER                           ::   inumsave                ! local logical unit
-      REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy 
+      REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy
       !!----------------------------------------------------------------------
       !
       inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null
       !
-      IF( numbot /= -1 ) THEN   
+      IF( numbot /= -1 ) THEN
          CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) )
       ELSE
@@ -1227 +1227 @@
       ENDIF
       !
-      IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists    
+      IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists
          CALL iom_get ( numbdy, jpdom_unknown,     'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) )
          zbot(:,:) = zbot(:,:) * zbdy(:,:)
@@ -1295 +1295 @@
       !!                  ***  ROUTINE init_ioipsl  ***
       !!
-      !! ** Purpose :   
-      !!
-      !! ** Method  :   
+      !! ** Purpose :
+      !!
+      !! ** Method  :
       !!
       !! History :
-      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
+      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL
       !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
       !!----------------------------------------------------------------------
@@ -1328 +1328 @@
       CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
       !
-   END SUBROUTINE init_ioipsl  
+   END SUBROUTINE init_ioipsl
 
 
@@ -1334 +1334 @@
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE  init_nfdcom  ***
-      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !! ** Purpose :   Setup for north fold exchanges with explicit
       !!                point-to-point messaging
       !!
@@ -1340 +1340 @@
       !!----------------------------------------------------------------------
       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
       !!----------------------------------------------------------------------
       INTEGER  ::   sxM, dxM, sxT, dxT, jn
@@ -1392 +1392 @@
       !
       Nis0 =   1+nn_hls   ;   Nis1 = Nis0-1   ;   Nis2 = MAX(  1, Nis0-2)
-      Njs0 =   1+nn_hls   ;   Njs1 = Njs0-1   ;   Njs2 = MAX(  1, Njs0-2)  
-      !                                                 
+      Njs0 =   1+nn_hls   ;   Njs1 = Njs0-1   ;   Njs2 = MAX(  1, Njs0-2)
+      !
       Nie0 = jpi-nn_hls   ;   Nie1 = Nie0+1   ;   Nie2 = MIN(jpi, Nie0+2)
       Nje0 = jpj-nn_hls   ;   Nje1 = Nje0+1   ;   Nje2 = MIN(jpj, Nje0+2)
@@ -1402 +1402 @@
          Nie1nxt2 = Nie0   ;   Nje1nxt2 = Nje0
          !
-      ELSE                            !* larger halo size... 
+      ELSE                            !* larger halo size...
          !
          Nis1nxt2 = Nis1   ;   Njs1nxt2 = Njs1
@@ -1417 +1417 @@
       !
    END SUBROUTINE init_doloop
-   
+
    !!======================================================================
 END MODULE mppini