New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13411 – NEMO

Changeset 13411


Ignore:
Timestamp:
2020-08-18T17:58:08+02:00 (4 years ago)
Author:
hadcv
Message:

#2365: Fix some bugs with non-MPP and GYRE code

Location:
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC/mpp_nfd_generic.h90

    r13290 r13411  
    106106      REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthglo 
    107107      !!---------------------------------------------------------------------- 
     108#if defined key_mpp_mpi 
    108109      ! 
    109110      ipk = K_SIZE(ptab)   ! 3rd dimension 
    … …  
    395396      ENDIF   ! l_north_nogather 
    396397      ! 
     398#endif 
    397399   END SUBROUTINE ROUTINE_NFD 
    398400 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC/mppini.F90

    r13305 r13411  
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    64       jpiglo = Ni0glo 
    65       jpjglo = Nj0glo 
     64      nn_hls = 1 
     65      jpiglo = Ni0glo + 2 * nn_hls 
     66      jpjglo = Nj0glo + 2 * nn_hls 
    6667      jpimax = jpiglo 
    6768      jpjmax = jpjglo 
    … …  
    7980      jpnj   = 1 
    8081      jpnij  = jpni*jpnj 
    81       nn_hls = 1 
    8282      nimpp  = 1 
    8383      njmpp  = 1 
    … …  
    675675      ! 
    676676    END SUBROUTINE mpp_init 
    677  
    678  
    679     SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
    680       !!---------------------------------------------------------------------- 
    681       !!                  ***  ROUTINE mpp_basesplit  *** 
    682       !!                     
    683       !! ** Purpose :   Lay out the global domain over processors. 
    684       !! 
    685       !! ** Method  :   Global domain is distributed in smaller local domains. 
    686       !! 
    687       !! ** Action : - set for all knbi*knbj domains: 
    688       !!                    kimppt     : longitudinal index 
    689       !!                    kjmppt     : latitudinal  index 
    690       !!                    klci       : first dimension 
    691       !!                    klcj       : second dimension 
    692       !!---------------------------------------------------------------------- 
    693       INTEGER,                                 INTENT(in   ) ::   kiglo, kjglo 
    694       INTEGER,                                 INTENT(in   ) ::   khls 
    695       INTEGER,                                 INTENT(in   ) ::   knbi, knbj 
    696       INTEGER,                                 INTENT(  out) ::   kimax, kjmax 
    697       INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   kimppt, kjmppt 
    698       INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   klci, klcj 
    699       ! 
    700       INTEGER ::   ji, jj 
    701       INTEGER ::   i2hls  
    702       INTEGER ::   iresti, irestj, irm, ijpjmin 
    703       !!---------------------------------------------------------------------- 
    704       i2hls = 2*khls 
    705       ! 
    706 #if defined key_nemocice_decomp 
    707       kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
    708       kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim.  
    709 #else 
    710       kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
    711       kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls    ! second dim. 
    712 #endif 
    713       IF( .NOT. PRESENT(kimppt) ) RETURN 
    714       ! 
    715       !  1. Dimension arrays for subdomains 
    716       ! ----------------------------------- 
    717       !  Computation of local domain sizes klci() klcj() 
    718       !  These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 
    719       !  The subdomains are squares lesser than or equal to the global 
    720       !  dimensions divided by the number of processors minus the overlap array. 
    721       ! 
    722       iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 
    723       irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 
    724       ! 
    725       !  Need to use kimax and kjmax here since jpi and jpj not yet defined 
    726 #if defined key_nemocice_decomp 
    727       ! Change padding to be consistent with CICE 
    728       klci(1:knbi-1,:       ) = kimax 
    729       klci(  knbi  ,:       ) = kiglo - (knbi - 1) * (kimax - i2hls) 
    730       klcj(:       ,1:knbj-1) = kjmax 
    731       klcj(:       ,  knbj  ) = kjglo - (knbj - 1) * (kjmax - i2hls) 
    732 #else 
    733       klci(1:iresti      ,:) = kimax 
    734       klci(iresti+1:knbi ,:) = kimax-1 
    735       IF( MINVAL(klci) < 2*i2hls ) THEN 
    736          WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 
    737          WRITE(ctmp2,*) '   We have ', MINVAL(klci) 
    738         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    739       ENDIF 
    740       IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 
    741          ! minimize the size of the last row to compensate for the north pole folding coast 
    742          IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 2+3*khls   ! V and F folding must be outside of southern halos 
    743          IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 1+3*khls   ! V and F folding must be outside of southern halos 
    744          irm = knbj - irestj                                       ! total number of lines to be removed 
    745          klcj(:,knbj) = MAX( ijpjmin, kjmax-irm )                  ! we must have jpj >= ijpjmin in the last row 
    746          irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove  
    747          irestj = knbj - 1 - irm 
    748          klcj(:, irestj+1:knbj-1) = kjmax-1 
    749       ELSE 
    750          klcj(:, irestj+1:knbj  ) = kjmax-1 
    751       ENDIF 
    752       klcj(:,1:irestj) = kjmax 
    753       IF( MINVAL(klcj) < 2*i2hls ) THEN 
    754          WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 
    755          WRITE(ctmp2,*) '   We have ', MINVAL(klcj) 
    756          CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    757       ENDIF 
    758 #endif 
    759  
    760       !  2. Index arrays for subdomains 
    761       ! ------------------------------- 
    762       kimppt(:,:) = 1 
    763       kjmppt(:,:) = 1 
    764       ! 
    765       IF( knbi > 1 ) THEN 
    766          DO jj = 1, knbj 
    767             DO ji = 2, knbi 
    768                kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls 
    769             END DO 
    770          END DO 
    771       ENDIF 
    772       ! 
    773       IF( knbj > 1 )THEN 
    774          DO jj = 2, knbj 
    775             DO ji = 1, knbi 
    776                kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls 
    777             END DO 
    778          END DO 
    779       ENDIF 
    780        
    781    END SUBROUTINE mpp_basesplit 
    782677 
    783678 
    … …  
    1027922      ! 
    1028923   END SUBROUTINE mpp_init_landprop 
    1029     
    1030     
     924 
     925 
     926   SUBROUTINE init_ioipsl 
     927      !!---------------------------------------------------------------------- 
     928      !!                  ***  ROUTINE init_ioipsl  *** 
     929      !! 
     930      !! ** Purpose :    
     931      !! 
     932      !! ** Method  :    
     933      !! 
     934      !! History : 
     935      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL  
     936      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij 
     937      !!---------------------------------------------------------------------- 
     938      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
     939      !!---------------------------------------------------------------------- 
     940 
     941      ! The domain is split only horizontally along i- or/and j- direction 
     942      ! So we need at the most only 1D arrays with 2 elements. 
     943      ! Set idompar values equivalent to the jpdom_local_noextra definition 
     944      ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 
     945      iglo( :) = (/ Ni0glo, Nj0glo /) 
     946      iloc( :) = (/ Ni_0  , Nj_0   /) 
     947      iabsf(:) = (/ Nis0  , Njs0   /) + (/ nimpp, njmpp /) - 1 - nn_hls   ! corresponds to mig0(Nis0) but mig0 is not yet defined! 
     948      iabsl(:) = iabsf(:) + iloc(:) - 1 
     949      ihals(:) = (/ 0     , 0      /) 
     950      ihale(:) = (/ 0     , 0      /) 
     951      idid( :) = (/ 1     , 2      /) 
     952 
     953      IF(lwp) THEN 
     954          WRITE(numout,*) 
     955          WRITE(numout,*) 'mpp init_ioipsl :   iloc  = ', iloc 
     956          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf 
     957          WRITE(numout,*) '                    ihals = ', ihals 
     958          WRITE(numout,*) '                    ihale = ', ihale 
     959      ENDIF 
     960      ! 
     961      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 
     962      ! 
     963   END SUBROUTINE init_ioipsl   
     964 
     965 
     966   SUBROUTINE init_nfdcom 
     967      !!---------------------------------------------------------------------- 
     968      !!                     ***  ROUTINE  init_nfdcom  *** 
     969      !! ** Purpose :   Setup for north fold exchanges with explicit  
     970      !!                point-to-point messaging 
     971      !! 
     972      !! ** Method :   Initialization of the northern neighbours lists. 
     973      !!---------------------------------------------------------------------- 
     974      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
     975      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
     976      !!---------------------------------------------------------------------- 
     977      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
     978      !!---------------------------------------------------------------------- 
     979      ! 
     980      !initializes the north-fold communication variables 
     981      isendto(:) = 0 
     982      nsndto     = 0 
     983      ! 
     984      IF ( njmpp == MAXVAL( njmppt ) ) THEN      ! if I am a process in the north 
     985         ! 
     986         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
     987         sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 
     988         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
     989         dxM = jpiglo - nimppt(narea) + 2 
     990         ! 
     991         ! loop over the other north-fold processes to find the processes 
     992         ! managing the points belonging to the sxT-dxT range 
     993         ! 
     994         DO jn = 1, jpni 
     995            ! 
     996            sxT = nfimpp(jn)                    ! sxT = 1st  point (in the global domain) of the jn process 
     997            dxT = nfimpp(jn) + nfjpi(jn) - 1    ! dxT = last point (in the global domain) of the jn process 
     998            ! 
     999            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
     1000               nsndto          = nsndto + 1 
     1001               isendto(nsndto) = jn 
     1002            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN 
     1003               nsndto          = nsndto + 1 
     1004               isendto(nsndto) = jn 
     1005            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN 
     1006               nsndto          = nsndto + 1 
     1007               isendto(nsndto) = jn 
     1008            ENDIF 
     1009            ! 
     1010         END DO 
     1011         ! 
     1012      ENDIF 
     1013      l_north_nogather = .TRUE. 
     1014      ! 
     1015   END SUBROUTINE init_nfdcom 
     1016 
     1017#endif 
     1018 
     1019   SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
     1020      !!---------------------------------------------------------------------- 
     1021      !!                  ***  ROUTINE mpp_basesplit  *** 
     1022      !! 
     1023      !! ** Purpose :   Lay out the global domain over processors. 
     1024      !! 
     1025      !! ** Method  :   Global domain is distributed in smaller local domains. 
     1026      !! 
     1027      !! ** Action : - set for all knbi*knbj domains: 
     1028      !!                    kimppt     : longitudinal index 
     1029      !!                    kjmppt     : latitudinal  index 
     1030      !!                    klci       : first dimension 
     1031      !!                    klcj       : second dimension 
     1032      !!---------------------------------------------------------------------- 
     1033      INTEGER,                                 INTENT(in   ) ::   kiglo, kjglo 
     1034      INTEGER,                                 INTENT(in   ) ::   khls 
     1035      INTEGER,                                 INTENT(in   ) ::   knbi, knbj 
     1036      INTEGER,                                 INTENT(  out) ::   kimax, kjmax 
     1037      INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   kimppt, kjmppt 
     1038      INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   klci, klcj 
     1039      ! 
     1040      INTEGER ::   ji, jj 
     1041      INTEGER ::   i2hls 
     1042      INTEGER ::   iresti, irestj, irm, ijpjmin 
     1043      !!---------------------------------------------------------------------- 
     1044      i2hls = 2*khls 
     1045      ! 
     1046#if defined key_nemocice_decomp 
     1047      kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
     1048      kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim. 
     1049#else 
     1050      kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
     1051      kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls    ! second dim. 
     1052#endif 
     1053      IF( .NOT. PRESENT(kimppt) ) RETURN 
     1054      ! 
     1055      !  1. Dimension arrays for subdomains 
     1056      ! ----------------------------------- 
     1057      !  Computation of local domain sizes klci() klcj() 
     1058      !  These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 
     1059      !  The subdomains are squares lesser than or equal to the global 
     1060      !  dimensions divided by the number of processors minus the overlap array. 
     1061      ! 
     1062      iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 
     1063      irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 
     1064      ! 
     1065      !  Need to use kimax and kjmax here since jpi and jpj not yet defined 
     1066#if defined key_nemocice_decomp 
     1067      ! Change padding to be consistent with CICE 
     1068      klci(1:knbi-1,:       ) = kimax 
     1069      klci(  knbi  ,:       ) = kiglo - (knbi - 1) * (kimax - i2hls) 
     1070      klcj(:       ,1:knbj-1) = kjmax 
     1071      klcj(:       ,  knbj  ) = kjglo - (knbj - 1) * (kjmax - i2hls) 
     1072#else 
     1073      klci(1:iresti      ,:) = kimax 
     1074      klci(iresti+1:knbi ,:) = kimax-1 
     1075      IF( MINVAL(klci) < 2*i2hls ) THEN 
     1076         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 
     1077         WRITE(ctmp2,*) '   We have ', MINVAL(klci) 
     1078        CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
     1079      ENDIF 
     1080      IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 
     1081         ! minimize the size of the last row to compensate for the north pole folding coast 
     1082         IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 2+3*khls   ! V and F folding must be outside of southern halos 
     1083         IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 1+3*khls   ! V and F folding must be outside of southern halos 
     1084         irm = knbj - irestj                                       ! total number of lines to be removed 
     1085         klcj(:,knbj) = MAX( ijpjmin, kjmax-irm )                  ! we must have jpj >= ijpjmin in the last row 
     1086         irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove 
     1087         irestj = knbj - 1 - irm 
     1088         klcj(:, irestj+1:knbj-1) = kjmax-1 
     1089      ELSE 
     1090         klcj(:, irestj+1:knbj  ) = kjmax-1 
     1091      ENDIF 
     1092      klcj(:,1:irestj) = kjmax 
     1093      IF( MINVAL(klcj) < 2*i2hls ) THEN 
     1094         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 
     1095         WRITE(ctmp2,*) '   We have ', MINVAL(klcj) 
     1096         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
     1097      ENDIF 
     1098#endif 
     1099 
     1100      !  2. Index arrays for subdomains 
     1101      ! ------------------------------- 
     1102      kimppt(:,:) = 1 
     1103      kjmppt(:,:) = 1 
     1104      ! 
     1105      IF( knbi > 1 ) THEN 
     1106         DO jj = 1, knbj 
     1107            DO ji = 2, knbi 
     1108               kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls 
     1109            END DO 
     1110         END DO 
     1111      ENDIF 
     1112      ! 
     1113      IF( knbj > 1 )THEN 
     1114         DO jj = 2, knbj 
     1115            DO ji = 1, knbi 
     1116               kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls 
     1117            END DO 
     1118         END DO 
     1119      ENDIF 
     1120 
     1121   END SUBROUTINE mpp_basesplit 
     1122 
     1123 
    10311124   SUBROUTINE mpp_is_ocean( ldisoce ) 
    10321125      !!---------------------------------------------------------------------- 
    … …  
    10441137      !! ** Method  : read inbj strips (of length Ni0glo) of the land-sea mask 
    10451138      !!---------------------------------------------------------------------- 
    1046       LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point  
     1139      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point 
    10471140      ! 
    10481141      INTEGER :: idiv, iimax, ijmax, iarea 
    … …  
    10531146      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi 
    10541147      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj 
    1055       LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean  
     1148      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean 
    10561149      !!---------------------------------------------------------------------- 
    10571150      ! do nothing if there is no land-sea mask 
    … …  
    10861179            isty = 1 + COUNT( (/ iarea == 1 /) )                       ! read from the first or the second line? 
    10871180            CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) )   ! read the strip 
    1088             !  
     1181            ! 
    10891182            IF( iarea == 1    ) THEN                                   ! the first line was not read 
    10901183               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity 
    … …  
    10971190               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity 
    10981191                  CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) )       !      read the first line -> last line of lloce 
    1099                ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point  
     1192               ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point 
    11001193                  lloce(2,iny) = lloce(2,iny-2)                        !      here we have 1 halo (even if nn_hls>1) 
    11011194                  DO ji = 3,inx-1 
    … …  
    11311224         ENDIF 
    11321225      END DO 
    1133     
     1226 
    11341227      inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 
    11351228      CALL mpp_sum( 'mppini', inboce_1d ) 
    … …  
    11391232      ! 
    11401233   END SUBROUTINE mpp_is_ocean 
    1141     
    1142     
    1143    SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 
    1144       !!---------------------------------------------------------------------- 
    1145       !!                  ***  ROUTINE readbot_strip  *** 
    1146       !! 
    1147       !! ** Purpose : Read relevant bathymetric information in order to 
    1148       !!              provide a land/sea mask used for the elimination 
    1149       !!              of land domains, in an mpp computation. 
    1150       !! 
    1151       !! ** Method  : read stipe of size (Ni0glo,...) 
    1152       !!---------------------------------------------------------------------- 
    1153       INTEGER                         , INTENT(in   ) ::   kjstr       ! starting j position of the reading 
    1154       INTEGER                         , INTENT(in   ) ::   kjcnt       ! number of lines to read 
    1155       LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::   ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
    1156       ! 
    1157       INTEGER                           ::   inumsave                ! local logical unit 
    1158       REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy  
    1159       !!---------------------------------------------------------------------- 
    1160       ! 
    1161       inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null 
    1162       ! 
    1163       IF( numbot /= -1 ) THEN    
    1164          CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    1165       ELSE 
    1166          zbot(:,:) = 1._wp                      ! put a non-null value 
    1167       ENDIF 
    1168       ! 
    1169       IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists     
    1170          CALL iom_get ( numbdy, jpdom_unknown,     'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    1171          zbot(:,:) = zbot(:,:) * zbdy(:,:) 
    1172       ENDIF 
    1173       ! 
    1174       ldoce(:,:) = zbot(:,:) > 0._wp 
    1175       numout = inumsave 
    1176       ! 
    1177    END SUBROUTINE readbot_strip 
    11781234 
    11791235 
    … …  
    12311287 
    12321288 
    1233    SUBROUTINE init_ioipsl 
    1234       !!---------------------------------------------------------------------- 
    1235       !!                  ***  ROUTINE init_ioipsl  *** 
    1236       !! 
    1237       !! ** Purpose :    
    1238       !! 
    1239       !! ** Method  :    
    1240       !! 
    1241       !! History : 
    1242       !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL  
    1243       !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij 
    1244       !!---------------------------------------------------------------------- 
    1245       INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    1246       !!---------------------------------------------------------------------- 
    1247  
    1248       ! The domain is split only horizontally along i- or/and j- direction 
    1249       ! So we need at the most only 1D arrays with 2 elements. 
    1250       ! Set idompar values equivalent to the jpdom_local_noextra definition 
    1251       ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 
    1252       iglo( :) = (/ Ni0glo, Nj0glo /) 
    1253       iloc( :) = (/ Ni_0  , Nj_0   /) 
    1254       iabsf(:) = (/ Nis0  , Njs0   /) + (/ nimpp, njmpp /) - 1 - nn_hls   ! corresponds to mig0(Nis0) but mig0 is not yet defined! 
    1255       iabsl(:) = iabsf(:) + iloc(:) - 1 
    1256       ihals(:) = (/ 0     , 0      /) 
    1257       ihale(:) = (/ 0     , 0      /) 
    1258       idid( :) = (/ 1     , 2      /) 
    1259  
    1260       IF(lwp) THEN 
    1261           WRITE(numout,*) 
    1262           WRITE(numout,*) 'mpp init_ioipsl :   iloc  = ', iloc 
    1263           WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf 
    1264           WRITE(numout,*) '                    ihals = ', ihals 
    1265           WRITE(numout,*) '                    ihale = ', ihale 
    1266       ENDIF 
    1267       ! 
    1268       CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 
    1269       ! 
    1270    END SUBROUTINE init_ioipsl   
    1271  
    1272  
    1273    SUBROUTINE init_nfdcom 
    1274       !!---------------------------------------------------------------------- 
    1275       !!                     ***  ROUTINE  init_nfdcom  *** 
    1276       !! ** Purpose :   Setup for north fold exchanges with explicit  
    1277       !!                point-to-point messaging 
    1278       !! 
    1279       !! ** Method :   Initialization of the northern neighbours lists. 
    1280       !!---------------------------------------------------------------------- 
    1281       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    1282       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    1283       !!---------------------------------------------------------------------- 
    1284       INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    1285       !!---------------------------------------------------------------------- 
    1286       ! 
    1287       !initializes the north-fold communication variables 
    1288       isendto(:) = 0 
    1289       nsndto     = 0 
    1290       ! 
    1291       IF ( njmpp == MAXVAL( njmppt ) ) THEN      ! if I am a process in the north 
    1292          ! 
    1293          !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
    1294          sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 
    1295          !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
    1296          dxM = jpiglo - nimppt(narea) + 2 
    1297          ! 
    1298          ! loop over the other north-fold processes to find the processes 
    1299          ! managing the points belonging to the sxT-dxT range 
    1300          ! 
    1301          DO jn = 1, jpni 
    1302             ! 
    1303             sxT = nfimpp(jn)                    ! sxT = 1st  point (in the global domain) of the jn process 
    1304             dxT = nfimpp(jn) + nfjpi(jn) - 1    ! dxT = last point (in the global domain) of the jn process 
    1305             ! 
    1306             IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
    1307                nsndto          = nsndto + 1 
    1308                isendto(nsndto) = jn 
    1309             ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN 
    1310                nsndto          = nsndto + 1 
    1311                isendto(nsndto) = jn 
    1312             ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN 
    1313                nsndto          = nsndto + 1 
    1314                isendto(nsndto) = jn 
    1315             ENDIF 
    1316             ! 
    1317          END DO 
    1318          ! 
    1319       ENDIF 
    1320       l_north_nogather = .TRUE. 
    1321       ! 
    1322    END SUBROUTINE init_nfdcom 
    1323  
    1324 #endif 
     1289   SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 
     1290      !!---------------------------------------------------------------------- 
     1291      !!                  ***  ROUTINE readbot_strip  *** 
     1292      !! 
     1293      !! ** Purpose : Read relevant bathymetric information in order to 
     1294      !!              provide a land/sea mask used for the elimination 
     1295      !!              of land domains, in an mpp computation. 
     1296      !! 
     1297      !! ** Method  : read stipe of size (Ni0glo,...) 
     1298      !!---------------------------------------------------------------------- 
     1299      INTEGER                         , INTENT(in   ) ::   kjstr       ! starting j position of the reading 
     1300      INTEGER                         , INTENT(in   ) ::   kjcnt       ! number of lines to read 
     1301      LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::   ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean 
     1302      ! 
     1303      INTEGER                           ::   inumsave                ! local logical unit 
     1304      REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy 
     1305      !!---------------------------------------------------------------------- 
     1306      ! 
     1307      inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null 
     1308      ! 
     1309      IF( numbot /= -1 ) THEN 
     1310         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
     1311      ELSE 
     1312         zbot(:,:) = 1._wp                      ! put a non-null value 
     1313      ENDIF 
     1314      ! 
     1315      IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists 
     1316         CALL iom_get ( numbdy, jpdom_unknown,     'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
     1317         zbot(:,:) = zbot(:,:) * zbdy(:,:) 
     1318      ENDIF 
     1319      ! 
     1320      ldoce(:,:) = zbot(:,:) > 0._wp 
     1321      numout = inumsave 
     1322      ! 
     1323   END SUBROUTINE readbot_strip 
     1324 
    13251325 
    13261326   SUBROUTINE init_doloop 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/USR/usrdef_hgr.F90

    r13295 r13411  
    9090      zcos_alpha =   SQRT( 2._wp ) * 0.5_wp 
    9191      ze1deg = ze1 / (ra * rad) 
    92       zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo - 2, wp ) 
    93       zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo - 2, wp ) 
     92      zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo, wp ) 
     93      zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo, wp ) 
    9494 
    9595#if defined key_agrif 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/USR/usrdef_nam.F90

    r13286 r13411  
    7070      kk_cfg = nn_GYRE 
    7171      ! 
    72       kpi = 30 * nn_GYRE + 2       !                      
    73       kpj = 20 * nn_GYRE + 2 
     72      kpi = 30 * nn_GYRE       ! 
     73      kpj = 20 * nn_GYRE 
    7474#if defined key_agrif 
    7575      IF( .NOT.Agrif_Root() ) THEN         ! Global Domain size: add 1 land point on each side 
Note: See TracChangeset for help on using the changeset viewer.