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 12807 – NEMO

Changeset 12807


Ignore:
Timestamp:
2020-04-23T15:14:45+02:00 (4 years ago)
Author:
smasson
Message:

Extra_Halo: input file only over inner domain + new variables names, see #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
Files:
56 edited
1 moved

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice_interp.F90

    r10069 r12807  
    260260!            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
    261261!            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3 
    262 !            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2 
     262!            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = jpj-2 
    263263!            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3 
    264 !            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2 
     264!            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = jpi-2 
    265265! 
    266266!            ! smoothed fields 
    267267!            IF( eastern_side ) THEN 
    268 !               ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
     268!               ztab(jpi,j1:j2,:) = z1 * ptab(jpi,j1:j2,:) + z2 * ptab(jpi-1,j1:j2,:) 
    269269!               DO jj = jmin, jmax 
    270270!                  rswitch = 0. 
    271 !                  IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
    272 !                  ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
    273 !                     &                +      umask(nlci-2,jj,1)   *  & 
    274 !                     &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
    275 !                     &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
    276 !                  ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
     271!                  IF( u_ice(jpi-2,jj) > 0._wp ) rswitch = 1. 
     272!                  ztab(jpi-1,jj,:) = ( 1. - umask(jpi-2,jj,1) ) * ztab(jpi,jj,:)  & 
     273!                     &               +      umask(jpi-2,jj,1)   *  & 
     274!                     &               ( (1. - rswitch) * ( z4 * ztab(jpi  ,jj,:) + z3 * ztab(jpi-2,jj,:) )  & 
     275!                     &                 +     rswitch  * ( z6 * ztab(jpi-2,jj,:) + z5 * ztab(jpi  ,jj,:) + z7 * ztab(jpi-3,jj,:) ) ) 
     276!                  ztab(jpi-1,jj,:) = ztab(jpi-1,jj,:) * tmask(jpi-1,jj,1) 
    277277!               END DO 
    278278!            ENDIF 
    279279!            !  
    280280!            IF( northern_side ) THEN 
    281 !               ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
     281!               ztab(i1:i2,jpj,:) = z1 * ptab(i1:i2,jpj,:) + z2 * ptab(i1:i2,jpj-1,:) 
    282282!               DO ji = imin, imax 
    283283!                  rswitch = 0. 
    284 !                  IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
    285 !                  ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
    286 !                     &                +      vmask(ji,nlcj-2,1)   *  & 
    287 !                     &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
    288 !                     &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
    289 !                  ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
     284!                  IF( v_ice(ji,jpj-2) > 0._wp ) rswitch = 1. 
     285!                  ztab(ji,jpj-1,:) = ( 1. - vmask(ji,jpj-2,1) ) * ztab(ji,jpj,:)  & 
     286!                     &               +      vmask(ji,jpj-2,1)   *  & 
     287!                     &               ( (1. - rswitch) * ( z4 * ztab(ji,jpj  ,:) + z3 * ztab(ji,jpj-2,:) ) & 
     288!                     &                 +     rswitch  * ( z6 * ztab(ji,jpj-2,:) + z5 * ztab(ji,jpj  ,:) + z7 * ztab(ji,jpj-3,:) ) ) 
     289!                  ztab(ji,jpj-1,:) = ztab(ji,jpj-1,:) * tmask(ji,jpj-1,1) 
    290290!               END DO 
    291291!            END IF 
    … …  
    318318!            ! 
    319319!            ! Treatment of corners 
    320 !            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
    321 !            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
    322 !            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
    323 !            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
     320!            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(jpi-1,2    ,:) = ptab(jpi-1,    2,:)   ! East south 
     321!            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(jpi-1,jpj-1,:) = ptab(jpi-1,jpj-1,:)  ! East north 
     322!            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(    2,    2,:) = ptab(    2,    2,:)   ! West south 
     323!            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(    2,jpj-1,:) = ptab(    2,jpj-1,:)   ! West north 
    324324!             
    325325!            ! retrieve ice tracers 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90

    r12489 r12807  
    646646 
    647647         jmax = j2-1 
    648          IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
     648         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,jpj-nbghostcells-2)   ! North 
    649649 
    650650         DO jj = j1+1, jmax 
    … …  
    802802 
    803803         imax = i2 - 1 
    804          IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East 
     804         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,jpi-nbghostcells-2)   ! East 
    805805 
    806806         DO jj = j1+1, j2 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90

    r12489 r12807  
    6565      ind2 = 1 + nbghostcells 
    6666      ind3 = 2 + nbghostcells 
    67       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
    68       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     67      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     68      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    6969 
    7070      ! 2. Type of interpolation 
    … …  
    318318      ind3 = 2 + nbghostcells 
    319319# if defined key_vertical 
    320       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
    321       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
    322  
    323       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
    324       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
    325       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
    326       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
    327       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
    328       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
     320      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
     321      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
     322 
     323      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
     324      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
     325      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
     326      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
     327      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
     328      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
    329329# else 
    330       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
    331       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
    332  
    333       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
    334       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
    335       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
    336       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
    337       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
    338       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
    339 # endif 
    340  
    341       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     330      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     331      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
     332 
     333      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
     334      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
     335      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
     336      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
     337      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
     338      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
     339# endif 
     340 
     341      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 
    342342 
    343343# if defined key_vertical 
    344       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
    345       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 
    346 # endif 
    347  
    348       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
    349  
    350       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
    351       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
    352       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
    353       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
    354       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
    355       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
    356  
    357       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     344      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 
     345      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 
     346# endif 
     347 
     348      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,3/),scales_t_id) 
     349 
     350      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
     351      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
     352      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
     353      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
     354      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
     355      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
     356 
     357      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    358358 
    359359      IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    360 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
    361 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     360!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     361!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    362362# if defined key_vertical 
    363          CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
     363         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
    364364# else 
    365          CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
     365         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
    366366# endif 
    367367      ENDIF 
    … …  
    535535      ind2 = 1 + nbghostcells 
    536536      ind3 = 2 + nbghostcells 
    537       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    538       CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
    539       CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
     537      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
     538      CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_ice_id  ) 
     539      CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_ice_id  ) 
    540540 
    541541      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
    … …  
    661661      ind3 = 2 + nbghostcells 
    662662# if defined key_vertical 
    663       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
    664       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
     663      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
     664      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
    665665# else 
    666       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
    667       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
     666      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     667      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    668668# endif 
    669669 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/CRS/crs.F90

    r10068 r12807  
    3636      INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo 
    3737      INTEGER  ::  npiglo, npjglo               !: jpjglo 
    38       INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid 
    39       INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid 
    40       INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid 
    41       INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid 
    42       INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid 
    43       INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid 
     38      INTEGER  ::  Nis0_full, Njs0_full         !: starting indices of internal sub-domain on parent grid 
     39      INTEGER  ::  Nie0_full, Nje0_full         !: ending indices of internal sub-domain on parent grid 
     40      INTEGER  ::  Nis0_crs , Njs0_crs          !: starting indices of internal sub-domain on coarse grid 
     41      INTEGER  ::  Nie0_crs , Nje0_crs          !: ending indices of internal sub-domain on coarse grid 
    4442 
    4543      INTEGER  ::  narea_full, narea_crs        !: node 
    … …  
    4846      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid 
    4947      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc 
    50       INTEGER  ::  nreci_full, nrecj_full 
    51       INTEGER  ::  nreci_crs, nrecj_crs 
    5248      !cc 
    5349      INTEGER ::   noea_full, nowe_full        !: index of the local neighboring processors in 
    … …  
    7672      INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs 
    7773      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box 
    78       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain 
    79       INTEGER, DIMENSION(:), ALLOCATABLE ::   nldit_crs, nldit_full     !: first, last indoor index for each i-domain 
    80       INTEGER, DIMENSION(:), ALLOCATABLE ::   nleit_crs, nleit_full    !: first, last indoor index for each j-domain 
    81       INTEGER, DIMENSION(:), ALLOCATABLE ::   nimppt_crs, nimppt_full    !: first, last indoor index for each j-domain 
    82       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcjt_crs, nlcjt_full  !: dimensions of every subdomain 
    83       INTEGER, DIMENSION(:), ALLOCATABLE ::   nldjt_crs, nldjt_full     !: first, last indoor index for each i-domain 
    84       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlejt_crs, nlejt_full    !: first, last indoor index for each j-domain 
    85       INTEGER, DIMENSION(:), ALLOCATABLE ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain 
     74      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpiall_crs,  jpiall_full   !: dimensions of every subdomain 
     75      INTEGER, DIMENSION(:), ALLOCATABLE ::   nis0all_crs, nis0all_full   !: first, last indoor index for each i-domain 
     76      INTEGER, DIMENSION(:), ALLOCATABLE ::   nie0all_crs, nie0all_full   !: first, last indoor index for each j-domain 
     77      INTEGER, DIMENSION(:), ALLOCATABLE ::    nimppt_crs,  nimppt_full   !: first, last indoor index for each j-domain 
     78      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpjall_crs,  jpjall_full   !: dimensions of every subdomain 
     79      INTEGER, DIMENSION(:), ALLOCATABLE ::   njs0all_crs, njs0all_full   !: first, last indoor index for each i-domain 
     80      INTEGER, DIMENSION(:), ALLOCATABLE ::   nje0all_crs, nje0all_full   !: first, last indoor index for each j-domain 
     81      INTEGER, DIMENSION(:), ALLOCATABLE ::    njmppt_crs,  njmppt_full   !: first, last indoor index for each j-domain 
    8682 
    8783  
    8884      ! Masks 
    8985      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs 
    90       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs 
    91        
    92   !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol       
    93  
     86      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: rnfmsk_crs 
     87       
    9488      ! Scale factors 
    9589      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T 
    … …  
    182176         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2)) 
    183177 
    184       ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs)   , rnfmsk_crs(jpi_crs,jpj_crs), & 
    185       &         tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) ) 
     178      ALLOCATE( rnfmsk_crs(jpi_crs,jpj_crs), STAT=ierr(3) ) 
    186179 
    187180      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , &  
    … …  
    238231         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 
    239232          
    240       ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij),   & 
    241          &      nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
    242                 njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij),   & 
    243          &      njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) ) 
     233      ALLOCATE( nimppt_crs (jpnij) , jpiall_crs (jpnij) , nis0all_crs (jpnij) , nie0all_crs (jpnij),   & 
     234         &      nimppt_full(jpnij) , jpiall_full(jpnij) , nis0all_full(jpnij) , nie0all_full(jpnij),   & 
     235                njmppt_crs (jpnij) , jpjall_crs (jpnij) , njs0all_crs (jpnij) , nje0all_crs (jpnij),   & 
     236         &      njmppt_full(jpnij) , jpjall_full(jpnij) , njs0all_full(jpnij) , nje0all_full(jpnij)  , STAT=ierr(15) ) 
    244237    
    245238      crs_dom_alloc = MAXVAL(ierr) 
    … …  
    258251      ierr(:) = 0 
    259252       
    260       ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) ) 
     253      ALLOCATE( mjs_crs(Nje0_crs) , mje_crs(Nje0_crs), mis_crs(Nie0_crs) , mie_crs(Nie0_crs), STAT=ierr(1) ) 
    261254      crs_dom_alloc2 = MAXVAL(ierr) 
    262255 
    … …  
    282275      jpjglo = jpjglo_full 
    283276 
    284       nlci   = nlci_full 
    285       nlcj   = nlcj_full 
    286       nldi   = nldi_full 
    287       nldj   = nldj_full 
    288       nlei   = nlei_full 
    289       nlej   = nlej_full 
    290       nimpp  = nimpp_full 
    291       njmpp  = njmpp_full 
    292        
    293       nlcit(:)  = nlcit_full(:) 
    294       nldit(:)  = nldit_full(:) 
    295       nleit(:)  = nleit_full(:) 
    296       nimppt(:) = nimppt_full(:) 
    297       nlcjt(:)  = nlcjt_full(:) 
    298       nldjt(:)  = nldjt_full(:) 
    299       nlejt(:)  = nlejt_full(:) 
    300       njmppt(:) = njmppt_full(:) 
     277      jpi   = jpi_full 
     278      jpj   = jpj_full 
     279      Nis0  = Nis0_full 
     280      Njs0  = Njs0_full 
     281      Nie0  = Nie0_full 
     282      Nje0  = Nje0_full 
     283      nimpp = nimpp_full 
     284      njmpp = njmpp_full 
     285       
     286      jpiall (:) = jpiall_full (:) 
     287      nis0all(:) = nis0all_full(:) 
     288      nie0all(:) = nie0all_full(:) 
     289      nimppt (:) = nimppt_full (:) 
     290      jpjall (:) = jpjall_full (:) 
     291      njs0all(:) = njs0all_full(:) 
     292      nje0all(:) = nje0all_full(:) 
     293      njmppt (:) = njmppt_full (:) 
    301294 
    302295   END SUBROUTINE dom_grid_glo 
    … …  
    322315 
    323316 
    324       nlci   = nlci_crs 
    325       nlcj   = nlcj_crs 
    326       nldi   = nldi_crs 
    327       nlei   = nlei_crs 
    328       nlej   = nlej_crs 
    329       nldj   = nldj_crs 
    330       nimpp  = nimpp_crs 
    331       njmpp  = njmpp_crs 
    332        
    333       nlcit(:)  = nlcit_crs(:) 
    334       nldit(:)  = nldit_crs(:) 
    335       nleit(:)  = nleit_crs(:) 
    336       nimppt(:) = nimppt_crs(:) 
    337       nlcjt(:)  = nlcjt_crs(:) 
    338       nldjt(:)  = nldjt_crs(:) 
    339       nlejt(:)  = nlejt_crs(:) 
    340       njmppt(:) = njmppt_crs(:) 
     317      jpi   = jpi_crs 
     318      jpj   = jpj_crs 
     319      Nis0  = Nis0_crs 
     320      Nie0  = Nie0_crs 
     321      Nje0  = Nje0_crs 
     322      Njs0  = Njs0_crs 
     323      nimpp = nimpp_crs 
     324      njmpp = njmpp_crs 
     325       
     326      jpiall (:) = jpiall_crs (:) 
     327      nis0all(:) = nis0all_crs(:) 
     328      nie0all(:) = nie0all_crs(:) 
     329      nimppt (:) = nimppt_crs (:) 
     330      jpjall (:) = jpjall_crs (:) 
     331      njs0all(:) = njs0all_crs(:) 
     332      nje0all(:) = nje0all_crs(:) 
     333      njmppt (:) = njmppt_crs (:) 
    341334      ! 
    342335   END SUBROUTINE dom_grid_crs 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/CRS/crsdom.F90

    r11536 r12807  
    7373   
    7474             
    75       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     75      IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    7676         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    7777            je_2 = mje_crs(2)   ;  ij = je_2 
    … …  
    8181      ENDIF 
    8282      DO jk = 1, jpkm1 
    83          DO ji = 2, nlei_crs   
     83         DO ji = 2, Nie0_crs   
    8484            ijis = mis_crs(ji)  ;  ijie = mie_crs(ji)     
    8585            !           
    … …  
    101101      ! 
    102102      DO jk = 1, jpkm1 
    103          DO ji = 2, nlei_crs   
     103         DO ji = 2, Nie0_crs   
    104104            ijis = mis_crs(ji)     ;   ijie = mie_crs(ji)        
    105             DO jj = 3, nlej_crs 
     105            DO jj = 3, Nje0_crs 
    106106               ijjs = mjs_crs(jj)  ;   ijje = mje_crs(jj) 
    107107                           
    … …  
    168168      SELECT CASE ( cd_type ) 
    169169         CASE ( 'T' ) 
    170             DO jj =  nldj_crs, nlej_crs 
     170            DO jj =  Njs0_crs, Nje0_crs 
    171171               ijjs = mjs_crs(jj) + mybinctr 
    172                DO ji = 2, nlei_crs 
     172               DO ji = 2, Nie0_crs 
    173173                  ijis = mis_crs(ji) + mxbinctr  
    174174                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    177177            ENDDO 
    178178         CASE ( 'U' ) 
    179             DO jj =  nldj_crs, nlej_crs 
     179            DO jj =  Njs0_crs, Nje0_crs 
    180180               ijjs = mjs_crs(jj) + mybinctr                   
    181                DO ji = 2, nlei_crs 
     181               DO ji = 2, Nie0_crs 
    182182                  ijis = mis_crs(ji) 
    183183                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    186186            ENDDO 
    187187         CASE ( 'V' ) 
    188             DO jj =  nldj_crs, nlej_crs 
     188            DO jj =  Njs0_crs, Nje0_crs 
    189189               ijjs = mjs_crs(jj) 
    190                DO ji = 2, nlei_crs 
     190               DO ji = 2, Nie0_crs 
    191191                  ijis = mis_crs(ji) + mxbinctr  
    192192                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    195195            ENDDO 
    196196         CASE ( 'F' ) 
    197             DO jj =  nldj_crs, nlej_crs 
     197            DO jj =  Njs0_crs, Nje0_crs 
    198198               ijjs = mjs_crs(jj) 
    199                DO ji = 2, nlei_crs 
     199               DO ji = 2, Nie0_crs 
    200200                  ijis = mis_crs(ji) 
    201201                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    212212      SELECT CASE ( cd_type ) 
    213213         CASE ( 'T', 'V' ) 
    214             DO ji = 2, nlei_crs 
     214            DO ji = 2, Nie0_crs 
    215215               ijis = mis_crs(ji) + mxbinctr  
    216216               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    … …  
    218218            ENDDO 
    219219         CASE ( 'U', 'F' ) 
    220             DO ji = 2, nlei_crs 
     220            DO ji = 2, Nie0_crs 
    221221               ijis = mis_crs(ji)  
    222222               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    … …  
    261261 
    262262      DO jk = 1, jpk     
    263          DO ji = 2, nlei_crs 
     263         DO ji = 2, Nie0_crs 
    264264            ijie = mie_crs(ji) 
    265             DO jj = nldj_crs, nlej_crs 
     265            DO jj = Njs0_crs, Nje0_crs 
    266266               ijje = mje_crs(jj)   ;   ijrs =  mje_crs(jj) - mjs_crs(jj) 
    267267               ! Only for a factro 3 coarsening 
    … …  
    374374      ENDIF 
    375375 
    376       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     376      IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    377377         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    378378            je_2 = mje_crs(2) 
    … …  
    512512                  ENDIF 
    513513          
    514                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     514                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    515515                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    516516                        je_2 = mje_crs(2) 
    … …  
    617617               CASE( 'T', 'W' ) 
    618618          
    619                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     619                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    620620                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    621621                        je_2 = mje_crs(2) 
    … …  
    674674               CASE( 'V' ) 
    675675 
    676                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     676                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    677677                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    678678                        ijje = mje_crs(2) 
    … …  
    711711               CASE( 'U' ) 
    712712 
    713                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     713                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    714714                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    715715                        je_2 = mje_crs(2) 
    … …  
    782782               CASE( 'T', 'W' ) 
    783783          
    784                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     784                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    785785                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    786786                        je_2 = mje_crs(2) 
    … …  
    842842               CASE( 'V' ) 
    843843 
    844                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     844                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    845845                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    846846                        ijje = mje_crs(2) 
    … …  
    883883               CASE( 'U' ) 
    884884 
    885                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     885                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    886886                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    887887                        je_2 = mje_crs(2) 
    … …  
    953953               CASE( 'T', 'W' ) 
    954954          
    955                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     955                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    956956                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    957957                        je_2 = mje_crs(2) 
    … …  
    10131013               CASE( 'V' ) 
    10141014 
    1015                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1015                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    10161016                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    10171017                        ijje = mje_crs(2) 
    … …  
    10531053               CASE( 'U' ) 
    10541054 
    1055                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1055                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    10561056                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    10571057                        je_2 = mje_crs(2) 
    … …  
    11581158            zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
    11591159 
    1160             IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1160            IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    11611161               IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    11621162                  je_2 = mje_crs(2) 
    … …  
    12341234               CASE( 'T', 'W' ) 
    12351235 
    1236                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1236                   IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    12371237                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    12381238                         je_2 = mje_crs(2) 
    … …  
    12851285               CASE( 'V' ) 
    12861286 
    1287                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1287                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    12881288                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    12891289                        ijje = mje_crs(2) 
    … …  
    13181318               CASE( 'U' ) 
    13191319 
    1320                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1320                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    13211321                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    13221322                        je_2 = mje_crs(2) 
    … …  
    13691369               CASE( 'T', 'W' ) 
    13701370   
    1371                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1371                   IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    13721372                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    13731373                         je_2 = mje_crs(2) 
    … …  
    14201420               CASE( 'V' ) 
    14211421 
    1422                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1422                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    14231423                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    14241424                        ijje = mje_crs(2) 
    … …  
    14531453               CASE( 'U' ) 
    14541454 
    1455                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1455                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    14561456                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    14571457                        je_2 = mje_crs(2) 
    … …  
    14971497              CASE( 'T', 'W' ) 
    14981498   
    1499                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1499                   IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    15001500                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    15011501                         je_2 = mje_crs(2) 
    … …  
    15481548               CASE( 'V' ) 
    15491549 
    1550                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1550                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    15511551                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    15521552                        ijje = mje_crs(2) 
    … …  
    15811581               CASE( 'U' ) 
    15821582 
    1583                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1583                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    15841584                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    15851585                        je_2 = mje_crs(2) 
    … …  
    16651665       ENDDO 
    16661666 
    1667        IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1667       IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    16681668          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    16691669             je_2 = mje_crs(2) 
    … …  
    18081808      END SELECT 
    18091809 
    1810       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1810      IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    18111811         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    18121812            je_2 = mje_crs(2) 
    … …  
    18991899      ! 2.a Define processor domain 
    19001900      IF( .NOT. lk_mpp ) THEN 
    1901          nimpp_crs  = 1 
    1902          njmpp_crs  = 1 
    1903          nlci_crs   = jpi_crs 
    1904          nlcj_crs   = jpj_crs 
    1905          nldi_crs   = 1 
    1906          nldj_crs   = 1 
    1907          nlei_crs   = jpi_crs 
    1908          nlej_crs   = jpj_crs 
     1901         nimpp_crs = 1 
     1902         njmpp_crs = 1 
     1903         Nis0_crs  = 1 
     1904         Njs0_crs  = 1 
     1905         Nie0_crs  = jpi_crs 
     1906         Nje0_crs  = jpj_crs 
    19091907      ELSE 
    19101908         ! Initialisation of most local variables - 
    1911          nimpp_crs  = 1 
    1912          njmpp_crs  = 1 
    1913          nlci_crs   = jpi_crs 
    1914          nlcj_crs   = jpj_crs 
    1915          nldi_crs   = 1 
    1916          nldj_crs   = 1 
    1917          nlei_crs   = jpi_crs 
    1918          nlej_crs   = jpj_crs 
     1909         nimpp_crs = 1 
     1910         njmpp_crs = 1 
     1911         Nis0_crs  = 1 
     1912         Njs0_crs  = 1 
     1913         Nie0_crs  = jpi_crs 
     1914         Nje0_crs  = jpj_crs 
    19191915          
    19201916        ! Calculs suivant une découpage en j 
    19211917        DO jn = 1, jpnij, jpni 
    19221918           IF( jn < ( jpnij - jpni + 1 ) ) THEN 
    1923               nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) & 
     1919              nje0all_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) & 
    19241920                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) ) 
    19251921           ELSE                                              
    1926               nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1             
     1922              nje0all_crs(jn) = AINT( REAL(  nje0all(jn) / nn_facty, wp ) ) + 1             
    19271923           ENDIF 
    1928            IF( noso < 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1              
     1924           IF( noso < 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1              
    19291925           SELECT CASE( ibonjt(jn) ) 
    19301926              CASE ( -1 ) 
    1931                 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    1932                 nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls 
    1933                 nldjt_crs(jn) = nldjt(jn) 
     1927                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nje0all_crs(jn) = nje0all_crs(jn) + 1 
     1928                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 
     1929                njs0all_crs(jn) = njs0all(jn) 
    19341930               
    19351931              CASE ( 0 ) 
    19361932               
    1937                 nldjt_crs(jn) = nldjt(jn) 
    1938                 IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    1939                 nlejt_crs(jn) = nlejt_crs(jn) + nn_hls 
    1940                 nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls 
     1933                njs0all_crs(jn) = njs0all(jn) 
     1934                IF( njs0all(jn) == 1 )  nje0all_crs(jn) = nje0all_crs(jn) + 1 
     1935                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 
     1936                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 
    19411937                 
    19421938              CASE ( 1, 2 ) 
    19431939               
    1944                 nlejt_crs(jn) = nlejt_crs(jn) + nn_hls 
    1945                 nlcjt_crs(jn) = nlejt_crs(jn) 
    1946                 nldjt_crs(jn) = nldjt(jn) 
     1940                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 
     1941                jpjall_crs (jn) = nje0all_crs(jn) 
     1942                njs0all_crs(jn) = njs0all(jn) 
    19471943                 
    19481944              CASE DEFAULT 
    19491945                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' ) 
    19501946           END SELECT 
    1951            IF( nlcjt_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1 
    1952  
    1953            IF(nldjt_crs(jn) == 1 ) THEN 
     1947           IF( jpjall_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1 
     1948 
     1949           IF(njs0all_crs(jn) == 1 ) THEN 
    19541950              njmppt_crs(jn) = 1 
    19551951           ELSE 
    … …  
    19581954            
    19591955           DO jj = jn + 1, jn + jpni - 1 
    1960               nlejt_crs(jj) = nlejt_crs(jn)  
    1961               nlcjt_crs(jj) = nlcjt_crs(jn) 
    1962               nldjt_crs(jj) = nldjt_crs(jn) 
    1963               njmppt_crs(jj)= njmppt_crs(jn) 
     1956              nje0all_crs(jj) = nje0all_crs(jn)  
     1957              jpjall_crs (jj) = jpjall_crs(jn) 
     1958              njs0all_crs(jj) = njs0all_crs(jn) 
     1959              njmppt_crs (jj) = njmppt_crs(jn) 
    19641960           ENDDO 
    19651961        ENDDO  
    1966         nlej_crs  = nlejt_crs(nproc + 1)  
    1967         nlcj_crs  = nlcjt_crs(nproc + 1) 
    1968         nldj_crs  = nldjt_crs(nproc + 1) 
    1969         njmpp_crs = njmppt_crs(nproc + 1) 
     1962        Nje0_crs  = nje0all_crs(nproc + 1)  
     1963        jpj_crs   = jpjall_crs (nproc + 1) 
     1964        Njs0_crs  = njs0all_crs(nproc + 1) 
     1965        njmpp_crs = njmppt_crs (nproc + 1) 
    19701966 
    19711967        ! Calcul suivant un decoupage en i 
    19721968        DO jn = 1, jpni 
    19731969           IF( jn == 1 ) THEN           
    1974               nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) 
     1970              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) ) 
    19751971           ELSE 
    1976               nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) & 
    1977                  &          - AINT( REAL( ( nimppt(jn-1) - 1 + nlcit(jn-1) )  / nn_factx, wp) ) 
     1972              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) ) & 
     1973                 &            - AINT( REAL( ( nimppt(jn-1) - 1 + jpiall(jn-1) )  / nn_factx, wp) ) 
    19781974           ENDIF 
    19791975 
    19801976           SELECT CASE( ibonit(jn) ) 
    19811977              CASE ( -1 ) 
    1982                  nleit_crs(jn) = nleit_crs(jn) + nn_hls            
    1983                  nlcit_crs(jn) = nleit_crs(jn) + nn_hls 
    1984                  nldit_crs(jn) = nldit(jn)  
     1978                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls            
     1979                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 
     1980                 nis0all_crs(jn) = nis0all(jn)  
    19851981               
    19861982              CASE ( 0 ) 
    1987                  nleit_crs(jn) = nleit_crs(jn) + nn_hls 
    1988                  nlcit_crs(jn) = nleit_crs(jn) + nn_hls 
    1989                  nldit_crs(jn) = nldit(jn)  
     1983                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 
     1984                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 
     1985                 nis0all_crs(jn) = nis0all(jn)  
    19901986                 
    19911987              CASE ( 1, 2 ) 
    1992                  IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1 
    1993                  nleit_crs(jn) = nleit_crs(jn) + nn_hls 
    1994                  nlcit_crs(jn) = nleit_crs(jn) 
    1995                  nldit_crs(jn) = nldit(jn)  
     1988                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nie0all_crs(jn) = nie0all_crs(jn) + 1 
     1989                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 
     1990                 jpiall_crs (jn) = nie0all_crs(jn) 
     1991                 nis0all_crs(jn) = nis0all(jn)  
    19961992 
    19971993              CASE DEFAULT 
    … …  
    20011997           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 
    20021998           DO jj = jn + jpni , jpnij, jpni 
    2003               nleit_crs(jj) = nleit_crs(jn)  
    2004               nlcit_crs(jj) = nlcit_crs(jn) 
    2005               nldit_crs(jj) = nldit_crs(jn) 
    2006               nimppt_crs(jj)= nimppt_crs(jn) 
     1999              nie0all_crs(jj) = nie0all_crs(jn)  
     2000              jpiall_crs (jj) = jpiall_crs (jn) 
     2001              nis0all_crs(jj) = nis0all_crs(jn) 
     2002              nimppt_crs (jj) = nimppt_crs (jn) 
    20072003           ENDDO 
    20082004         ENDDO  
    20092005         
    2010          nlei_crs  = nleit_crs(nproc + 1)  
    2011          nlci_crs  = nlcit_crs(nproc + 1) 
    2012          nldi_crs  = nldit_crs(nproc + 1) 
    2013          nimpp_crs = nimppt_crs(nproc + 1) 
     2006         Nie0_crs  = nie0all_crs(nproc + 1)  
     2007         jpi_crs   = jpiall_crs (nproc + 1) 
     2008         Nis0_crs  = nis0all_crs(nproc + 1) 
     2009         nimpp_crs = nimppt_crs (nproc + 1) 
    20142010 
    20152011         DO ji = 1, jpi_crs 
    … …  
    20432039      jpjglo_full = jpjglo 
    20442040 
    2045       nlcj_full   = nlcj 
    2046       nlci_full   = nlci 
    2047       nldi_full   = nldi 
    2048       nldj_full   = nldj 
    2049       nlei_full   = nlei 
    2050       nlej_full   = nlej 
    2051       nimpp_full  = nimpp      
    2052       njmpp_full  = njmpp 
     2041      jpj_full   = jpj 
     2042      jpi_full   = jpi 
     2043      Nis0_full  = Nis0 
     2044      Njs0_full  = Njs0 
     2045      Nie0_full  = Nie0 
     2046      Nje0_full  = Nje0 
     2047      nimpp_full = nimpp      
     2048      njmpp_full = njmpp 
    20532049       
    2054       nlcit_full(:)  = nlcit(:) 
    2055       nldit_full(:)  = nldit(:) 
    2056       nleit_full(:)  = nleit(:) 
    2057       nimppt_full(:) = nimppt(:) 
    2058       nlcjt_full(:)  = nlcjt(:) 
    2059       nldjt_full(:)  = nldjt(:) 
    2060       nlejt_full(:)  = nlejt(:) 
    2061       njmppt_full(:) = njmppt(:) 
     2050      jpiall_full (:) = jpiall (:) 
     2051      nis0all_full(:) = nis0all(:) 
     2052      nie0all_full(:) = nie0all(:) 
     2053      nimppt_full (:) = nimppt (:) 
     2054      jpjall_full (:) = jpjall (:) 
     2055      njs0all_full(:) = njs0all(:) 
     2056      nje0all_full(:) = nje0all(:) 
     2057      njmppt_full (:) = njmppt (:) 
    20622058       
    20632059      CALL dom_grid_crs  !swich de grille 
    … …  
    20732069         WRITE(numout,*) 
    20742070         WRITE(numout,*) ' nproc  = '     , nproc 
    2075          WRITE(numout,*) ' nlci   = '     , nlci 
    2076          WRITE(numout,*) ' nlcj   = '     , nlcj 
    2077          WRITE(numout,*) ' nldi   = '     , nldi 
    2078          WRITE(numout,*) ' nldj   = '     , nldj 
    2079          WRITE(numout,*) ' nlei   = '     , nlei 
    2080          WRITE(numout,*) ' nlej   = '     , nlej 
    2081          WRITE(numout,*) ' nlei_full='    , nlei_full 
    2082          WRITE(numout,*) ' nldi_full='    , nldi_full 
     2071         WRITE(numout,*) ' jpi    = '     , jpi 
     2072         WRITE(numout,*) ' jpj    = '     , jpj 
     2073         WRITE(numout,*) ' Nis0   = '     , Nis0 
     2074         WRITE(numout,*) ' Njs0   = '     , Njs0 
     2075         WRITE(numout,*) ' Nie0   = '     , Nie0 
     2076         WRITE(numout,*) ' Nje0   = '     , Nje0 
     2077         WRITE(numout,*) ' Nie0_full='    , Nie0_full 
     2078         WRITE(numout,*) ' Nis0_full='    , Nis0_full 
    20832079         WRITE(numout,*) ' nimpp  = '     , nimpp 
    20842080         WRITE(numout,*) ' njmpp  = '     , njmpp 
    … …  
    22032199        mje_crs(:) = mje2_crs(:)  
    22042200      ELSE 
    2205         DO jj = 1, nlej_crs 
     2201        DO jj = 1, Nje0_crs 
    22062202           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
    22072203           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
    22082204        ENDDO 
    2209         DO ji = 1, nlei_crs 
     2205        DO ji = 1, Nie0_crs 
    22102206           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
    22112207           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
    … …  
    22132209      ENDIF 
    22142210      ! 
    2215       nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1) 
    2216       njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1) 
     2211      nistr = mis_crs(2)  ;   niend = mis_crs(jpi_crs - 1) 
     2212      njstr = mjs_crs(3)  ;   njend = mjs_crs(jpj_crs - 1) 
    22172213      ! 
    22182214   END SUBROUTINE crs_dom_def 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/CRS/crsdomwri.F90

    r12377 r12807  
    5050      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    5151      INTEGER           ::   inum         ! local units for 'mesh_mask.nc' file 
    52       INTEGER           ::   iif, iil, ijf, ijl 
    5352      CHARACTER(len=21) ::   clnam        ! filename (mesh and mask informations) 
    5453      !                                   !  workspace 
    … …  
    7675      CALL iom_rstput( 0, 0, inum, 'fmask', fmask_crs, ktype = jp_i1 ) 
    7776       
    78        
    79       tmask_i_crs(:,:) = tmask_crs(:,:,1) 
    80       iif = nn_hls 
    81       iil = nlci_crs - nn_hls + 1 
    82       ijf = nn_hls 
    83       ijl = nlcj_crs - nn_hls + 1 
    84       
    85       tmask_i_crs( 1:iif ,    :  ) = 0._wp 
    86       tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp 
    87       tmask_i_crs(   :   , 1:ijf ) = 0._wp 
    88       tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp 
    89        
    90        
    91       tpol_crs(1:jpiglo_crs,:) = 1._wp 
    92       fpol_crs(1:jpiglo_crs,:) = 1._wp 
    93       IF( jperio == 3 .OR. jperio == 4 ) THEN 
    94          tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp 
    95          fpol_crs(       1      :jpiglo_crs,:) = 0._wp 
    96          IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN 
    97             DO ji = iif+1, iil-1 
    98                tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) & 
    99                & * tpol_crs(mig_crs(ji),1) 
    100             ENDDO 
    101          ENDIF 
    102       ENDIF 
    103       IF( jperio == 5 .OR. jperio == 6 ) THEN 
    104          tpol_crs(      1       :jpiglo_crs,:)=0._wp 
    105          fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp 
    106       ENDIF 
    107        
    108       CALL iom_rstput( 0, 0, inum, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 
    109                                    !    ! unique point mask 
     77      CALL dom_uniq_crs( zprw, 'T' ) 
     78      zprt = tmask_crs(:,:,1) * zprw 
     79      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 ) 
    11080      CALL dom_uniq_crs( zprw, 'U' ) 
    11181      zprt = umask_crs(:,:,1) * zprw 
    … …  
    211181      REAL(wp) ::  zshift   ! shift value link to the process number 
    212182      INTEGER  ::  ji       ! dummy loop indices 
    213       LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    214       REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: ztstref 
     183      LOGICAL , DIMENSION(jpi_crs,jpj_crs,1) ::   lluniq  ! store whether each point is unique or not 
     184      REAL(wp), DIMENSION(jpi_crs,jpj_crs  ) ::  ztstref 
    215185      !!---------------------------------------------------------------------- 
    216186      ! 
    … …  
    218188      ! in mpp: make sure that these values are different even between process 
    219189      ! -> apply a shift value according to the process number 
    220       zshift = jpi_crs * jpj_crs * ( narea - 1 ) 
     190      zshift = (jpi_crs+1.) * (jpj_crs+1.) * ( narea - 1 )   ! we should use jpimax_crs but not existing 
    221191      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi_crs*jpj_crs) /), (/ jpi_crs, jpj_crs /) ) 
    222192      ! 
    223       puniq(:,:) = ztstref(:,:)                   ! default definition 
    224       CALL crs_lbc_lnk( puniq,cdgrd, 1. )            ! apply boundary conditions 
    225       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    226       ! 
    227       puniq(:,:) = 1.                             ! default definition 
    228       ! fill only the inner part of the cpu with llbl converted into real  
    229       puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 
     193      puniq(:,:) = ztstref(:,:)                    ! default definition 
     194      CALL crs_lbc_lnk( puniq,cdgrd, 1. )          ! apply boundary conditions 
     195      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
     196      ! 
     197      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) 
    230198      ! 
    231199   END SUBROUTINE dom_uniq_crs 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DIA/diadct.F90

    r12489 r12807  
    409409              ijloc=ijglo-njmpp+1   !  " 
    410410 
    411               !verify if the point is on the local domain:(1,nlei)*(1,nlej) 
    412               IF( iiloc >= 1 .AND. iiloc <= nlei .AND. & 
    413                   ijloc >= 1 .AND. ijloc <= nlej       )THEN 
     411              !verify if the point is on the local domain:(1,Nie0)*(1,Nje0) 
     412              IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. & 
     413                  ijloc >= 1 .AND. ijloc <= Nje0       )THEN 
    414414                 iptloc = iptloc + 1                                                 ! count local points 
    415415                 secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates 
    … …  
    516516  
    517517     !which coordinate shall we verify ? 
    518      IF      ( cdind=='I' )THEN   ; itest=nlei ; iind=1 
    519      ELSE IF ( cdind=='J' )THEN   ; itest=nlej ; iind=2 
     518     IF      ( cdind=='I' )THEN   ; itest=Nie0 ; iind=1 
     519     ELSE IF ( cdind=='J' )THEN   ; itest=Nje0 ; iind=2 
    520520     ELSE    ; CALL ctl_stop("removepoints :Wrong value for cdind")  
    521521     ENDIF 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/dom_oce.F90

    r12586 r12807  
    7575   !                                 !  domain MPP decomposition parameters 
    7676   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom 
    77    INTEGER             , PUBLIC ::   nreci, nrecj     !: overlap region in i and j 
    7877   INTEGER             , PUBLIC ::   nproc            !: number for local processor 
    7978   INTEGER             , PUBLIC ::   narea            !: number for local area 
    … …  
    8584 
    8685   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4) 
    87    INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices 
    88    INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices 
    8986   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in 
    9087   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions 
    … …  
    9794   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index (mj0=1 and mj1=0 if the global index 
    9895   !                                                                !                                             is not in the local domain) 
    99    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor 
    100    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
    101    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain 
    102    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
    103    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
    104    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit 
     96   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::    nimppt, njmppt   !: i-, j-indexes for each processor 
     97   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::    ibonit, ibonjt   !: i-, j- processor neighbour existence 
     98   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::    jpiall,  jpjall   !: dimensions of all subdomain 
     99   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nis0all, njs0all   !: first, last indoor index for all i-subdomain 
     100   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nie0all, nje0all   !: first, last indoor index for all j-subdomain 
     101   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfijpit 
    105102 
    106103   !!---------------------------------------------------------------------- 
    … …  
    185182   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, wmask  !: land/ocean mask at T-, U-, V-pts 
    186183   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    187  
    188    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
    189184 
    190185   !!---------------------------------------------------------------------- 
    … …  
    250245      ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) ) 
    251246         ! 
    252       ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
    253          &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) ) 
     247      ALLOCATE( mi0(jpiglo), mi1(jpiglo), mj0(jpjglo), mj1(jpjglo), STAT=ierr(2) ) 
    254248         ! 
    255249      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     & 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domhgr.F90

    r12738 r12807  
    3131   USE iom            ! I/O library 
    3232   USE lib_mpp        ! MPP library 
     33   USE lbclnk         ! lateal boundary condition / mpp exchanges 
    3334   USE timing         ! Timing 
    3435 
    … …  
    199200      CALL iom_get( inum, jpdom_global, 'gphif', pphif, cd_type = 'F', psgn = 1._wp ) 
    200201      ! 
    201       CALL iom_get( inum, jpdom_global, 'e1t'  , pe1t , cd_type = 'T', psgn = 1._wp ) 
    202       CALL iom_get( inum, jpdom_global, 'e1u'  , pe1u , cd_type = 'U', psgn = 1._wp ) 
    203       CALL iom_get( inum, jpdom_global, 'e1v'  , pe1v , cd_type = 'V', psgn = 1._wp ) 
    204       CALL iom_get( inum, jpdom_global, 'e1f'  , pe1f , cd_type = 'F', psgn = 1._wp ) 
    205       ! 
    206       CALL iom_get( inum, jpdom_global, 'e2t'  , pe2t , cd_type = 'T', psgn = 1._wp ) 
    207       CALL iom_get( inum, jpdom_global, 'e2u'  , pe2u , cd_type = 'U', psgn = 1._wp ) 
    208       CALL iom_get( inum, jpdom_global, 'e2v'  , pe2v , cd_type = 'V', psgn = 1._wp ) 
    209       CALL iom_get( inum, jpdom_global, 'e2f'  , pe2f , cd_type = 'F', psgn = 1._wp ) 
     202      CALL iom_get( inum, jpdom_global, 'e1t'  , pe1t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) 
     203      CALL iom_get( inum, jpdom_global, 'e1u'  , pe1u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     204      CALL iom_get( inum, jpdom_global, 'e1v'  , pe1v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
     205      CALL iom_get( inum, jpdom_global, 'e1f'  , pe1f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 
     206      ! 
     207      CALL iom_get( inum, jpdom_global, 'e2t'  , pe2t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) 
     208      CALL iom_get( inum, jpdom_global, 'e2u'  , pe2u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     209      CALL iom_get( inum, jpdom_global, 'e2v'  , pe2v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
     210      CALL iom_get( inum, jpdom_global, 'e2f'  , pe2f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 
    210211      ! 
    211212      IF(  iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0  .AND.  & 
    … …  
    221222      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 
    222223         IF(lwp) WRITE(numout,*) '           e1e2u & e1e2v read in ', TRIM( cn_domcfg ), ' file' 
    223          CALL iom_get( inum, jpdom_global, 'e1e2u', pe1e2u, cd_type = 'U', psgn = 1._wp ) 
    224          CALL iom_get( inum, jpdom_global, 'e1e2v', pe1e2v, cd_type = 'V', psgn = 1._wp ) 
     224         CALL iom_get( inum, jpdom_global, 'e1e2u', pe1e2u, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     225         CALL iom_get( inum, jpdom_global, 'e1e2v', pe1e2v, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
    225226         ke1e2u_v = 1 
    226227      ELSE 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/dommsk.F90

    r12738 r12807  
    2525   USE oce            ! ocean dynamics and tracers 
    2626   USE dom_oce        ! ocean space and time domain 
     27   USE domutl         !  
    2728   USE usrdef_fmask   ! user defined fmask 
    2829   USE bdy_oce        ! open boundary 
    … …  
    8889      ! 
    8990      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    90       INTEGER  ::   iif, iil       ! local integers 
    91       INTEGER  ::   ijf, ijl       !   -       - 
    9291      INTEGER  ::   iktop, ikbot   !   -       - 
    9392      INTEGER  ::   ios, inum 
    … …  
    131130      ! 
    132131      tmask(:,:,:) = 0._wp 
    133       DO_2D_11_11 
     132      DO_2D_00_00 
    134133         iktop = k_top(ji,jj) 
    135134         ikbot = k_bot(ji,jj) 
    136135         IF( iktop /= 0 ) THEN       ! water in the column 
    137             tmask(ji,jj,iktop:ikbot  ) = 1._wp 
     136            tmask(ji,jj,iktop:ikbot) = 1._wp 
    138137         ENDIF 
    139138      END_2D 
    140139      ! 
    141       ! the following call is mandatory 
     140      ! the following is mandatory 
    142141      ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...)   
    143       CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
     142      IF( .NOT. (nbondj == 1 .OR. nbondj == 0 .OR. l_Jperio) ) THEN 
     143         tmask(mi0(  1 ):mi1(jpiglo),mj0(Njs0):mj1(Njs0  ),:) = 0._wp   ! line   number Njs0 at 0 
     144      ENDIF 
     145      IF( .NOT. (nbondi == 1 .OR. nbondi == 0 .OR. l_Iperio) ) THEN 
     146         tmask(mi0(Nis0):mi1(  Nis0),mj0(  1 ):mj1(jpjglo),:) = 0._wp   ! column number Nis0 at 0 
     147      ENDIF 
     148      CALL lbc_lnk( 'dommsk', tmask, 'T', 1._wp )      ! Lateral boundary conditions 
    144149 
    145150     ! Mask corrections for bdy (read in mppini2) 
    … …  
    186191      END DO 
    187192 
    188  
    189193      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical) 
    190194      ! ---------------------------------------------- 
    … …  
    193197      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
    194198 
    195  
    196199      ! Interior domain mask  (used for global sum) 
    197200      ! -------------------- 
    198201      ! 
    199       iif = nn_hls   ;   iil = nlci - nn_hls + 1 
    200       ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1 
    201       ! 
    202       !                          ! halo mask : 0 on the halo and 1 elsewhere 
    203       tmask_h(:,:) = 1._wp                   
    204       tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    205       tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    206       tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
    207       tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
    208       ! 
    209       !                          ! north fold mask 
    210       tpol(1:jpiglo) = 1._wp  
    211       fpol(1:jpiglo) = 1._wp 
    212       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    213          tpol(jpiglo/2+1:jpiglo) = 0._wp 
    214          fpol(     1    :jpiglo) = 0._wp 
    215          IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h 
    216             DO ji = iif+1, iil-1 
    217                tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
    218             END DO 
    219          ENDIF 
    220       ENDIF 
    221       ! 
    222       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    223          tpol(     1    :jpiglo) = 0._wp 
    224          fpol(jpiglo/2+1:jpiglo) = 0._wp 
    225       ENDIF 
     202      CALL dom_uniq( tmask_h, 'T' ) 
    226203      ! 
    227204      !                          ! interior mask : 2D ocean mask x halo mask  
    228205      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
    229  
    230206 
    231207      ! Lateral boundary conditions on velocity (modify fmask) 
    … …  
    261237#if defined key_agrif  
    262238            IF( .NOT. AGRIF_Root() ) THEN  
    263                IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east  
    264                IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west  
    265                IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north  
    266                IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south  
     239               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(jpi-1, :   ,jk) = 0.e0      ! east  
     240               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1    , :   ,jk) = 0.e0      ! west  
     241               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:    ,jpj-1,jk) = 0.e0      ! north  
     242               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:    ,1    ,jk) = 0.e0      ! south  
    267243            ENDIF  
    268244#endif  

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domutl.F90

    r12766 r12807  
    1 MODULE domngb 
     1MODULE domutl 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  domngb  *** 
    4    !! Grid search:  find the closest grid point from a given on/lat position 
     3   !!                       ***  MODULE  domutl  *** 
     4   !! Grid utilities: 
    55   !!====================================================================== 
    6    !! History : 3.2  !  2009-11  (S. Masson)  Original code 
     6   !! History : 4.2  !  2020-04  (S. Masson)  Original code 
    77   !!---------------------------------------------------------------------- 
    88 
    99   !!---------------------------------------------------------------------- 
    1010   !!   dom_ngb       : find the closest grid point from a given lon/lat position 
     11   !!   dom_uniq      : identify unique point of a grid (TUVF) 
    1112   !!---------------------------------------------------------------------- 
     13   ! 
    1214   USE dom_oce        ! ocean space and time domain 
    1315   ! 
    1416   USE in_out_manager ! I/O manager 
     17   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    1518   USE lib_mpp        ! for mppsum 
    1619 
    … …  
    1821   PRIVATE 
    1922 
    20    PUBLIC   dom_ngb   ! routine called in iom.F90 module 
     23   PUBLIC dom_ngb    ! routine called in iom.F90 module 
     24   PUBLIC dom_uniq   ! Called by dommsk and domwri 
    2125 
    2226   !!---------------------------------------------------------------------- 
    23    !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     27   !! NEMO/OCE 4.2 , NEMO Consortium (2020) 
    2428   !! $Id$  
    2529   !! Software governed by the CeCILL license (see ./LICENSE) 
    … …  
    4751      !!-------------------------------------------------------------------- 
    4852      ! 
    49       zmask(:,:) = 0._wp 
    5053      ik = 1 
    5154      IF ( PRESENT(kkk) ) ik=kkk 
     55      ! 
     56      CALL dom_uniq(zmask,cdgrid) 
     57      ! 
    5258      SELECT CASE( cdgrid ) 
    53       CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik) 
    54       CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik) 
    55       CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik) 
    56       CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik) 
     59      CASE( 'U' )    ;   zglam(:,:) = glamu(:,:)   ;   zgphi(:,:) = gphiu(:,:)   ;   zmask(:,:) = zmask(:,:) * umask(:,:,ik) 
     60      CASE( 'V' )    ;   zglam(:,:) = glamv(:,:)   ;   zgphi(:,:) = gphiv(:,:)   ;   zmask(:,:) = zmask(:,:) * vmask(:,:,ik) 
     61      CASE( 'F' )    ;   zglam(:,:) = glamf(:,:)   ;   zgphi(:,:) = gphif(:,:)   ;   zmask(:,:) = zmask(:,:) * fmask(:,:,ik) 
     62      CASE DEFAULT   ;   zglam(:,:) = glamt(:,:)   ;   zgphi(:,:) = gphit(:,:)   ;   zmask(:,:) = zmask(:,:) * tmask(:,:,ik) 
    5763      END SELECT 
    58  
     64      ! 
    5965      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360 
    6066      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360 
    … …  
    7783   END SUBROUTINE dom_ngb 
    7884 
     85 
     86   SUBROUTINE dom_uniq( puniq, cdgrd ) 
     87      !!---------------------------------------------------------------------- 
     88      !!                  ***  ROUTINE dom_uniq  *** 
     89      !!                    
     90      !! ** Purpose :   identify unique point of a grid (TUVF) 
     91      !! 
     92      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element 
     93      !!                2) check which elements have been changed 
     94      !!---------------------------------------------------------------------- 
     95      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
     96      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
     97      ! 
     98      REAL(wp)                       ::  zshift   ! shift value link to the process number 
     99      INTEGER                        ::  ji       ! dummy loop indices 
     100      LOGICAL , DIMENSION(jpi,jpj,1) ::   lluniq  ! store whether each point is unique or not 
     101      REAL(wp), DIMENSION(jpi,jpj  ) ::   ztstref 
     102      !!---------------------------------------------------------------------- 
     103      ! 
     104      ! build an array with different values for each element  
     105      ! in mpp: make sure that these values are different even between process 
     106      ! -> apply a shift value according to the process number 
     107      zshift = jpimax * jpjmax * ( narea - 1 ) 
     108      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) ) 
     109      ! 
     110      puniq(:,:) = ztstref(:,:)                    ! default definition 
     111      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )   ! apply boundary conditions 
     112      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed  
     113      ! 
     114      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) 
     115      ! 
     116   END SUBROUTINE dom_uniq 
     117    
    79118   !!====================================================================== 
    80 END MODULE domngb 
     119END MODULE domutl 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domwri.F90

    r12377 r12807  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   dom_wri        : create and write mesh and mask file(s) 
    15    !!   dom_uniq       : identify unique point of a grid (TUVF) 
    1615   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 
    1716   !!---------------------------------------------------------------------- 
    1817   ! 
    1918   USE dom_oce         ! ocean space and time domain 
     19   USE domutl          !  
    2020   USE phycst ,   ONLY :   rsmall 
    2121   USE wet_dry,   ONLY :   ll_wd  ! Wetting and drying 
    … …  
    182182      !                                     ! ============================ 
    183183   END SUBROUTINE dom_wri 
    184  
    185  
    186    SUBROUTINE dom_uniq( puniq, cdgrd ) 
    187       !!---------------------------------------------------------------------- 
    188       !!                  ***  ROUTINE dom_uniq  *** 
    189       !!                    
    190       !! ** Purpose :   identify unique point of a grid (TUVF) 
    191       !! 
    192       !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element 
    193       !!                2) check which elements have been changed 
    194       !!---------------------------------------------------------------------- 
    195       CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    196       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
    197       ! 
    198       REAL(wp) ::  zshift   ! shift value link to the process number 
    199       INTEGER  ::  ji       ! dummy loop indices 
    200       LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    201       REAL(wp), DIMENSION(jpi,jpj) ::   ztstref 
    202       !!---------------------------------------------------------------------- 
    203       ! 
    204       ! build an array with different values for each element  
    205       ! in mpp: make sure that these values are different even between process 
    206       ! -> apply a shift value according to the process number 
    207       zshift = jpi * jpj * ( narea - 1 ) 
    208       ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) ) 
    209       ! 
    210       puniq(:,:) = ztstref(:,:)                   ! default definition 
    211       CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )            ! apply boundary conditions 
    212       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    213       ! 
    214       puniq(:,:) = 1.                             ! default definition 
    215       ! fill only the inner part of the cpu with llbl converted into real  
    216       puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    217       ! 
    218    END SUBROUTINE dom_uniq 
    219184 
    220185 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domzgr.F90

    r12738 r12807  
    236236      CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , pe3w_1d  ) 
    237237      ! 
    238       CALL iom_get( inum, jpdom_global, 'e3t_0'  , pe3t , cd_type = 'T', psgn = 1._wp )    ! 3D coordinate 
    239       CALL iom_get( inum, jpdom_global, 'e3u_0'  , pe3u , cd_type = 'U', psgn = 1._wp ) 
    240       CALL iom_get( inum, jpdom_global, 'e3v_0'  , pe3v , cd_type = 'V', psgn = 1._wp ) 
    241       CALL iom_get( inum, jpdom_global, 'e3f_0'  , pe3f , cd_type = 'F', psgn = 1._wp ) 
    242       CALL iom_get( inum, jpdom_global, 'e3w_0'  , pe3w , cd_type = 'W', psgn = 1._wp ) 
    243       CALL iom_get( inum, jpdom_global, 'e3uw_0' , pe3uw, cd_type = 'U', psgn = 1._wp ) 
    244       CALL iom_get( inum, jpdom_global, 'e3vw_0' , pe3vw, cd_type = 'V', psgn = 1._wp ) 
     238      CALL iom_get( inum, jpdom_global, 'e3t_0'  , pe3t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy )    ! 3D coordinate 
     239      CALL iom_get( inum, jpdom_global, 'e3u_0'  , pe3u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     240      CALL iom_get( inum, jpdom_global, 'e3v_0'  , pe3v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
     241      CALL iom_get( inum, jpdom_global, 'e3f_0'  , pe3f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 
     242      CALL iom_get( inum, jpdom_global, 'e3w_0'  , pe3w , cd_type = 'W', psgn = 1._wp, kfill = jpfillcopy ) 
     243      CALL iom_get( inum, jpdom_global, 'e3uw_0' , pe3uw, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     244      CALL iom_get( inum, jpdom_global, 'e3vw_0' , pe3vw, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
    245245      ! 
    246246      !                          !* depths 
    … …  
    254254         CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d )    
    255255         CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d ) 
    256          CALL iom_get( inum, jpdom_global , 'gdept_0' , pdept  ) 
    257          CALL iom_get( inum, jpdom_global , 'gdepw_0' , pdepw  ) 
     256         CALL iom_get( inum, jpdom_global , 'gdept_0' , pdept, kfill = jpfillcopy ) 
     257         CALL iom_get( inum, jpdom_global , 'gdepw_0' , pdepw, kfill = jpfillcopy ) 
    258258         ! 
    259259      ELSE                                !- depths computed from e3. scale factors 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/divhor.F90

    r12377 r12807  
    8686#if defined key_agrif 
    8787      IF( .NOT. Agrif_Root() ) THEN 
    88          IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west 
    89          IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east 
    90          IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south 
    91          IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north 
     88         IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(  2  ,  :  ,:) = 0._wp      ! west 
     89         IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv(jpi-1,  :  ,:) = 0._wp      ! east 
     90         IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(  :  ,  2  ,:) = 0._wp      ! south 
     91         IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(  :  ,jpj-1,:) = 0._wp      ! north 
    9292      ENDIF 
    9393#endif 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/dynldf_lap_blp.F90

    r12377 r12807  
    7474         DO_2D_01_01 
    7575            !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    76 !!gm open question here : e3f  at before or now ?    probably now... 
    77 !!gm note that ahmf has already been multiplied by fmask 
    78             zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       & 
     76            zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
    7977               &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
    8078               &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
    8179            !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    82 !!gm note that ahmt has already been multiplied by tmask 
    83             zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)                                         & 
     80            zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
    8481               &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
    8582               &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
    … …  
    8784         ! 
    8885         DO_2D_00_00 
    89             pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * (                                                 & 
     86            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    9087               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    91                &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
     88               &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
    9289               ! 
    93             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * (                                                 & 
     90            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
    9491               &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
    95                &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
     92               &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
    9693         END_2D 
    9794         !                                             ! =============== 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/sshwzv.F90

    r12489 r12807  
    202202#if defined key_agrif  
    203203      IF( .NOT. AGRIF_Root() ) THEN  
    204          IF ((nbondi ==  1).OR.(nbondi == 2)) pww(nlci-1 , :     ,:) = 0.e0      ! east  
    205          IF ((nbondi == -1).OR.(nbondi == 2)) pww(2      , :     ,:) = 0.e0      ! west  
    206          IF ((nbondj ==  1).OR.(nbondj == 2)) pww(:      ,nlcj-1 ,:) = 0.e0      ! north  
    207          IF ((nbondj == -1).OR.(nbondj == 2)) pww(:      ,2      ,:) = 0.e0      ! south  
     204         IF ((nbondi ==  1).OR.(nbondi == 2)) pww(jpi-1, :   ,:) = 0.e0      ! east  
     205         IF ((nbondi == -1).OR.(nbondi == 2)) pww( 2   , :   ,:) = 0.e0      ! west  
     206         IF ((nbondj ==  1).OR.(nbondj == 2)) pww( :   ,jpj-1,:) = 0.e0      ! north  
     207         IF ((nbondj == -1).OR.(nbondj == 2)) pww( :   , 2   ,:) = 0.e0      ! south  
    208208      ENDIF  
    209209#endif  

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/FLO/floblk.F90

    r12489 r12807  
    100100222   DO jfl = 1, jpnfl 
    101101# if   defined key_mpp_mpi 
    102          IF( iil(jfl) >= mig(nldi) .AND. iil(jfl) <= mig(nlei) .AND.   & 
    103              ijl(jfl) >= mjg(nldj) .AND. ijl(jfl) <= mjg(nlej)   ) THEN 
     102         IF( iil(jfl) >= mig(Nis0) .AND. iil(jfl) <= mig(Nie0) .AND.   & 
     103             ijl(jfl) >= mjg(Njs0) .AND. ijl(jfl) <= mjg(Nje0)   ) THEN 
    104104            iiloc(jfl) = iil(jfl) - mig(1) + 1 
    105105            ijloc(jfl) = ijl(jfl) - mjg(1) + 1 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/FLO/flodom.F90

    r12377 r12807  
    155155         ikmfl(jfl) = 0 
    156156# if   defined key_mpp_mpi 
    157          DO ji = MAX(nldi,2), nlei 
    158             DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
     157         DO ji = MAX(Nis0,2), Nie0 
     158            DO jj = MAX(Njs0,2), Nje0   ! NO vector opt. 
    159159# else          
    160160         DO ji = 2, jpi 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/FLO/florst.F90

    r11536 r12807  
    9898         IF( lk_mpp ) THEN 
    9999            DO jfl = 1, jpnfl 
    100                IF( (INT(tpifl(jfl)) >= mig(nldi)) .AND.   & 
    101                   &(INT(tpifl(jfl)) <= mig(nlei)) .AND.   & 
    102                   &(INT(tpjfl(jfl)) >= mjg(nldj)) .AND.   & 
    103                   &(INT(tpjfl(jfl)) <= mjg(nlej)) ) THEN 
     100               IF( (INT(tpifl(jfl)) >= mig(Nis0)) .AND.   & 
     101                  &(INT(tpifl(jfl)) <= mig(Nie0)) .AND.   & 
     102                  &(INT(tpjfl(jfl)) >= mjg(Njs0)) .AND.   & 
     103                  &(INT(tpjfl(jfl)) <= mjg(Nje0)) ) THEN 
    104104                  iperproc(narea) = iperproc(narea)+1 
    105105               ENDIF 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/FLO/flowri.F90

    r12489 r12807  
    105105            ibfloc = mj1( ibfl ) 
    106106  
    107             IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 
    108               & nldj <= ibfloc .AND. ibfloc <= nlej       ) THEN  
     107            IF( Nis0 <= iafloc .AND. iafloc <= Nie0 .AND. & 
     108              & Njs0 <= ibfloc .AND. ibfloc <= Nje0       ) THEN  
    109109 
    110110               !the float is inside of current proc's area 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ICB/icbini.F90

    r12738 r12807  
    133133      ! first entry with narea for this processor is left hand interior index 
    134134      ! last  entry                               is right hand interior index 
    135       jj = nlcj/2 
     135      jj = jpj/2 
    136136      nicbdi = -1 
    137137      nicbei = -1 
    … …  
    149149      ! 
    150150      ! repeat for j direction 
    151       ji = nlci/2 
     151      ji = jpi/2 
    152152      nicbdj = -1 
    153153      nicbej = -1 
    … …  
    166166      ! special for east-west boundary exchange we save the destination index 
    167167      i1 = MAX( nicbdi-1, 1) 
    168       i3 = INT( src_calving(i1,nlcj/2) ) 
     168      i3 = INT( src_calving(i1,jpj/2) ) 
    169169      jj = INT( i3/nicbpack ) 
    170170      ricb_left = REAL( i3 - nicbpack*jj, wp ) 
    171171      i1 = MIN( nicbei+1, jpi ) 
    172       i3 = INT( src_calving(i1,nlcj/2) ) 
     172      i3 = INT( src_calving(i1,jpj/2) ) 
    173173      jj = INT( i3/nicbpack ) 
    174174      ricb_right = REAL( i3 - nicbpack*jj, wp ) 
    … …  
    203203         WRITE(numicb,*) 'processor ', narea 
    204204         WRITE(numicb,*) 'jpi, jpj   ', jpi, jpj 
    205          WRITE(numicb,*) 'nldi, nlei ', nldi, nlei 
    206          WRITE(numicb,*) 'nldj, nlej ', nldj, nlej 
     205         WRITE(numicb,*) 'Nis0, Nie0 ', Nis0, Nie0 
     206         WRITE(numicb,*) 'Njs0, Nje0 ', Njs0, Nje0 
    207207         WRITE(numicb,*) 'berg i interior ', nicbdi, nicbei 
    208208         WRITE(numicb,*) 'berg j interior ', nicbdj, nicbej 
    209209         WRITE(numicb,*) 'berg left       ', ricb_left 
    210210         WRITE(numicb,*) 'berg right      ', ricb_right 
    211          jj = nlcj/2 
     211         jj = jpj/2 
    212212         WRITE(numicb,*) "central j line:" 
    213213         WRITE(numicb,*) "i processor" 
    … …  
    215215         WRITE(numicb,*) "i point" 
    216216         WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi) 
    217          ji = nlci/2 
     217         ji = jpi/2 
    218218         WRITE(numicb,*) "central i line:" 
    219219         WRITE(numicb,*) "j processor" 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ICB/icbrst.F90

    r12745 r12807  
    9191            ij = INT( localpt%yj + 0.5 ) 
    9292            ! Only proceed if this iceberg is on the local processor (excluding halos). 
    93             IF ( ii >= mig(nldi) .AND. ii <= mig(nlei) .AND.   & 
    94            &     ij >= mjg(nldj) .AND. ij <= mjg(nlej) ) THEN            
     93            IF ( ii >= mig(Nis0) .AND. ii <= mig(Nie0) .AND.   & 
     94           &     ij >= mjg(Njs0) .AND. ij <= mjg(Nje0) ) THEN            
    9595 
    9696               CALL iom_get( ncid, jpdom_unknown, 'number', zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 
    … …  
    226226    
    227227         ! Dimensions 
    228          nret = NF90_DEF_DIM(ncid, 'x', nlei-nldi+1, ix_dim) 
     228         nret = NF90_DEF_DIM(ncid, 'x', Ni_0, ix_dim) 
    229229         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim x failed') 
    230230    
    231          nret = NF90_DEF_DIM(ncid, 'y', nlej-nldj+1, iy_dim) 
     231         nret = NF90_DEF_DIM(ncid, 'y', Nj_0, iy_dim) 
    232232         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim y failed') 
    233233    
    … …  
    243243            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ) 
    244244            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ) 
    245             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1              , 2               /) ) 
    246             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global'    , (/ jpiglo         , jpjglo          /) ) 
    247             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local'     , (/ nlei - nldi + 1, nlej - nldj + 1 /) ) 
    248             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig(nldi)      , mjg(nldj)      /) ) 
    249             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last'  , (/ mig(nlei)      , mjg(nlej)      /) ) 
    250             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0              , 0               /) ) 
    251             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/ 0              , 0               /) ) 
     245            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1        , 2         /) ) 
     246            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global'    , (/ jpiglo   , jpjglo    /) ) 
     247            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local'     , (/ Ni_0     , Nj_0      /) ) 
     248            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig(Nis0), mjg(Njs0) /) ) 
     249            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last'  , (/ mig(Nie0), mjg(Nje0) /) ) 
     250            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0        , 0         /) ) 
     251            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/ 0        , 0         /) ) 
    252252            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ) 
    253253         ENDIF 
    … …  
    341341         nstrt3(1) = 1 
    342342         nstrt3(2) = 1 
    343          nlngth3(1) = nlei - nldi + 1 
    344          nlngth3(2) = nlej - nldj + 1 
     343         nlngth3(1) = Ni_0 
     344         nlngth3(2) = Nj_0 
    345345         nlngth3(3) = 1 
    346346    
    347347         DO jn=1,nclasses 
    348348            nstrt3(3) = jn 
    349             nret = NF90_PUT_VAR( ncid, nsiceid, berg_grid%stored_ice(nldi:nlei,nldj:nlej,jn), nstrt3, nlngth3 ) 
     349            nret = NF90_PUT_VAR( ncid, nsiceid, berg_grid%stored_ice(Nis0:Nie0,Njs0:Nje0,jn), nstrt3, nlngth3 ) 
    350350            IF (nret .ne. NF90_NOERR) THEN 
    351351               IF( lwp ) WRITE(numout,*) TRIM(NF90_STRERROR( nret )) 
    … …  
    358358         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var kount failed') 
    359359    
    360          nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(nldi:nlei,nldj:nlej) ) 
     360         nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(Nis0:Nie0,Njs0:Nje0) ) 
    361361         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed') 
    362362         IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written' 
    363363    
    364          nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(nldi:nlei,nldj:nlej) ) 
     364         nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(Nis0:Nie0,Njs0:Nje0) ) 
    365365         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving failed') 
    366          nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(nldi:nlei,nldj:nlej) ) 
     366         nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(Nis0:Nie0,Njs0:Nje0) ) 
    367367         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed') 
    368368         IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written' 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90

    r12745 r12807  
    2121   !!---------------------------------------------------------------------- 
    2222   USE dom_oce         ! ocean space and time domain 
     23   USE domutl          !  
    2324   USE c1d             ! 1D vertical configuration 
    2425   USE flo_oce         ! floats module declarations 
    … …  
    3435   USE ice      , ONLY :   jpl 
    3536#endif 
    36    USE domngb          ! ocean space and time domain 
    3737   USE phycst          ! physical constants 
    3838   USE dianam          ! build name of file 
    … …  
    117117      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    118118      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    119       INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
    120       INTEGER ::   nldj_save, nlej_save    !: 
     119      INTEGER ::   Nis0_save, Nie0_save    !:      and close boundaries in output files 
     120      INTEGER ::   Njs0_save, Nje0_save    !: 
    121121      LOGICAL ::   ll_closedef = .TRUE. 
    122122      !!---------------------------------------------------------------------- 
    … …  
    127127      ENDIF 
    128128      IF ( ll_tmppatch ) THEN 
    129          nldi_save = nldi   ;   nlei_save = nlei 
    130          nldj_save = nldj   ;   nlej_save = nlej 
    131          IF( nimpp           ==      1 ) nldi = 1 
    132          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    133          IF( njmpp           ==      1 ) nldj = 1 
    134          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
     129         Nis0_save = Nis0   ;   Nie0_save = Nie0 
     130         Njs0_save = Njs0   ;   Nje0_save = Nje0 
     131         IF( nimpp           ==      1 ) Nis0 = 1 
     132         IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 
     133         IF( njmpp           ==      1 ) Njs0 = 1 
     134         IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 
    135135      ENDIF 
    136136      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 
    … …  
    169169         ! 
    170170         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    171             CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 
    172             CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 
    173             CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 
    174             CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 
     171            CALL iom_set_domain_attr("grid_T", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 
     172            CALL iom_set_domain_attr("grid_U", area = e1e2u(Nis0:Nie0, Njs0:Nje0)) 
     173            CALL iom_set_domain_attr("grid_V", area = e1e2v(Nis0:Nie0, Njs0:Nje0)) 
     174            CALL iom_set_domain_attr("grid_W", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 
    175175            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    176176            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    … …  
    192192         ! 
    193193         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata 
    194             CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
    195             CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 
    196             CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 
    197             CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
     194            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 
     195            CALL iom_set_domain_attr("grid_U", area =   e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0)) 
     196            CALL iom_set_domain_attr("grid_V", area =   e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0)) 
     197            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 
    198198            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
    199199            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
    … …  
    283283      ! 
    284284      IF ( ll_tmppatch ) THEN 
    285          nldi = nldi_save   ;   nlei = nlei_save 
    286          nldj = nldj_save   ;   nlej = nlej_save 
     285         Nis0 = Nis0_save   ;   Nie0 = Nie0_save 
     286         Njs0 = Njs0_save   ;   Nje0 = Nje0_save 
    287287      ENDIF 
    288288#endif 
    … …  
    762762      ENDIF 
    763763      IF( llwrt ) THEN 
    764          idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    765          idompar(:,2) = (/ mig(nldi)      , mjg(nldj)      /) 
    766          idompar(:,3) = (/ mig(nlei)      , mjg(nlej)      /) 
    767          idompar(:,4) = (/ 0              , 0               /) 
    768          idompar(:,5) = (/ 0              , 0               /) 
     764         idompar(:,1) = (/ Ni_0     , Nj_0      /) 
     765         idompar(:,2) = (/ mig(Nis0), mjg(Njs0) /) 
     766         idompar(:,3) = (/ mig(Nie0), mjg(Nje0) /) 
     767         idompar(:,4) = (/ 0        , 0         /) 
     768         idompar(:,5) = (/ 0        , 0         /) 
    769769      ENDIF 
    770770      ! Open the NetCDF file 
    … …  
    976976   END SUBROUTINE iom_g1d 
    977977 
    978    SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kstart, kcount, ldxios) 
     978   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
    979979      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    980980      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    … …  
    984984      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    985985      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     986      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    986987      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
    987988      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
    … …  
    989990      ! 
    990991      IF( kiomid > 0 ) THEN 
    991          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom         , cdvar            , pv_r2d=pvar,   & 
    992             &                                                       ktime=ktime  , cd_type = cd_type, psgn = psgn,   & 
    993             &                                                       kstart=kstart, kcount=kcount    , ldxios=ldxios  ) 
     992         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = pvar  , ktime = ktime,   & 
     993            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     994            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
    994995      ENDIF 
    995996   END SUBROUTINE iom_g2d 
    996997 
    997    SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kstart, kcount, ldxios ) 
     998   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
    998999      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    9991000      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    … …  
    10031004      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    10041005      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1006      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    10051007      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
    10061008      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
    … …  
    10081010      ! 
    10091011      IF( kiomid > 0 ) THEN 
    1010          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom         , cdvar            , pv_r3d=pvar,   & 
    1011             &                                                       ktime=ktime  , cd_type = cd_type, psgn = psgn,   & 
    1012             &                                                       kstart=kstart, kcount=kcount    , ldxios=ldxios  ) 
     1012         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = pvar  , ktime = ktime,   & 
     1013            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1014            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
    10131015      ENDIF 
    10141016   END SUBROUTINE iom_g3d 
    10151017   !!---------------------------------------------------------------------- 
    10161018 
    1017    SUBROUTINE iom_get_123d( kiomid, kdom   , cdvar , pv_r1d, pv_r2d, pv_r3d,   & 
    1018          &                  ktime , cd_type, psgn  , kstart, kcount, ldxios ) 
     1019   SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime ,   & 
     1020         &                  cd_type, psgn, kfill, kstart, kcount, ldxios ) 
    10191021      !!----------------------------------------------------------------------- 
    10201022      !!                  ***  ROUTINE  iom_get_123d  *** 
    … …  
    10331035      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    10341036      REAL(wp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1037      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    10351038      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis  
    10361039      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount    ! number of points to be read in each axis 
    … …  
    11581161               ENDIF 
    11591162            ELSE   !   not a 1D array as pv_r1d requires jpdom_unknown 
    1160                ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
    1161                IF( idom == jpdom_global )   istart(1:2) = (/ mig(nldi), mjg(nldj) /) 
    1162                icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
     1163               ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0  
     1164               IF( idom == jpdom_global )   istart(1:2) = (/ mig(Nis0)-nn_hls, mjg(Njs0)-nn_hls /) 
     1165               icnt(1:2) = (/ Ni_0, Nj_0 /) 
    11631166               IF( PRESENT(pv_r3d) ) THEN 
    11641167                  IF( idom == jpdom_auto_xy ) THEN 
    … …  
    11911194            ELSE 
    11921195               IF( irankpv == 2 ) THEN 
    1193                   ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)' 
     1196                  ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0  ))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 
    11941197               ENDIF 
    11951198               IF( irankpv == 3 ) THEN  
    1196                   ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 
     1199                  ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 
    11971200               ENDIF 
    11981201            ENDIF          
    … …  
    12091212            ! 
    12101213            ! find the right index of the array to be read 
    1211             IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
     1214            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = Nis0   ;   ix2 = Nie0      ;   iy1 = Njs0   ;   iy2 = Nje0 
    12121215            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    12131216            ENDIF 
    … …  
    12241227               !--- overlap areas and extra hallows (mpp) 
    12251228               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1226                   CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = jpfillnothing ) 
     1229                  CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 
    12271230               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    1228                   CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = jpfillnothing ) 
     1231                  CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 
    12291232               ENDIF 
    12301233               ! 
    … …  
    18631866      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    18641867      ! 
    1865       INTEGER  :: ni, nj 
    18661868      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    18671869      LOGICAL, INTENT(IN) :: ldxios, ldrxios 
    18681870      !!---------------------------------------------------------------------- 
    18691871      ! 
    1870       ni = nlei-nldi+1 
    1871       nj = nlej-nldj+1 
    1872       ! 
    1873       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    1874       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1872      CALL iom_set_domain_attr("grid_"//cdgrd,ni_glo=jpiglo,nj_glo=jpjglo,ibegin=nimpp+Nis0-2,jbegin=njmpp+Njs0-2,ni=Ni_0,nj=Nj_0) 
     1873      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 
    18751874!don't define lon and lat for restart reading context.  
    18761875      IF ( .NOT.ldrxios ) & 
    1877          CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    1878          &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     1876         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),   & 
     1877         &                                        latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)))   
    18791878      ! 
    18801879      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 
    … …  
    18871886         END SELECT 
    18881887         ! 
    1889          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. ) 
    1890          CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
     1888         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0    /)) /= 0. ) 
     1889         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0*Nj_0,jpk/)) /= 0. ) 
    18911890      ENDIF 
    18921891      ! 
    … …  
    19051904      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j) 
    19061905      ! 
    1907       INTEGER :: ji, jj, jn, ni, nj 
     1906      INTEGER :: ji, jj, jn 
    19081907      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    19091908      !                                                 ! represents the bottom-left corner of cell (i,j) 
    … …  
    19211920      CASE ('V')        ;   icnr = -1   ;   jcnr =  0 
    19221921      END SELECT 
    1923       ! 
    1924       ni = nlei-nldi+1   ! Dimensions of subdomain interior 
    1925       nj = nlej-nldj+1 
    19261922      ! 
    19271923      z_fld(:,:) = 1._wp 
    … …  
    19581954         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    19591955            DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
    1960                z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 
     1956               z_bnds(jn,jpi,:,1) = plat_pnt(jpi,:)  ;  z_bnds(jn,jpi,:,2) = plon_pnt(jpi,:) 
    19611957            END DO 
    19621958         ENDIF 
    … …  
    19681964         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
    19691965            DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
    1970                z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 
     1966               z_bnds(jn,:,jpj,1) = plat_pnt(:,jpj)  ;  z_bnds(jn,:,jpj,2) = plon_pnt(:,jpj) 
    19711967            END DO 
    19721968         ENDIF 
    … …  
    19911987      ENDIF 
    19921988      ! 
    1993       CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
    1994           &                                    bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
     1989      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)),           & 
     1990          &                                    bounds_lon = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), nvertex=4 ) 
    19951991      ! 
    19961992      DEALLOCATE( z_bnds, z_fld, z_rot )  
    … …  
    20082004      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    20092005      ! 
    2010       INTEGER  :: ni, nj, ix, iy 
     2006      INTEGER  :: ix, iy 
    20112007      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    20122008      !!---------------------------------------------------------------------- 
    20132009      ! 
    2014       ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk) 
    2015       nj=nlej-nldj+1 
    20162010      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
    20172011      ! 
    20182012!      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    20192013      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    2020       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    2021       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     2014      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+Nis0-2, jbegin=njmpp+Njs0-2, ni=Ni_0, nj=Nj_0) 
     2015      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 
    20222016      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    2023          &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     2017         &                             latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)))   
    20242018      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
    20252019      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom_def.F90

    r12738 r12807  
    1414 
    1515   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 1   !: ( 1  :jpiglo, 1  :jpjglo) 
    16    INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 2   !: (nldi:nlei  ,nldj:nlej ) 
     16   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 2   !: (Nis0: Nie0 ,Njs0: Nje0 ) 
    1717   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 3   !: No dimension checking 
    1818   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto          = 4   !:  

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom_nf90.F90

    r12377 r12807  
    134134                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
    135135                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    136                  CALL iom_nf90_check(NF90_DEF_DIM( if90id,  'numcat',          kdlev, idmy ), clinfo) 
     136                 IF( kdlev > 0 )   CALL iom_nf90_check(NF90_DEF_DIM( if90id,  'numcat',          kdlev, idmy ), clinfo) 
    137137              ENDIF 
    138138            ELSE 
    … …  
    665665         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN 
    666666            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar) 
    667             IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN 
    668                ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej 
    669             ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN 
    670                ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj 
    671             ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN 
     667            IF(     idimsz(1) == Ni_0 .AND. idimsz(2) == Nj_0 ) THEN 
     668               ix1 = Nis0   ;   ix2 = Nie0   ;   iy1 = Njs0   ;   iy2 = Nje0 
     669            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
     670               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
     671            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
    672672               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    673673            ELSE  

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/prtctl.F90

    r12377 r12807  
    1818 
    1919   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid 
    20    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain 
    21    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain 
    22    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor 
    23    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain 
    24    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   ! 
     20   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nis0allp, njs0allp   ! first, last indoor index for each i-domain 
     21   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nie0allp, nje0allp   ! first, last indoor index for each j-domain 
     22   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::    nimpptl, njmpptl   ! i-, j-indexes for each processor 
     23   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::    jpiallp,  jpjallp   ! dimensions of every subdomain 
     24   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::    ibonitl, ibonjtl   ! 
    2525 
    2626   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values 
    … …  
    134134         IF( .NOT. lsp_area ) THEN 
    135135            IF (lk_mpp .AND. jpnij > 1)   THEN 
    136                nictls = MAX(  1, nlditl(jn) ) 
    137                nictle = MIN(jpi, nleitl(jn) ) 
    138                njctls = MAX(  1, nldjtl(jn) ) 
    139                njctle = MIN(jpj, nlejtl(jn) ) 
     136               nictls = MAX(  1, nis0allp(jn) ) 
     137               nictle = MIN(jpi, nie0allp(jn) ) 
     138               njctls = MAX(  1, njs0allp(jn) ) 
     139               njctle = MIN(jpj, nje0allp(jn) ) 
    140140               ! Do not take into account the bound of the domain 
    141141               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    142142               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    143                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nleitl(jn) - 1) 
    144                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(jn) - 1) 
     143               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nie0allp(jn) - 1) 
     144               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nje0allp(jn) - 1) 
    145145            ELSE 
    146                nictls = MAX(  1, nimpptl(jn) - 1 + nlditl(jn) ) 
    147                nictle = MIN(jpi, nimpptl(jn) - 1 + nleitl(jn) ) 
    148                njctls = MAX(  1, njmpptl(jn) - 1 + nldjtl(jn) ) 
    149                njctle = MIN(jpj, njmpptl(jn) - 1 + nlejtl(jn) ) 
     146               nictls = MAX(  1, nimpptl(jn) - 1 + nis0allp(jn) ) 
     147               nictle = MIN(jpi, nimpptl(jn) - 1 + nie0allp(jn) ) 
     148               njctls = MAX(  1, njmpptl(jn) - 1 + njs0allp(jn) ) 
     149               njctle = MIN(jpj, njmpptl(jn) - 1 + nje0allp(jn) ) 
    150150               ! Do not take into account the bound of the domain 
    151151               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    152152               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    153                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nleitl(jn) - 2) 
    154                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nlejtl(jn) - 2) 
     153               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nie0allp(jn) - 2) 
     154               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nje0allp(jn) - 2) 
    155155            ENDIF 
    156156         ENDIF 
    … …  
    277277 
    278278      ! Allocate arrays 
    279       ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
    280          &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
    281          &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     & 
    282          &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       ) 
     279      ALLOCATE( nis0allp(ijsplt) , nie0allp(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
     280         &      njs0allp(ijsplt) , nje0allp(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
     281         &       jpiallp(ijsplt) ,   t_ctll(ijsplt) ,  u_ctll(ijsplt) ,                     & 
     282         &       jpjallp(ijsplt) ,   s_ctll(ijsplt) ,  v_ctll(ijsplt)                       ) 
    283283 
    284284      ! Initialization  
    … …  
    295295         cl_run = 'MULTI processor run' 
    296296         ! use indices for each area computed by mpp_init subroutine 
    297          nlditl(1:jpnij) = nldit(:)  
    298          nleitl(1:jpnij) = nleit(:)  
    299          nldjtl(1:jpnij) = nldjt(:)  
    300          nlejtl(1:jpnij) = nlejt(:)  
     297         nis0allp(1:jpnij) = nis0all(:)  
     298         nie0allp(1:jpnij) = nie0all(:)  
     299         njs0allp(1:jpnij) = njs0all(:)  
     300         nje0allp(1:jpnij) = nje0all(:)  
    301301         ! 
    302302         nimpptl(1:jpnij) = nimppt(:) 
    303303         njmpptl(1:jpnij) = njmppt(:) 
    304304         ! 
    305          nlcitl(1:jpnij) = nlcit(:) 
    306          nlcjtl(1:jpnij) = nlcjt(:) 
     305         jpiallp(1:jpnij) = jpiall(:) 
     306         jpjallp(1:jpnij) = jpjall(:) 
    307307         ! 
    308308         ibonitl(1:jpnij) = ibonit(:) 
    … …  
    335335         ! Print the SUM control indices 
    336336         IF( .NOT. lsp_area )   THEN 
    337             nictls = nimpptl(jn) + nlditl(jn) - 1 
    338             nictle = nimpptl(jn) + nleitl(jn) - 1 
    339             njctls = njmpptl(jn) + nldjtl(jn) - 1 
    340             njctle = njmpptl(jn) + nlejtl(jn) - 1 
     337            nictls = nimpptl(jn) + nis0allp(jn) - 1 
     338            nictle = nimpptl(jn) + nie0allp(jn) - 1 
     339            njctls = njmpptl(jn) + njs0allp(jn) - 1 
     340            njctle = njmpptl(jn) + nje0allp(jn) - 1 
    341341         ENDIF 
    342342         WRITE(j_id,*)  
    … …  
    344344         WRITE(j_id,*) '~~~~~~~' 
    345345         WRITE(j_id,*) 
    346          WRITE(j_id,9000)'                                nlej   = ', nlejtl(jn), '              ' 
     346         WRITE(j_id,9000)'                                Nje0   = ', nje0allp(jn), '              ' 
    347347         WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------' 
    348348         WRITE(j_id,9001)'                  |                                       |' 
    … …  
    350350         WRITE(j_id,9001)'                  |                                       |' 
    351351         WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle 
    352          WRITE(j_id,9002)'           nldi   = ', nlditl(jn),  '                           nlei   = ', nleitl(jn) 
     352         WRITE(j_id,9002)'           Nis0   = ', nis0allp(jn),  '                           Nie0   = ', nie0allp(jn) 
    353353         WRITE(j_id,9001)'                  |                                       |' 
    354354         WRITE(j_id,9001)'                  |                                       |' 
    355355         WRITE(j_id,9001)'                  |                                       |' 
    356356         WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------' 
    357          WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        nldj   = ', nldjtl(jn), '              ' 
     357         WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        Njs0   = ', njs0allp(jn), '              ' 
    358358         WRITE(j_id,*) 
    359359         WRITE(j_id,*) 
    … …  
    392392      !!                    njmpp     : latitudinal  index 
    393393      !!                    narea     : number for local area 
    394       !!                    nlcil      : first dimension 
    395       !!                    nlcjl      : second dimension 
     394      !!                    ipil      : first dimension 
     395      !!                    ipjl      : second dimension 
    396396      !!                    nbondil    : mark for "east-west local boundary" 
    397397      !!                    nbondjl    : mark for "north-south local boundary" 
    … …  
    408408         ii, ij,                         &  ! temporary integers 
    409409         irestil, irestjl,               &  !    "          " 
    410          ijpi  , ijpj, nlcil,            &  ! temporary logical unit 
    411          nlcjl , nbondil, nbondjl,       & 
    412          nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    413  
    414       INTEGER, DIMENSION(jpi,jpj) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
     410         ijpi  , ijpj, ipil,             &  ! temporary logical unit 
     411         ipjl , nbondil, nbondjl,        & 
     412         nrecil, nrecjl, Nis0l, Nie0l, Njs0l, Nje0l 
     413 
     414      INTEGER, DIMENSION(jpi,jpj) ::   iimpptl, ijmpptl, ijpitl, ijpjtl   ! workspace 
    415415      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    416416      INTEGER ::   inum                     ! local logical unit 
    … …  
    421421      !  1. Dimension arrays for subdomains 
    422422      ! ----------------------------------- 
    423       !  Computation of local domain sizes ilcitl() ilcjtl() 
     423      !  Computation of local domain sizes ijpitl() ijpjtl() 
    424424      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 
    425425      !  The subdomains are squares leeser than or equal to the global 
    … …  
    448448      DO jj = 1, jsplt  
    449449         DO ji=1, isplt-1  
    450             ilcitl(ji,jj) = ijpi  
     450            ijpitl(ji,jj) = ijpi  
    451451         END DO  
    452          ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 
     452         ijpitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 
    453453      END DO  
    454454 
    … …  
    457457      DO jj = 1, jsplt 
    458458         DO ji = 1, irestil 
    459             ilcitl(ji,jj) = ijpi 
     459            ijpitl(ji,jj) = ijpi 
    460460         END DO 
    461461         DO ji = irestil+1, isplt 
    462             ilcitl(ji,jj) = ijpi -1 
     462            ijpitl(ji,jj) = ijpi -1 
    463463         END DO 
    464464      END DO 
    … …  
    472472      DO ji = 1, isplt  
    473473         DO jj=1, jsplt-1  
    474             ilcjtl(ji,jj) = ijpj  
     474            ijpjtl(ji,jj) = ijpj  
    475475         END DO  
    476          ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 
     476         ijpjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 
    477477      END DO  
    478478 
    … …  
    481481      DO ji = 1, isplt 
    482482         DO jj = 1, irestjl 
    483             ilcjtl(ji,jj) = ijpj 
     483            ijpjtl(ji,jj) = ijpj 
    484484         END DO 
    485485         DO jj = irestjl+1, jsplt 
    486             ilcjtl(ji,jj) = ijpj -1 
     486            ijpjtl(ji,jj) = ijpj -1 
    487487         END DO 
    488488      END DO 
    … …  
    491491      zidom = nrecil 
    492492      DO ji = 1, isplt 
    493          zidom = zidom + ilcitl(ji,1) - nrecil 
     493         zidom = zidom + ijpitl(ji,1) - nrecil 
    494494      END DO 
    495495      IF(lwp) WRITE(numout,*) 
    496       IF(lwp) WRITE(numout,*)' sum ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 
     496      IF(lwp) WRITE(numout,*)' sum ijpitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 
    497497       
    498498      zjdom = nrecjl 
    499499      DO jj = 1, jsplt 
    500          zjdom = zjdom + ilcjtl(1,jj) - nrecjl 
    501       END DO 
    502       IF(lwp) WRITE(numout,*)' sum ilcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo 
     500         zjdom = zjdom + ijpjtl(1,jj) - nrecjl 
     501      END DO 
     502      IF(lwp) WRITE(numout,*)' sum ijpitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo 
    503503      IF(lwp) WRITE(numout,*) 
    504504       
    … …  
    513513         DO jj = 1, jsplt 
    514514            DO ji = 2, isplt 
    515                iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil 
     515               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ijpitl(ji-1,jj) - nrecil 
    516516            END DO 
    517517         END DO 
    … …  
    521521         DO jj = 2, jsplt 
    522522            DO ji = 1, isplt 
    523                ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl 
     523               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ijpjtl(ji,jj-1)-nrecjl 
    524524            END DO 
    525525         END DO 
    … …  
    534534         nimpptl(jn) = iimpptl(ii,ij) 
    535535         njmpptl(jn) = ijmpptl(ii,ij) 
    536          nlcitl (jn) = ilcitl (ii,ij)      
    537          nlcil       = nlcitl (jn)      
    538          nlcjtl (jn) = ilcjtl (ii,ij)      
    539          nlcjl       = nlcjtl (jn) 
     536         jpiallp(jn) = ijpitl (ii,ij)      
     537         ipil        = jpiallp(jn)      
     538         jpjallp(jn) = ijpjtl (ii,ij)      
     539         ipjl        = jpjallp(jn) 
    540540         nbondjl = -1                                    ! general case 
    541541         IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor 
    … …  
    550550         ibonitl(jn) = nbondil 
    551551          
    552          nldil =  1   + nn_hls 
    553          nleil = nlcil - nn_hls 
    554          IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1 
    555          IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil 
    556          nldjl =  1   + nn_hls 
    557          nlejl = nlcjl - nn_hls 
    558          IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1 
    559          IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl 
    560          nlditl(jn) = nldil 
    561          nleitl(jn) = nleil 
    562          nldjtl(jn) = nldjl 
    563          nlejtl(jn) = nlejl 
     552         Nis0l =  1   + nn_hls 
     553         Nie0l = ipil - nn_hls 
     554         IF( nbondil == -1 .OR. nbondil == 2 )   Nis0l = 1 
     555         IF( nbondil ==  1 .OR. nbondil == 2 )   Nie0l = ipil 
     556         Njs0l =  1   + nn_hls 
     557         Nje0l = ipjl - nn_hls 
     558         IF( nbondjl == -1 .OR. nbondjl == 2 )   Njs0l = 1 
     559         IF( nbondjl ==  1 .OR. nbondjl == 2 )   Nje0l = ipjl 
     560         nis0allp(jn) = Nis0l 
     561         nie0allp(jn) = Nie0l 
     562         njs0allp(jn) = Njs0l 
     563         nje0allp(jn) = Nje0l 
    564564      END DO 
    565565      ! 
    … …  
    567567      IF(lwp) THEN 
    568568         CALL ctl_opn( inum, 'layout_prtctl.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    569          WRITE(inum,'(a)') 'nproc nlcil nlcjl nldil nldjl nleil nlejl nimpptl njmpptl ibonitl ibonjtl' 
     569         WRITE(inum,'(a)') 'nproc ipil ipjl Nis0l Njs0l Nie0l Nje0l nimpptl njmpptl ibonitl ibonjtl' 
    570570         ! 
    571571         DO jn = 1, ijsplt 
    572             WRITE(inum,'(i5,6i6,4i8)') jn-1,nlcitl(jn),  nlcjtl(jn), & 
    573                &                            nlditl(jn),  nldjtl(jn), & 
    574                &                            nleitl(jn),  nlejtl(jn), & 
    575                &                           nimpptl(jn), njmpptl(jn), & 
    576                &                           ibonitl(jn), ibonjtl(jn) 
     572            WRITE(inum,'(i5,6i6,4i8)') jn-1, jpiallp(jn),  jpjallp(jn), & 
     573               &                            nis0allp(jn), njs0allp(jn), & 
     574               &                            nie0allp(jn), nje0allp(jn), & 
     575               &                             nimpptl(jn), njmpptl(jn), & 
     576               &                             ibonitl(jn), ibonjtl(jn) 
    577577         END DO 
    578578         CLOSE(inum)    

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ISF/isfcpl.F90

    r12738 r12807  
    1616   USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine 
    1717   USE domvvl  , ONLY: dom_vvl_zgr      ! vertical scale factor interpolation 
    18    USE domngb  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position 
     18   USE domutl  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position 
    1919   ! 
    2020   USE oce            ! ocean dynamics and tracers 
    … …  
    519519 
    520520      DO jk = 1,jpk-1 
    521          DO jj = nldj,nlej 
    522             DO ji = nldi,nlei 
     521         DO jj = Njs0,Nje0 
     522            DO ji = Nis0,Nie0 
    523523 
    524524               ! volume diff 
    … …  
    552552      nisfl(:)=0 
    553553      DO jk = 1,jpk-1 
    554          DO jj = nldj,nlej 
    555             DO ji = nldi,nlei 
     554         DO jj = Njs0,Nje0 
     555            DO ji = Nis0,Nie0 
    556556               jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ; 
    557557               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp) 
    … …  
    572572      jisf = 0 
    573573      DO jk = 1,jpk-1 
    574          DO jj = nldj,nlej 
    575             DO ji = nldi,nlei 
     574         DO jj = Njs0,Nje0 
     575            DO ji = Nis0,Nie0 
    576576               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN 
    577577 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ISF/isfutils.F90

    r12738 r12807  
    1515   USE lib_fortran   , ONLY: glob_sum, glob_min, glob_max                    ! compute global value 
    1616   USE par_oce       , ONLY: jpi,jpj,jpk, jpnij                              ! domain size 
    17    USE dom_oce       , ONLY: nldi, nlei, nldj, nlej, narea, tmask_h, tmask_i ! local domain 
     17   USE dom_oce       , ONLY: Nis0, Nie0, Njs0, Nje0, narea, tmask_h, tmask_i ! local domain 
    1818   USE in_out_manager, ONLY: i8, wp, lwp, numout                             ! miscelenious 
    1919   USE lib_mpp 
    … …  
    8484      ! 
    8585      ! local MOD sum 
    86       DO jj=nldj,nlej 
    87          DO ji=nldi,nlei 
     86      DO jj=Njs0,Nje0 
     87         DO ji=Nis0,Nie0 
    8888            idums = ABS(MOD(TRANSFER(pvar(ji,jj), ip),imodd)) 
    8989            itmps(narea) = MOD(itmps(narea) + idums, imods) 
    … …  
    138138      ! local MOD sum 
    139139      DO jk=1,jpk 
    140          DO jj=nldj,nlej 
    141             DO ji=nldi,nlei 
     140         DO jj=Njs0,Nje0 
     141            DO ji=Nis0,Nie0 
    142142               idums = ABS(MOD(TRANSFER(pvar(ji,jj,jk), ip),imodd)) 
    143143               itmps(narea) = MOD(itmps(narea) + idums, imods) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/halo_mng.F90

    r12719 r12807  
    2626   INTEGER :: jpi_1, jpj_1 
    2727   INTEGER :: jpimax_1, jpjmax_1 
    28    INTEGER :: nlci_1, nlcj_1 
    29    INTEGER :: nldi_1, nldj_1 
    30    INTEGER :: nlei_1, nlej_1 
     28   INTEGER :: Nis0_1, Njs0_1 
     29   INTEGER :: Nie0_1, Nje0_1 
    3130CONTAINS 
    3231 
    … …  
    3635        jpj_1 = jpj 
    3736 
    38         nlci_1 = nlci 
    39         nlcj_1 = nlcj 
     37        Nis0_1 = Nis0 
     38        Njs0_1 = Njs0 
    4039 
    41         nldi_1 = nldi 
    42         nldj_1 = nldj 
    43  
    44         nlei_1 = nlei 
    45         nlej_1 = nlej 
     40        Nie0_1 = Nie0 
     41        Nje0_1 = Nje0 
    4642 
    4743      jpimax_1 = jpimax 
    … …  
    5955        jpj = jpj_1 + 2*khls -2 
    6056 
    61         nlci = nlci_1 + 2*khls -2 
    62         nlcj = nlcj_1 + 2*khls -2 
     57        jpi = jpi_1 + 2*khls -2 
     58        jpj = jpj_1 + 2*khls -2 
    6359         
    6460        jpimax = jpimax_1 + 2*khls -2 
    6561        jpjmax = jpjmax_1 + 2*khls -2 
    6662 
    67         nldi = nldi_1 + khls - 1 
    68         nldj = nldj_1 + khls - 1 
     63        Nis0 = Nis0_1 + khls - 1 
     64        Njs0 = Njs0_1 + khls - 1 
    6965 
    70         nlei = nlei_1 + khls - 1 
    71         nlej = nlej_1 + khls - 1 
     66        Nie0 = Nie0_1 + khls - 1 
     67        Nje0 = Nje0_1 + khls - 1 
    7268 
    7369   END SUBROUTINE halo_mng_set 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_ext_generic.h90

    r10525 r12807  
    2828      ! 
    2929      SELECT CASE ( jpni ) 
    30       CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction 
     30      CASE ( 1 )     ;   ipj = jpj        ! 1 proc only  along the i-direction 
    3131      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction 
    3232      END SELECT 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_generic.h90

    r10425 r12807  
    6565      ! 
    6666      SELECT CASE ( jpni ) 
    67       CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction 
     67      CASE ( 1 )     ;   ipj = jpj        ! 1 proc only  along the i-direction 
    6868      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction 
    6969      END SELECT 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_nogather_generic.h90

    r12719 r12807  
    9797               DO jl = 1, ipl; DO jk = 1, ipk 
    9898                    DO jj = 1, nn_hls 
    99                        ijj = nlcj -jj +1 
    100                      DO ji = startloop, nlci 
     99                       ijj = jpj -jj +1 
     100                     DO ji = startloop, jpi 
    101101                     ijt = jpiglo - (ji + nimpp-nn_hls+1 ) - nfiimpp(isendto(1),jpnj) + 4 
    102102                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    … …  
    107107                  DO jl = 1, ipl; DO jk = 1, ipk 
    108108                     DO jj = 1, nn_hls 
    109                      ijj = nlcj -jj +1 
     109                     ijj = jpj -jj +1 
    110110                     DO ii = 0, nn_hls-1 
    111                         ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,nlcj-2*nn_hls+jj-1,jk,jl,jf) 
     111                        ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf) 
    112112                     END DO 
    113113                     END DO 
    … …  
    118118                  IF( nimpp >= jpiglo/2+1 ) THEN 
    119119                     startloop = 1 
    120                   ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
     120                  ELSEIF( nimpp+jpi-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    121121                     startloop = jpiglo/2+1 - nimpp + nn_hls 
    122122                  ELSE 
    123                      startloop = nlci + 1 
    124                   ENDIF 
    125                   IF( startloop <= nlci ) THEN 
     123                     startloop = jpi + 1 
     124                  ENDIF 
     125                  IF( startloop <= jpi ) THEN 
    126126                     DO jl = 1, ipl; DO jk = 1, ipk 
    127                         DO ji = startloop, nlci 
     127                        DO ji = startloop, jpi 
    128128                           ijt  = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 
    129129                           jia  = ji + nimpp -nn_hls 
    130130                           ijta = jpiglo - jia + 2 
    131131                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
    132                               ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf) 
     132                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 
    133133                           ELSE 
    134                               ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
     134                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
    135135                           ENDIF 
    136136                        END DO 
    … …  
    139139               ENDIF 
    140140            CASE ( 'U' )                                     ! U-point 
    141                IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    142                   endloop = nlci 
     141               IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 
     142                  endloop = jpi 
    143143               ELSE 
    144                   endloop = nlci - nn_hls 
    145                ENDIF 
    146                DO jl = 1, ipl; DO jk = 1, ipk 
    147         DO jj = 1, nn_hls 
    148               ijj = nlcj -jj +1 
     144                  endloop = jpi - nn_hls 
     145               ENDIF 
     146               DO jl = 1, ipl; DO jk = 1, ipk 
     147        DO jj = 1, nn_hls 
     148              ijj = jpj -jj +1 
    149149                     DO ji = 1, endloop 
    150150                        iju = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 3 
    … …  
    155155               IF (nimpp .eq. 1) THEN 
    156156        DO jj = 1, nn_hls 
    157            ijj = nlcj -jj +1 
     157           ijj = jpj -jj +1 
    158158           DO ii = 0, nn_hls-1 
    159          ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     159         ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 
    160160           END DO 
    161161                  END DO 
    162162               ENDIF 
    163                IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN 
     163               IF((nimpp + jpi - 2*nn_hls+1) .eq. jpiglo) THEN 
    164164                  DO jj = 1, nn_hls 
    165                        ijj = nlcj -jj +1 
     165                       ijj = jpj -jj +1 
    166166         DO ii = 1, nn_hls 
    167                ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     167               ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 
    168168         END DO 
    169169        END DO 
    … …  
    171171               ! 
    172172               IF ( .NOT. l_fast_exchanges ) THEN 
    173                   IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    174                      endloop = nlci 
    175                   ELSE 
    176                      endloop = nlci - nn_hls 
     173                  IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 
     174                     endloop = jpi 
     175                  ELSE 
     176                     endloop = jpi - nn_hls 
    177177                  ENDIF 
    178178                  IF( nimpp >= jpiglo/2 ) THEN 
    179179                     startloop = 1 
    180                   ELSEIF( ( nimpp + nlci - 2*nn_hls+1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 
     180                  ELSEIF( ( nimpp + jpi - 2*nn_hls+1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 
    181181                     startloop = jpiglo/2 - (nimpp -nn_hls+1) +1 
    182182                  ELSE 
    … …  
    190190                        ijua = jpiglo - jia + 1 
    191191                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
    192                            ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf) 
     192                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 
    193193                        ELSE 
    194                            ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
     194                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
    195195                        ENDIF 
    196196                     END DO 
    … …  
    208208                  DO jl = 1, ipl; DO jk = 1, ipk 
    209209                       DO jj = 2, nn_hls+1 
    210                      ijj = nlcj -jj +1 
    211                         DO ji = startloop, nlci 
     210                     ijj = jpj -jj +1 
     211                        DO ji = startloop, jpi 
    212212                           ijt=jpiglo - (ji +nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 
    213213                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    … …  
    217217               ENDIF 
    218218               DO jl = 1, ipl; DO jk = 1, ipk 
    219                   DO ji = startloop, nlci 
     219                  DO ji = startloop, jpi 
    220220                     ijt=jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 
    221                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 
     221                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 
    222222                  END DO 
    223223               END DO; END DO 
    224224               IF (nimpp .eq. 1) THEN 
    225225        DO jj = 1, nn_hls 
    226                        ijj = nlcj-jj+1 
     226                       ijj = jpj-jj+1 
    227227                       DO ii = 0, nn_hls-1 
    228                         ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,nlcj-2*nn_hls+jj-1,:,:,jf) 
     228                        ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf) 
    229229           END DO 
    230230        END DO 
    231231               ENDIF 
    232232            CASE ( 'F' )                                     ! F-point 
    233                IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    234                   endloop = nlci 
     233               IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 
     234                  endloop = jpi 
    235235               ELSE 
    236                   endloop = nlci - nn_hls 
     236                  endloop = jpi - nn_hls 
    237237               ENDIF 
    238238               IF ( .NOT. l_fast_exchanges ) THEN 
    239239                  DO jl = 1, ipl; DO jk = 1, ipk 
    240240                       DO jj = 2, nn_hls+1 
    241                      ijj = nlcj -jj +1 
     241                     ijj = jpj -jj +1 
    242242                        DO ji = 1, endloop 
    243243                           iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    … …  
    250250                  DO ji = 1, endloop 
    251251                     iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    252                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 
     252                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 
    253253                  END DO 
    254254               END DO; END DO 
    255255      IF (nimpp .eq. 1) THEN                
    256256         DO ii = 1, nn_hls 
    257                  ARRAY_IN(ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls-1,:,:,jf) 
     257                 ARRAY_IN(ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf) 
    258258         END DO 
    259259         IF ( .NOT. l_fast_exchanges ) THEN 
    260260            DO jj = 1, nn_hls 
    261                       ijj = nlcj -jj 
     261                      ijj = jpj -jj 
    262262                      DO ii = 1, nn_hls 
    263                          ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     263                         ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 
    264264                   END DO 
    265265                      END DO 
    266266                     ENDIF 
    267267      ENDIF 
    268       IF((nimpp + nlci - 2*nn_hls+1 ) .eq. jpiglo) THEN 
     268      IF((nimpp + jpi - 2*nn_hls+1 ) .eq. jpiglo) THEN 
    269269                   DO ii = 1, nn_hls 
    270                  ARRAY_IN(nlci-ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls-1,:,:,jf) 
     270                 ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf) 
    271271         END DO 
    272272         IF ( .NOT. l_fast_exchanges ) THEN 
    273273            DO jj = 1, nn_hls 
    274                            ijj = nlcj -jj 
     274                           ijj = jpj -jj 
    275275                      DO ii = 1, nn_hls 
    276                          ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     276                         ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 
    277277                         END DO 
    278278                      END DO 
    … …  
    288288               DO jl = 1, ipl; DO jk = 1, ipk 
    289289        DO jj = 1, nn_hls 
    290            ijj = nlcj-jj+1 
    291            DO ji = 1, nlci 
     290           ijj = jpj-jj+1 
     291           DO ji = 1, jpi 
    292292                        ijt = jpiglo - ( ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    293293                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    … …  
    297297               ! 
    298298            CASE ( 'U' )                                     ! U-point 
    299                IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    300                   endloop = nlci 
     299               IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 
     300                  endloop = jpi 
    301301               ELSE 
    302                   endloop = nlci - nn_hls 
    303                ENDIF 
    304                DO jl = 1, ipl; DO jk = 1, ipk 
    305         DO jj = 1, nn_hls 
    306            ijj = nlcj-jj+1 
     302                  endloop = jpi - nn_hls 
     303               ENDIF 
     304               DO jl = 1, ipl; DO jk = 1, ipk 
     305        DO jj = 1, nn_hls 
     306           ijj = jpj-jj+1 
    307307                     DO ji = 1, endloop 
    308308                        iju = jpiglo- (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 
    … …  
    311311                  END DO 
    312312               END DO; END DO 
    313                IF(nimpp + nlci - 2*nn_hls+1 .eq. jpiglo) THEN 
     313               IF(nimpp + jpi - 2*nn_hls+1 .eq. jpiglo) THEN 
    314314                  DO jl = 1, ipl; DO jk = 1, ipk 
    315315                     DO jj = 1, nn_hls 
    316                           ijj = nlcj-jj+1 
     316                          ijj = jpj-jj+1 
    317317                        DO ii = 1, nn_hls 
    318             iij = nlci-ii+1 
    319                            ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii-1,nlcj-2*nn_hls+jj,jk,jl,jf) 
     318            iij = jpi-ii+1 
     319                           ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf) 
    320320                        END DO 
    321321                     END DO 
    … …  
    326326               DO jl = 1, ipl; DO jk = 1, ipk 
    327327        DO jj = 1, nn_hls 
    328            ijj = nlcj -jj +1 
    329                      DO ji = 1, nlci 
     328           ijj = jpj -jj +1 
     329                     DO ji = 1, jpi 
    330330                        ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    331331                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    … …  
    337337                  IF( nimpp >= jpiglo/2+1 ) THEN 
    338338                     startloop = 1 
    339                   ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
     339                  ELSEIF( nimpp+jpi-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    340340                     startloop = jpiglo/2+1 - nimpp + nn_hls 
    341341                  ELSE 
    342                      startloop = nlci + 1 
    343                   ENDIF 
    344                   IF( startloop <= nlci ) THEN 
    345                   DO jl = 1, ipl; DO jk = 1, ipk 
    346                         DO ji = startloop, nlci 
     342                     startloop = jpi + 1 
     343                  ENDIF 
     344                  IF( startloop <= jpi ) THEN 
     345                  DO jl = 1, ipl; DO jk = 1, ipk 
     346                        DO ji = startloop, jpi 
    347347                        ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    348                            ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
     348                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
    349349                        END DO 
    350350                  END DO; END DO 
    … …  
    353353               ! 
    354354            CASE ( 'F' )                               ! F-point 
    355                IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    356                   endloop = nlci 
     355               IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 
     356                  endloop = jpi 
    357357               ELSE 
    358                   endloop = nlci - nn_hls 
    359                ENDIF 
    360                DO jl = 1, ipl; DO jk = 1, ipk 
    361         DO jj = 1, nn_hls 
    362           ijj = nlcj -jj +1 
     358                  endloop = jpi - nn_hls 
     359               ENDIF 
     360               DO jl = 1, ipl; DO jk = 1, ipk 
     361        DO jj = 1, nn_hls 
     362          ijj = jpj -jj +1 
    363363                    DO ji = 1, endloop 
    364364                       iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 
    … …  
    367367                  END DO 
    368368               END DO; END DO 
    369                IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN 
     369               IF((nimpp + jpi - 2*nn_hls+1) .eq. jpiglo) THEN 
    370370                  DO jl = 1, ipl; DO jk = 1, ipk 
    371371                     DO jj = 1, nn_hls 
    372                         ijj = nlcj -jj +1 
     372                        ijj = jpj -jj +1 
    373373                        DO ii = 1, nn_hls 
    374             iij = nlci -ii+1 
    375                            ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii-1,nlcj-2*nn_hls+jj-1,jk,jl,jf) 
     374            iij = jpi -ii+1 
     375                           ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf) 
    376376                        END DO 
    377377                     END DO 
    … …  
    380380               ! 
    381381               IF ( .NOT. l_fast_exchanges ) THEN 
    382                   IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    383                      endloop = nlci 
    384                   ELSE 
    385                      endloop = nlci - nn_hls 
     382                  IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 
     383                     endloop = jpi 
     384                  ELSE 
     385                     endloop = jpi - nn_hls 
    386386                  ENDIF 
    387387                  IF( nimpp >= jpiglo/2+1 ) THEN 
    388388                     startloop = 1  
    389                   ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
     389                  ELSEIF( nimpp+jpi-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    390390                     startloop = jpiglo/2+1 - nimpp + nn_hls 
    391391                  ELSE 
    … …  
    396396                        DO ji = startloop, endloop 
    397397                           iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 
    398                            ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
     398                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
    399399                        END DO 
    400400                     END DO; END DO 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbclnk.F90

    r12377 r12807  
    248248      ! 
    249249      INTEGER ::   ji, jj, jr 
    250       INTEGER ::   ierr, itaille, ildi, ilei, iilb 
     250      INTEGER ::   ierr, itaille, iis0, iie0, iilb 
    251251      INTEGER ::   ipj, ij, iproc 
    252252      ! 
    … …  
    282282      DO jr = 1, ndim_rank_north            ! recover the global north array 
    283283         iproc = nrank_north(jr) + 1 
    284          ildi = nldit (iproc) 
    285          ilei = nleit (iproc) 
     284         iis0 = nis0all(iproc) 
     285         iie0 = nie0all(iproc) 
    286286         iilb = nimppt(iproc) 
    287287         DO jj = 1-kextj, ipj+kextj 
    288             DO ji = ildi, ilei 
     288            DO ji = iis0, iie0 
    289289               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 
    290290            END DO 
    … …  
    396396      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    397397      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    398          iihom = jpi-nreci-kexti 
     398         iihom = jpi - (2 * nn_hls) - kexti 
    399399         DO jl = 1, ipreci 
    400400            r2dew(:,jl,1) = pt2d(nn_hls+jl,:) 
    … …  
    453453      ! 
    454454      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    455          ijhom = jpj-nrecj-kextj 
     455         ijhom = jpj - ( 2 * nn_hls ) -kextj 
    456456         DO jl = 1, iprecj 
    457457            r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90

    r12719 r12807  
    189189         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    190190            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    191          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     191         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    192192      CASE ( jpfillperio )                 ! use east-weast periodicity 
    193193         ishift2 = jpi - 2 * nn_hls 
    194194         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    195195            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    196          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     196         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    197197      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    198          DO jf = 1, ipf                               ! number of arrays to be treated 
    199             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    200                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    201                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 
    202                END DO   ;   END DO   ;   END DO   ;   END DO 
    203             ENDIF 
    204          END DO 
     198         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     199            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 
     200         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    205201      CASE ( jpfillcst   )                 ! filling with constant value 
    206          DO jf = 1, ipf                               ! number of arrays to be treated 
    207             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    208                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    209                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    210                END DO;   END DO   ;   END DO   ;   END DO 
    211             ENDIF 
    212          END DO 
     202         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     203            ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     204         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    213205      END SELECT 
    214206      ! 
    … …  
    234226         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    235227            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
    236          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     228         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    237229      END SELECT 
    238230      ! 
    … …  
    303295         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    304296            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    305          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     297         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    306298      CASE ( jpfillperio )                 ! use north-south periodicity 
    307299         ishift2 = jpj - 2 * nn_hls 
    308300         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    309301            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    310          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     302         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    311303      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    312          DO jf = 1, ipf                               ! number of arrays to be treated 
    313             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    314                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    315                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 
    316                END DO   ;   END DO   ;   END DO   ;   END DO 
    317             ENDIF 
    318          END DO 
     304         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     305            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 
     306         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    319307      CASE ( jpfillcst   )                 ! filling with constant value 
    320          DO jf = 1, ipf                               ! number of arrays to be treated 
    321             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    322                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi  
    323                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    324                END DO;   END DO   ;   END DO   ;   END DO 
    325             ENDIF 
    326          END DO 
     308         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi  
     309            ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     310         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    327311      END SELECT 
    328312      ! 
    … …  
    340324         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    341325            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    342          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     326         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    343327      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    344328         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    345329            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
    346          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     330         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    347331      CASE ( jpfillcst   )                 ! filling with constant value 
    348332         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    349333            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
    350          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     334         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    351335      END SELECT 
    352336      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

    r12719 r12807  
    5656      INTEGER  ::   ipi, ipk, ipl, ipf         ! dimension of the input array 
    5757      INTEGER  ::   imigr, iihom, ijhom             ! local integers 
    58       INTEGER  ::   ierr, ibuffsize, ilci, ildi, ilei, iilb 
     58      INTEGER  ::   ierr, ibuffsize, ijpi, iis0, iie0, iilb 
    5959      INTEGER  ::   ij, iproc 
    6060      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather 
    … …  
    111111               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    112112                  DO ji = 1, nn_hls+1 
    113                      jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     113                     jj_s(jf,ji) = jpj - 2*nn_hls +ji -1 
    114114                  ENDDO 
    115115               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    116116                  DO ji = 1, nn_hls+1 
    117                      jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2 
     117                     jj_s(jf,ji) = jpj - 2*nn_hls +ji - 2 
    118118                  ENDDO 
    119119               END SELECT 
    … …  
    124124               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    125125                  DO ji = 1, nn_hls 
    126                      jj_s(jf,ji) = nlcj - 2*nn_hls + ji 
     126                     jj_s(jf,ji) = jpj - 2*nn_hls + ji 
    127127                  ENDDO 
    128128                  ipj_s(jf) = nn_hls                  ! need only one line anyway 
    129129               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    130130                  DO ji = 1, nn_hls+1 
    131                      jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     131                     jj_s(jf,ji) = jpj - 2*nn_hls +ji -1 
    132132                  ENDDO 
    133133               END SELECT 
    … …  
    175175            iproc = nfipproc(isendto(jr),jpnj) 
    176176            IF(iproc /= -1) THEN 
    177                iilb = nimppt(iproc+1) 
    178                ilci = nlcit (iproc+1) 
    179                ildi = nldit (iproc+1) + nn_hls-1 
    180                ilei = nleit (iproc+1) + nn_hls-1 
    181                IF( iilb            ==      1 )   ildi = nn_hls   ! e-w boundary already done -> force to take 1st column 
    182                IF( iilb + ilci - 1 == jpiglo )   ilei = nlei+1   ! e-w boundary already done -> force to take last column 
     177               iilb =  nimppt(iproc+1) 
     178               ijpi =  jpiall(iproc+1) 
     179               iis0 = nis0all(iproc+1) + nn_hls-1 
     180               iie0 = nie0all(iproc+1) + nn_hls-1 
     181               IF( iilb            ==      1 )   iis0 = nn_hls   ! e-w boundary already done -> force to take 1st column 
     182               IF( iilb + ijpi - 1 == jpiglo )   iie0 = Nie0+1   ! e-w boundary already done -> force to take last column 
    183183               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    184184            ENDIF 
    … …  
    190190                  DO jl = 1, ipl 
    191191                     DO jk = 1, ipk 
    192                         DO ji = ildi, ilei 
     192                        DO ji = iis0, iie0 
    193193                           ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1) 
    194194                        END DO 
    … …  
    200200                  DO jl = 1, ipl 
    201201                     DO jk = 1, ipk 
    202                         DO ji = ildi, ilei 
     202                        DO ji = iis0, iie0 
    203203                           ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf) 
    204204                        END DO 
    … …  
    233233            DO jl = 1, ipl 
    234234               DO jk = 1, ipk 
    235                   DO jj = nlcj - ijpj +1, nlcj 
    236                      ij = jj - nlcj + ijpj 
     235                  DO jj = jpj - ijpj +1, jpj 
     236                     ij = jj - jpj + ijpj 
    237237                     znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf) 
    238238                  END DO 
    … …  
    262262         DO jr = 1, ndim_rank_north         ! recover the global north array 
    263263            iproc = nrank_north(jr) + 1 
    264             iilb  = nimppt(iproc) 
    265             ilci  = nlcit (iproc) 
    266             ildi  = nldit (iproc) 
    267             ilei  = nleit (iproc) 
    268             IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column 
    269             IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column 
     264            iilb  =  nimppt(iproc) 
     265            ijpi  =  jpiall(iproc) 
     266            iis0  = nis0all(iproc) 
     267            iie0  = nie0all(iproc) 
     268            IF( iilb            ==      1 )   iis0 = 1      ! e-w boundary already done -> force to take 1st column 
     269            IF( iilb + ijpi - 1 == jpiglo )   iie0 = ijpi   ! e-w boundary already done -> force to take last column 
    270270            DO jf = 1, ipf 
    271271               DO jl = 1, ipl 
    272272                  DO jk = 1, ipk 
    273273                     DO jj = 1, ijpj 
    274                         DO ji = ildi, ilei 
     274                        DO ji = iis0, iie0 
    275275                           ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr) 
    276276                        END DO 
    … …  
    287287            DO jl = 1, ipl 
    288288               DO jk = 1, ipk 
    289                   DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to ARRAY_IN 
    290                      ij = jj - nlcj + ijpj 
    291                      DO ji= 1, nlci 
     289                  DO jj = jpj-ijpj+1, jpj             ! Scatter back to ARRAY_IN 
     290                     ij = jj - jpj + ijpj 
     291                     DO ji= 1, jpi 
    292292                        ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf) 
    293293                     END DO 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90

    r12760 r12807  
    5959      !!---------------------------------------------------------------------- 
    6060      ! 
     61      jpiglo = Ni0glo 
     62      jpjglo = Nj0glo 
    6163      jpimax = jpiglo 
    6264      jpjmax = jpjglo 
    … …  
    7678      nimpp  = 1           !  
    7779      njmpp  = 1 
    78       nlci   = jpi 
    79       nlcj   = jpj 
    80       nldi   = 1 
    81       nldj   = 1 
    82       nlei   = jpi 
    83       nlej   = jpj 
    8480      nbondi = 2 
    8581      nbondj = 2 
    … …  
    131127      !!                    njmpp     : latitudinal  index 
    132128      !!                    narea     : number for local area 
    133       !!                    nlci      : first dimension 
    134       !!                    nlcj      : second dimension 
    135129      !!                    nbondi    : mark for "east-west local boundary" 
    136130      !!                    nbondj    : mark for "north-south local boundary" 
    … …  
    158152      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   iin, ii_nono, ii_noea          ! 1D workspace 
    159153      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ijn, ii_noso, ii_nowe          !  -     - 
    160       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace 
    161       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj, ibondj, ipolj    !  -     - 
    162       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilei, ildi, iono, ioea         !  -     - 
    163       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilej, ildj, ioso, iowe         !  -     - 
     154      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi, ibondi, ipproc   ! 2D workspace 
     155      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj, ibondj, ipolj    !  -     - 
     156      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iie0, iis0, iono, ioea         !  -     - 
     157      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ije0, ijs0, ioso, iowe         !  -     - 
    164158      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   llisoce                        !  -     - 
    165159      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           & 
    … …  
    194188      ! 
    195189      IF(lwm)   WRITE( numond, nammpp ) 
    196  
     190      ! 
     191!!!------------------------------------ 
     192!!!  nn_hls shloud be read in nammpp 
     193!!!------------------------------------ 
     194      jpiglo = Ni0glo + 2 * nn_hls 
     195      jpjglo = Nj0glo + 2 * nn_hls 
     196      ! 
    197197      ! do we need to take into account bdy_msk? 
    198198      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    … …  
    204204      IF( ln_bdy .AND. ln_mask_file ) CALL iom_open( cn_mask_file, numbdy ) 
    205205      ! 
    206       IF( ln_listonly )   CALL mpp_init_bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. )   ! must be done by all core 
     206      IF( ln_listonly )   CALL bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. )   ! must be done by all core 
    207207      ! 
    208208      !  1. Dimension arrays for subdomains 
    209209      ! ----------------------------------- 
    210210      ! 
    211       ! If dimensions of processor grid weren't specified in the namelist file 
     211      ! If dimensions of processors grid weren't specified in the namelist file 
    212212      ! then we calculate them here now that we have our communicator size 
    213213      IF(lwp) THEN 
    … …  
    217217      ENDIF 
    218218      IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    219          CALL mpp_init_bestpartition( mppsize, jpni, jpnj )           ! best mpi decomposition for mppsize mpi processes 
     219         CALL bestpartition( mppsize, jpni, jpnj )           ! best mpi decomposition for mppsize mpi processes 
    220220         llauto = .TRUE. 
    221221         llbest = .TRUE. 
    222222      ELSE 
    223223         llauto = .FALSE. 
    224          CALL mpp_init_bestpartition( mppsize, inbi, inbj, icnt2 )    ! best mpi decomposition for mppsize mpi processes 
     224         CALL bestpartition( mppsize, inbi, inbj, icnt2 )    ! best mpi decomposition for mppsize mpi processes 
    225225         ! largest subdomain size for mpi decoposition jpni*jpnj given in the namelist 
    226          CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax ) 
    227          ! largest subdomain size for mpi decoposition inbi*inbj given by mpp_init_bestpartition 
    228          CALL mpp_basic_decomposition( inbi, inbj,  iimax,  ijmax ) 
     226         CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax ) 
     227         ! largest subdomain size for mpi decoposition inbi*inbj given by bestpartition 
     228         CALL basic_decomposition( jpiglo, jpjglo, nn_hls, inbi, inbj,  iimax,  ijmax ) 
    229229         icnt1 = jpni*jpnj - mppsize   ! number of land subdomains that should be removed to use mppsize mpi processes 
    230230         IF(lwp) THEN 
    … …  
    257257      ! look for land mpi subdomains... 
    258258      ALLOCATE( llisoce(jpni,jpnj) ) 
    259       CALL mpp_init_isoce( jpni, jpnj, llisoce ) 
     259      CALL is_ocean( jpni, jpnj, llisoce ) 
    260260      inijmin = COUNT( llisoce )   ! number of oce subdomains 
    261261 
    … …  
    266266         WRITE(ctmp4,*) '   ==>>> There is the list of best domain decompositions you should use: ' 
    267267         CALL ctl_stop( ctmp1, ctmp2, ctmp3, ' ', ctmp4, ' ' ) 
    268          CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
     268         CALL bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
    269269      ENDIF 
    270270 
    … …  
    290290            WRITE(numout,*) 
    291291         ENDIF 
    292          CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
     292         CALL bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
    293293      ENDIF 
    294294 
    … …  
    318318      IF( numbdy /= -1 )   CALL iom_close( numbdy ) 
    319319     
    320       ALLOCATE(  nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) ,    & 
    321          &       nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,    & 
    322          &       njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,    & 
    323          &                                       nleit(jpnij) , nlejt(jpnij) ,    & 
     320      ALLOCATE(  nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfijpit(jpni,jpnj) ,    & 
     321         &       nimppt(jpnij) , ibonit(jpnij) ,  jpiall(jpnij) ,  jpjall(jpnij) ,    & 
     322         &       njmppt(jpnij) , ibonjt(jpnij) , nis0all(jpnij) , njs0all(jpnij) ,    & 
     323         &                                       nie0all(jpnij) , nje0all(jpnij) ,    & 
    324324         &       iin(jpnij), ii_nono(jpnij), ii_noea(jpnij),   & 
    325325         &       ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij),   & 
    326          &       iimppt(jpni,jpnj), ilci(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   & 
    327          &       ijmppt(jpni,jpnj), ilcj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj),   & 
    328          &       ilei(jpni,jpnj), ildi(jpni,jpnj), iono(jpni,jpnj), ioea(jpni,jpnj),   & 
    329          &       ilej(jpni,jpnj), ildj(jpni,jpnj), ioso(jpni,jpnj), iowe(jpni,jpnj),   & 
     326         &       iimppt(jpni,jpnj), ijpi(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   & 
     327         &       ijmppt(jpni,jpnj), ijpj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj),   & 
     328         &         iie0(jpni,jpnj), iis0(jpni,jpnj),   iono(jpni,jpnj),  ioea(jpni,jpnj),   & 
     329         &         ije0(jpni,jpnj), ijs0(jpni,jpnj),   ioso(jpni,jpnj),  iowe(jpni,jpnj),   & 
    330330         &       STAT=ierr ) 
    331331      CALL mpp_sum( 'mppini', ierr ) 
    … …  
    345345      ! ----------------------------------- 
    346346      ! 
    347       nreci = 2 * nn_hls 
    348       nrecj = 2 * nn_hls 
    349       CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ilci, ilcj ) 
     347      CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 
    350348      nfiimpp(:,:) = iimppt(:,:) 
    351       nfilcit(:,:) = ilci(:,:) 
     349      nfijpit(:,:) = ijpi(:,:) 
    352350      ! 
    353351      IF(lwp) THEN 
    … …  
    359357         WRITE(numout,*) '      jpnj = ', jpnj 
    360358         WRITE(numout,*) 
    361          WRITE(numout,*) '      sum ilci(i,1) = ', sum(ilci(:,1)), ' jpiglo = ', jpiglo 
    362          WRITE(numout,*) '      sum ilcj(1,j) = ', sum(ilcj(1,:)), ' jpjglo = ', jpjglo 
     359         WRITE(numout,*) '      sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo 
     360         WRITE(numout,*) '      sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo 
    363361      ENDIF 
    364362      
    … …  
    375373         ii = 1 + MOD(iarea0,jpni) 
    376374         ij = 1 +     iarea0/jpni 
    377          ili = ilci(ii,ij) 
    378          ilj = ilcj(ii,ij) 
     375         ili = ijpi(ii,ij) 
     376         ilj = ijpj(ii,ij) 
    379377         ibondi(ii,ij) = 0                         ! default: has e-w neighbours 
    380378         IF( ii   ==    1 )   ibondi(ii,ij) = -1   ! first column, has only e neighbour 
    … …  
    391389         ioea(ii,ij) = iarea0 + 1 
    392390         iono(ii,ij) = iarea0 + jpni 
    393          ildi(ii,ij) =  1  + nn_hls 
    394          ilei(ii,ij) = ili - nn_hls 
    395          ildj(ii,ij) =  1  + nn_hls 
    396          ilej(ii,ij) = ilj - nn_hls 
     391         iis0(ii,ij) =  1  + nn_hls 
     392         iie0(ii,ij) = ili - nn_hls 
     393         ijs0(ii,ij) =  1  + nn_hls 
     394         ije0(ii,ij) = ilj - nn_hls 
    397395 
    398396         ! East-West periodicity: change ibondi, ioea, iowe 
    … …  
    500498         ENDIF 
    501499      END DO 
    502  
    503       ! Update il[de][ij] according to modified ibond[ij] 
    504       ! ---------------------- 
    505       DO jproc = 1, jpnij 
    506          ii = iin(jproc) 
    507          ij = ijn(jproc) 
    508          IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1 
    509          IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij) 
    510          IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1 
    511          IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij) 
    512       END DO 
    513500       
    514501      ! 5. Subdomain print 
    … …  
    523510            DO jj = jpnj, 1, -1 
    524511               WRITE(numout,9403) ('   ',ji=il1,il2-1) 
    525                WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2) 
     512               WRITE(numout,9402) jj, (ijpi(ji,jj),ijpj(ji,jj),ji=il1,il2) 
    526513               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2) 
    527514               WRITE(numout,9403) ('   ',ji=il1,il2-1) 
    … …  
    580567      noea = ii_noea(narea) 
    581568      nono = ii_nono(narea) 
    582       nlci = ilci(ii,ij)   
    583       nldi = ildi(ii,ij) 
    584       nlei = ilei(ii,ij) 
    585       nlcj = ilcj(ii,ij)   
    586       nldj = ildj(ii,ij) 
    587       nlej = ilej(ii,ij) 
     569      jpi    = ijpi(ii,ij)   
     570!!$      Nis0  = iis0(ii,ij) 
     571!!$      Nie0  = iie0(ii,ij) 
     572      jpj    = ijpj(ii,ij)   
     573!!$      Njs0  = ijs0(ii,ij) 
     574!!$      Nje0  = ije0(ii,ij) 
    588575      nbondi = ibondi(ii,ij) 
    589576      nbondj = ibondj(ii,ij) 
    590577      nimpp = iimppt(ii,ij)   
    591578      njmpp = ijmppt(ii,ij) 
    592       jpi = nlci 
    593       jpj = nlcj 
    594579      jpk = jpkglo                              ! third dim 
    595580#if defined key_agrif 
    … …  
    609594         ii = iin(jproc) 
    610595         ij = ijn(jproc) 
    611          nlcit(jproc) = ilci(ii,ij) 
    612          nldit(jproc) = ildi(ii,ij) 
    613          nleit(jproc) = ilei(ii,ij) 
    614          nlcjt(jproc) = ilcj(ii,ij) 
    615          nldjt(jproc) = ildj(ii,ij) 
    616          nlejt(jproc) = ilej(ii,ij) 
     596         jpiall (jproc) = ijpi(ii,ij) 
     597         nis0all(jproc) = iis0(ii,ij) 
     598         nie0all(jproc) = iie0(ii,ij) 
     599         jpjall (jproc) = ijpj(ii,ij) 
     600         njs0all(jproc) = ijs0(ii,ij) 
     601         nje0all(jproc) = ije0(ii,ij) 
    617602         ibonit(jproc) = ibondi(ii,ij) 
    618603         ibonjt(jproc) = ibondj(ii,ij) 
    … …  
    628613         WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,& 
    629614   &           ' ( local: ',narea,jpi,jpj,' )' 
    630          WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 
     615         WRITE(inum,'(a)') 'nproc jpi jpj Nis0 Njs0 Nie0 Nje0 nimp njmp nono noso nowe noea nbondi nbondj ' 
    631616 
    632617         DO jproc = 1, jpnij 
    633             WRITE(inum,'(13i5,2i7)')   jproc-1, nlcit  (jproc), nlcjt  (jproc),   & 
    634                &                                nldit  (jproc), nldjt  (jproc),   & 
    635                &                                nleit  (jproc), nlejt  (jproc),   & 
     618            WRITE(inum,'(13i5,2i7)')   jproc-1,  jpiall(jproc),  jpjall(jproc),   & 
     619               &                                nis0all(jproc), njs0all(jproc),   & 
     620               &                                nie0all(jproc), nje0all(jproc),   & 
    636621               &                                nimppt (jproc), njmppt (jproc),   &  
    637622               &                                ii_nono(jproc), ii_noso(jproc),   & 
    … …  
    667652         WRITE(numout,*) '    l_Iperio = ', l_Iperio 
    668653         WRITE(numout,*) '    l_Jperio = ', l_Jperio 
    669          WRITE(numout,*) '      nlci   = ', nlci 
    670          WRITE(numout,*) '      nlcj   = ', nlcj 
    671654         WRITE(numout,*) '      nimpp  = ', nimpp 
    672655         WRITE(numout,*) '      njmpp  = ', njmpp 
    673          WRITE(numout,*) '      nreci  = ', nreci   
    674          WRITE(numout,*) '      nrecj  = ', nrecj   
    675656         WRITE(numout,*) '      nn_hls = ', nn_hls  
    676657      ENDIF 
    … …  
    712693      DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    & 
    713694         &       iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj,   & 
    714          &       ilci, ilcj, ilei, ilej, ildi, ildj,              & 
     695         &       ijpi, ijpj, iie0, ije0, iis0, ijs0,              & 
    715696         &       iono, ioea, ioso, iowe, llisoce) 
    716697      ! 
    … …  
    718699 
    719700 
    720     SUBROUTINE mpp_basic_decomposition( knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
    721       !!---------------------------------------------------------------------- 
    722       !!                  ***  ROUTINE mpp_basic_decomposition  *** 
     701    SUBROUTINE basic_decomposition( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
     702      !!---------------------------------------------------------------------- 
     703      !!                  ***  ROUTINE basic_decomposition  *** 
    723704      !!                     
    724705      !! ** Purpose :   Lay out the global domain over processors. 
    … …  
    732713      !!                    klcj       : second dimension 
    733714      !!---------------------------------------------------------------------- 
     715      INTEGER,                                 INTENT(in   ) ::   kiglo, kjglo 
     716      INTEGER,                                 INTENT(in   ) ::   khls 
    734717      INTEGER,                                 INTENT(in   ) ::   knbi, knbj 
    735718      INTEGER,                                 INTENT(  out) ::   kimax, kjmax 
    … …  
    738721      ! 
    739722      INTEGER ::   ji, jj 
     723      INTEGER ::   i2hls  
    740724      INTEGER ::   iresti, irestj, irm, ijpjmin 
    741       INTEGER ::   ireci, irecj 
    742       !!---------------------------------------------------------------------- 
     725      !!---------------------------------------------------------------------- 
     726      i2hls = 2*khls 
    743727      ! 
    744728#if defined key_nemocice_decomp 
    745       kimax = ( nx_global+2-2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim. 
    746       kjmax = ( ny_global+2-2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim.  
     729      kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
     730      kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim.  
    747731#else 
    748       kimax = ( jpiglo - 2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim. 
    749       kjmax = ( jpjglo - 2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim. 
     732      kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
     733      kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls    ! second dim. 
    750734#endif 
    751735      IF( .NOT. PRESENT(kimppt) ) RETURN 
    … …  
    754738      ! ----------------------------------- 
    755739      !  Computation of local domain sizes klci() klcj() 
    756       !  These dimensions depend on global sizes knbi,knbj and jpiglo,jpjglo 
     740      !  These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 
    757741      !  The subdomains are squares lesser than or equal to the global 
    758742      !  dimensions divided by the number of processors minus the overlap array. 
    759743      ! 
    760       ireci = 2 * nn_hls 
    761       irecj = 2 * nn_hls 
    762       iresti = 1 + MOD( jpiglo - ireci -1 , knbi ) 
    763       irestj = 1 + MOD( jpjglo - irecj -1 , knbj ) 
     744      iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 
     745      irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 
    764746      ! 
    765747      !  Need to use kimax and kjmax here since jpi and jpj not yet defined 
    766748#if defined key_nemocice_decomp 
    767749      ! Change padding to be consistent with CICE 
    768       klci(1:knbi-1      ,:) = kimax 
    769       klci(knbi          ,:) = jpiglo - (knbi - 1) * (kimax - nreci) 
    770       klcj(:,      1:knbj-1) = kjmax 
    771       klcj(:,          knbj) = jpjglo - (knbj - 1) * (kjmax - nrecj) 
     750      klci(1:knbi-1,:       ) = kimax 
     751      klci(  knbi  ,:       ) = kiglo - (knbi - 1) * (kimax - i2hls) 
     752      klcj(:       ,1:knbj-1) = kjmax 
     753      klcj(:       ,  knbj  ) = kjglo - (knbj - 1) * (kjmax - i2hls) 
    772754#else 
    773755      klci(1:iresti      ,:) = kimax 
    774756      klci(iresti+1:knbi ,:) = kimax-1 
    775       IF( MINVAL(klci) < 3 ) THEN 
    776          WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpi must be >= 3' 
     757      IF( MINVAL(klci) < 2*i2hls ) THEN 
     758         WRITE(ctmp1,*) '   basic_decomposition: minimum value of jpi must be >= ', 2*i2hls 
    777759         WRITE(ctmp2,*) '   We have ', MINVAL(klci) 
    778760        CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    … …  
    780762      IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 
    781763         ! minimize the size of the last row to compensate for the north pole folding coast 
    782          IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 5   ! V and F folding involves line jpj-3 that must not be south boundary 
    783          IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 4   ! V and F folding involves line jpj-2 that must not be south boundary 
    784          irm = knbj - irestj                                    ! total number of lines to be removed 
    785          klcj(:,            knbj) = MAX( ijpjmin, kjmax-irm )   ! we must have jpj >= ijpjmin in the last row 
    786          irm = irm - ( kjmax - klcj(1,knbj) )                   ! remaining number of lines to remove  
    787          irestj = knbj - 1 - irm                         
    788          klcj(:,        1:irestj) = kjmax 
     764         IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 2+3*khls   ! V and F folding must be outside of southern halos 
     765         IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 1+3*khls   ! V and F folding must be outside of southern halos 
     766         irm = knbj - irestj                                       ! total number of lines to be removed 
     767         klcj(:,knbj) = MAX( ijpjmin, kjmax-irm )                  ! we must have jpj >= ijpjmin in the last row 
     768         irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove  
     769         irestj = knbj - 1 - irm 
    789770         klcj(:, irestj+1:knbj-1) = kjmax-1 
    790771      ELSE 
    791          ijpjmin = 3 
    792          klcj(:,      1:irestj) = kjmax 
    793          klcj(:, irestj+1:knbj) = kjmax-1 
    794       ENDIF 
    795       IF( MINVAL(klcj) < ijpjmin ) THEN 
    796          WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpj must be >= ', ijpjmin 
     772         klcj(:, irestj+1:knbj  ) = kjmax-1 
     773      ENDIF 
     774      klcj(:,1:irestj) = kjmax 
     775      IF( MINVAL(klcj) < 2*i2hls ) THEN 
     776         WRITE(ctmp1,*) '   basic_decomposition: minimum value of jpj must be >= ', 2*i2hls 
    797777         WRITE(ctmp2,*) '   We have ', MINVAL(klcj) 
    798778         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    … …  
    808788         DO jj = 1, knbj 
    809789            DO ji = 2, knbi 
    810                kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - ireci 
     790               kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - 2 * nn_hls 
    811791            END DO 
    812792         END DO 
    … …  
    816796         DO jj = 2, knbj 
    817797            DO ji = 1, knbi 
    818                kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - irecj 
     798               kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - 2 * nn_hls 
    819799            END DO 
    820800         END DO 
    821801      ENDIF 
    822802       
    823    END SUBROUTINE mpp_basic_decomposition 
    824  
    825  
    826    SUBROUTINE mpp_init_bestpartition( knbij, knbi, knbj, knbcnt, ldlist ) 
    827       !!---------------------------------------------------------------------- 
    828       !!                 ***  ROUTINE mpp_init_bestpartition  *** 
     803   END SUBROUTINE basic_decomposition 
     804 
     805 
     806   SUBROUTINE bestpartition( knbij, knbi, knbj, knbcnt, ldlist ) 
     807      !!---------------------------------------------------------------------- 
     808      !!                 ***  ROUTINE bestpartition  *** 
    829809      !! 
    830810      !! ** Purpose : 
    … …  
    877857         iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim. 
    878858#else 
    879          iszitst = ( jpiglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls 
     859         iszitst = ( Ni0glo + (ji-1) ) / ji + 2*nn_hls 
    880860#endif 
    881861         IF( iszitst < isziref ) THEN 
    … …  
    888868         iszjtst = ( ny_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim. 
    889869#else 
    890          iszjtst = ( jpjglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls 
     870         iszjtst = ( Nj0glo + (ji-1) ) / ji + 2*nn_hls 
    891871#endif 
    892872         IF( iszjtst < iszjref ) THEN 
    … …  
    976956         ji = isz0   ! initialization with the largest value 
    977957         ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 
    978          CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
     958         CALL is_ocean( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
    979959         inbijold = COUNT(llisoce) 
    980960         DEALLOCATE( llisoce ) 
    981961         DO ji =isz0-1,1,-1 
    982962            ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 
    983             CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
     963            CALL is_ocean( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
    984964            inbij = COUNT(llisoce) 
    985965            DEALLOCATE( llisoce ) 
    … …  
    1007987         ii = ii -1  
    1008988         ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 
    1009          CALL mpp_init_isoce( inbi0(ii), inbj0(ii), llisoce )            ! must be done by all core 
     989         CALL is_ocean( inbi0(ii), inbj0(ii), llisoce )            ! must be done by all core 
    1010990         inbij = COUNT(llisoce) 
    1011991         DEALLOCATE( llisoce ) 
    … …  
    1016996      DEALLOCATE( inbi0, inbj0 ) 
    1017997      ! 
    1018    END SUBROUTINE mpp_init_bestpartition 
     998   END SUBROUTINE bestpartition 
    1019999    
    10201000    
    … …  
    10251005      !! ** Purpose : the the proportion of land points in the surface land-sea mask 
    10261006      !! 
    1027       !! ** Method  : read iproc strips (of length jpiglo) of the land-sea mask 
     1007      !! ** Method  : read iproc strips (of length Ni0glo) of the land-sea mask 
    10281008      !!---------------------------------------------------------------------- 
    10291009      REAL(wp), INTENT(  out) :: propland    ! proportion of land points in the global domain (between 0 and 1) 
    … …  
    10421022 
    10431023      ! number of processes reading the bathymetry file  
    1044       iproc = MINVAL( (/mppsize, jpjglo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time 
     1024      iproc = MINVAL( (/mppsize, Nj0glo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time 
    10451025       
    10461026      ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1 
    … …  
    10521032      IF( MOD( narea-1, idiv ) == 0 .AND. iarea < iproc ) THEN   ! beware idiv can be = to 1 
    10531033         ! 
    1054          ijsz = jpjglo / iproc                                               ! width of the stripe to read 
    1055          IF( iarea < MOD(jpjglo,iproc) ) ijsz = ijsz + 1 
    1056          ijstr = iarea*(jpjglo/iproc) + MIN(iarea, MOD(jpjglo,iproc)) + 1    ! starting j position of the reading 
    1057          ! 
    1058          ALLOCATE( lloce(jpiglo, ijsz) )                                     ! allocate the strip 
    1059          CALL mpp_init_readbot_strip( ijstr, ijsz, lloce ) 
     1034         ijsz = Nj0glo / iproc                                               ! width of the stripe to read 
     1035         IF( iarea < MOD(Nj0glo,iproc) ) ijsz = ijsz + 1 
     1036         ijstr = iarea*(Nj0glo/iproc) + MIN(iarea, MOD(Nj0glo,iproc)) + 1    ! starting j position of the reading 
     1037         ! 
     1038         ALLOCATE( lloce(Ni0glo, ijsz) )                                     ! allocate the strip 
     1039         CALL readbot_strip( ijstr, ijsz, lloce ) 
    10601040         inboce = COUNT(lloce)                                               ! number of ocean point in the stripe 
    10611041         DEALLOCATE(lloce) 
    … …  
    10661046      CALL mpp_sum( 'mppini', inboce )   ! total number of ocean points over the global domain 
    10671047      ! 
    1068       propland = REAL( jpiglo*jpjglo - inboce, wp ) / REAL( jpiglo*jpjglo, wp )  
     1048      propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp )  
    10691049      ! 
    10701050   END SUBROUTINE mpp_init_landprop 
    10711051    
    10721052    
    1073    SUBROUTINE mpp_init_isoce( knbi, knbj, ldisoce ) 
     1053   SUBROUTINE is_ocean( knbi, knbj, ldisoce ) 
    10741054      !!---------------------------------------------------------------------- 
    10751055      !!                  ***  ROUTINE mpp_init_nboce  *** 
    … …  
    10781058      !!              subdomains contain at least 1 ocean point 
    10791059      !! 
    1080       !! ** Method  : read knbj strips (of length jpiglo) of the land-sea mask 
     1060      !! ** Method  : read knbj strips (of length Ni0glo) of the land-sea mask 
    10811061      !!---------------------------------------------------------------------- 
    10821062      INTEGER,                       INTENT(in   ) ::   knbi, knbj     ! domain decomposition 
    … …  
    10881068      INTEGER :: ji, jn 
    10891069      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce                  ! lloce(i,j) = .true. if the point (i,j) is ocean  
    1090       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci 
    1091       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj 
     1070      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi 
     1071      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj 
    10921072      !!---------------------------------------------------------------------- 
    10931073      ! do nothing if there is no land-sea mask 
    … …  
    11091089         IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN   ! beware idiv can be = to 1 
    11101090            ! 
    1111             ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ilci(knbi,knbj), ilcj(knbi,knbj) ) 
    1112             CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj ) 
     1091            ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ijpi(knbi,knbj), ijpj(knbi,knbj) ) 
     1092            CALL basic_decomposition( Ni0glo, Nj0glo, 0, knbi, knbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 
    11131093            ! 
    1114             ALLOCATE( lloce(jpiglo, ilcj(1,iarea+1)) )                                         ! allocate the strip 
    1115             CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce )           ! read the strip 
     1094            ALLOCATE( lloce(Ni0glo, ijpj(1,iarea+1)) )                       ! allocate the strip 
     1095            CALL readbot_strip( ijmppt(1,iarea+1), ijpj(1,iarea+1), lloce )           ! read the strip 
    11161096            DO  ji = 1, knbi 
    1117                inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ilci(ji,1)-1,:) )   ! number of ocean point in subdomain 
     1097               inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)-1,:) )   ! number of ocean point in subdomain 
    11181098            END DO 
    11191099            ! 
    11201100            DEALLOCATE(lloce) 
    1121             DEALLOCATE(iimppt, ijmppt, ilci, ilcj) 
     1101            DEALLOCATE(iimppt, ijmppt, ijpi, ijpj) 
    11221102            ! 
    11231103         ENDIF 
    … …  
    11291109      ldisoce(:,:) = inboce(:,:) /= 0 
    11301110      ! 
    1131    END SUBROUTINE mpp_init_isoce 
     1111   END SUBROUTINE is_ocean 
    11321112    
    11331113    
    1134    SUBROUTINE mpp_init_readbot_strip( kjstr, kjcnt, ldoce ) 
    1135       !!---------------------------------------------------------------------- 
    1136       !!                  ***  ROUTINE mpp_init_readbot_strip  *** 
     1114   SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 
     1115      !!---------------------------------------------------------------------- 
     1116      !!                  ***  ROUTINE readbot_strip  *** 
    11371117      !! 
    11381118      !! ** Purpose : Read relevant bathymetric information in order to 
    … …  
    11401120      !!              of land domains, in an mpp computation. 
    11411121      !! 
    1142       !! ** Method  : read stipe of size (jpiglo,...) 
     1122      !! ** Method  : read stipe of size (Ni0glo,...) 
    11431123      !!---------------------------------------------------------------------- 
    11441124      INTEGER                         , INTENT(in   ) :: kjstr       ! starting j position of the reading 
    11451125      INTEGER                         , INTENT(in   ) :: kjcnt       ! number of lines to read 
    1146       LOGICAL, DIMENSION(jpiglo,kjcnt), INTENT(  out) :: ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
     1126      LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) :: ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
    11471127      ! 
    11481128      INTEGER                           ::   inumsave                ! local logical unit 
    1149       REAL(wp), DIMENSION(jpiglo,kjcnt) ::   zbot, zbdy  
     1129      REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy  
    11501130      !!---------------------------------------------------------------------- 
    11511131      ! 
    11521132      inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null 
    11531133      ! 
    1154       IF( numbot /= -1 ) THEN 
    1155          CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) ) 
     1134      IF( numbot /= -1 ) THEN    
     1135         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    11561136      ELSE 
    1157          zbot(:,:) = 1.                         ! put a non-null value 
    1158       ENDIF 
    1159  
    1160        IF( numbdy /= -1 ) THEN                  ! Adjust with bdy_msk if it exists     
    1161          CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) ) 
     1137         zbot(:,:) = 1._wp                      ! put a non-null value 
     1138      ENDIF 
     1139      ! 
     1140      IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists     
     1141         CALL iom_get ( numbdy, jpdom_unknown,     'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    11621142         zbot(:,:) = zbot(:,:) * zbdy(:,:) 
    11631143      ENDIF 
    11641144      ! 
    1165       ldoce(:,:) = zbot(:,:) > 0. 
     1145      ldoce(:,:) = zbot(:,:) > 0._wp 
    11661146      numout = inumsave 
    11671147      ! 
    1168    END SUBROUTINE mpp_init_readbot_strip 
     1148   END SUBROUTINE readbot_strip 
    11691149 
    11701150 
    … …  
    11901170      iglo(1) = jpiglo 
    11911171      iglo(2) = jpjglo 
    1192       iloc(1) = nlci 
    1193       iloc(2) = nlcj 
     1172      iloc(1) = jpi 
     1173      iloc(2) = jpj 
    11941174      iabsf(1) = nimppt(narea) 
    11951175      iabsf(2) = njmppt(narea) 
    11961176      iabsl(:) = iabsf(:) + iloc(:) - 1 
    1197       ihals(1) = nldi - 1 
    1198       ihals(2) = nldj - 1 
    1199       ihale(1) = nlci - nlei 
    1200       ihale(2) = nlcj - nlej 
     1177      ihals(1) = Nis0 - 1 
     1178      ihals(2) = Njs0 - 1 
     1179      ihale(1) = jpi - Nie0 
     1180      ihale(2) = jpj - Nje0 
    12011181      idid(1) = 1 
    12021182      idid(2) = 2 
    … …  
    12391219         ! 
    12401220         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
    1241          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
     1221         sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 
    12421222         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
    12431223         dxM = jpiglo - nimppt(narea) + 2 
    … …  
    12491229            ! 
    12501230            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process 
    1251             dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process 
     1231            dxT = nfiimpp(jn, jpnj) + nfijpit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process 
    12521232            ! 
    12531233            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
    … …  
    12811261      IF(     nn_hls == 1 ) THEN          !* halo size of 1 
    12821262         ! 
    1283          nIs_0 =   2     ;   nIs_1 =   1     ;   nIs_1nxt2 = nIs_0   ;   nIs_2 = nIs_1 
    1284          nJs_0 =   2     ;   nJs_1 =   1     ;   nJs_1nxt2 = nJs_0   ;   nJs_2 = nJs_1 
     1263         Nis0 =   2     ;   Nis1 =   1     ;   Nis1nxt2 = Nis0   ;   Nis2 = Nis1 
     1264         Njs0 =   2     ;   Njs1 =   1     ;   Njs1nxt2 = Njs0   ;   Njs2 = Njs1 
    12851265         !                                    
    1286          nIe_0 = jpi-1   ;   nIe_1 = jpi     ;   nIe_1nxt2 = nIe_0   ;   nIe_2 = nIe_1 
    1287          nJe_0 = jpj-1   ;   nJe_1 = jpj     ;   nJe_1nxt2 = nJe_0   ;   nJe_2 = nJe_1 
     1266         Nie0 = jpi-1   ;   Nie1 = jpi     ;   Nie1nxt2 = Nie0   ;   Nie2 = Nie1 
     1267         Nje0 = jpj-1   ;   Nje1 = jpj     ;   Nje1nxt2 = Nje0   ;   Nje2 = Nje1 
    12881268         ! 
    12891269      ELSEIF( nn_hls == 2 ) THEN          !* halo size of 2 
    12901270         ! 
    1291          nIs_0 =   3     ;   nIs_1 =   2     ;   nIs_1nxt2 = nIs_1   ;   nIs_2 =   1 
    1292          nJs_0 =   3     ;   nJs_1 =   2     ;   nJs_1nxt2 = nJs_1   ;   nJs_2 =   1 
     1271         Nis0 =   3     ;   Nis1 =   2     ;   Nis1nxt2 = Nis1   ;   Nis2 =   1 
     1272         Njs0 =   3     ;   Njs1 =   2     ;   Njs1nxt2 = Njs1   ;   Njs2 =   1 
    12931273         !                                                               
    1294          nIe_0 = jpi-2   ;   nIe_1 = jpi-1   ;   nIe_1nxt2 = nIe_1   ;   nIe_2 = jpi 
    1295          nJe_0 = jpj-2   ;   nJe_1 = jpj-1   ;   nJe_1nxt2 = nJe_1   ;   nJe_2 = jpj 
     1274         Nie0 = jpi-2   ;   Nie1 = jpi-1   ;   Nie1nxt2 = Nie1   ;   Nie2 = jpi 
     1275         Nje0 = jpj-2   ;   Nje1 = jpj-1   ;   Nje1nxt2 = Nje1   ;   Nje2 = jpj 
    12961276         ! 
    12971277      ELSE                                !* unexpected halo size 
    12981278         CALL ctl_stop( 'STOP', 'ini_mpp:  wrong value of halo size : nn_hls= 1 or 2 only !') 
    12991279      ENDIF 
     1280      ! 
     1281      Ni_0 = Nie0 - Nis0 + 1 
     1282      Nj_0 = Nje0 - Njs0 + 1 
     1283      Ni_1 = Nie1 - Nis1 + 1 
     1284      Nj_1 = Nje1 - Njs1 + 1 
     1285      Ni_2 = Nie2 - Nis2 + 1 
     1286      Nj_2 = Nje2 - Njs2 + 1 
    13001287      ! 
    13011288   END SUBROUTINE init_doloop 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/OBS/find_obs_proc.h90

    r10068 r12807  
    4141      ! first and last indoor i- and j-indexes      kldi, klei,   kldj, klej 
    4242      ! exclude any obs in the bottom-left overlap region 
    43       ! also any obs outside to whole region (defined by nlci and nlcj) 
     43      ! also any obs outside to whole region (defined by jpi and jpj) 
    4444      ! I am assuming that kobsp does not need to be the correct processor  
    4545      ! number 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/OBS/mpp_map.F90

    r10068 r12807  
    1212   USE par_kind, ONLY :   wp            ! Precision variables 
    1313   USE par_oce , ONLY :   jpi, jpj      ! Ocean parameters 
    14    USE dom_oce , ONLY :   mig, mjg, nldi, nlei, nldj, nlej, nlci, nlcj, narea   ! Ocean space and time domain variables 
     14   USE dom_oce , ONLY :   mig, mjg, Nis0, Nie0, Njs0, Nje0, jpi, jpj, narea   ! Ocean space and time domain variables 
    1515#if defined key_mpp_mpi 
    1616   USE lib_mpp, ONLY :   mpi_comm_oce   ! MPP library 
    … …  
    6565 
    6666!      ! Setup local grid points 
    67       imppmap(mig(1):mig(nlci),mjg(1):mjg(nlcj)) = narea 
     67      imppmap(mig(1):mig(jpi),mjg(1):mjg(jpj)) = narea 
    6868       
    6969      ! Get global data 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/OBS/obs_grid.F90

    r10068 r12807  
    129129            IF ( cdgrid == 'T' ) THEN 
    130130               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    131                   &                             1, nlci, 1, nlcj,         & 
     131                  &                             1, jpi, 1, jpj,           & 
    132132                  &                             nproc, jpnij,             & 
    133133                  &                             glamt, gphit, tmask,      & 
    … …  
    136136            ELSEIF ( cdgrid == 'U' ) THEN 
    137137               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    138                   &                             1, nlci, 1, nlcj,         & 
     138                  &                             1, jpi, 1, jpj,           & 
    139139                  &                             nproc, jpnij,             & 
    140140                  &                             glamu, gphiu, umask,      & 
    … …  
    143143            ELSEIF ( cdgrid == 'V' ) THEN 
    144144               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    145                   &                             1, nlci, 1, nlcj,         & 
     145                  &                             1, jpi, 1, jpj,           & 
    146146                  &                             nproc, jpnij,             & 
    147147                  &                             glamv, gphiv, vmask,      & 
    … …  
    150150            ELSEIF ( cdgrid == 'F' ) THEN 
    151151               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    152                   &                             1, nlci, 1, nlcj,         & 
     152                  &                             1, jpi, 1, jpj,           & 
    153153                  &                             nproc, jpnij,             & 
    154154                  &                             glamf, gphif, fmask,      & 
    … …  
    279279         zmskg(:,:) = -1.e+10 
    280280         ! Add various grids here. 
    281          DO jj = 1, nlcj 
    282             DO ji = 1, nlci 
     281         DO jj = 1, jpj 
     282            DO ji = 1, jpi 
    283283               zlamg(mig(ji),mjg(jj)) = glamt(ji,jj) 
    284284               zphig(mig(ji),mjg(jj)) = gphit(ji,jj) 
    … …  
    816816             
    817817            CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,  & 
    818                &                     1, nlci, 1, nlcj,          & 
     818               &                     1, jpi, 1, jpj,            & 
    819819               &                     nproc, jpnij,              & 
    820820               &                     glamt, gphit, tmask,       & 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/cpl_oasis3.F90

    r12527 r12807  
    7070   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    7171   LOGICAL, PARAMETER         ::   ltmp_wapatch = .TRUE.   ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define   
    72    INTEGER                    ::   nldi_save, nlei_save 
    73    INTEGER                    ::   nldj_save, nlej_save 
     72   INTEGER                    ::   Nis0_save, Nie0_save 
     73   INTEGER                    ::   Njs0_save, Nje0_save 
    7474    
    7575   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
    … …  
    150150      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    151151      IF( ltmp_wapatch ) THEN 
    152          nldi_save = nldi   ;   nlei_save = nlei 
    153          nldj_save = nldj   ;   nlej_save = nlej 
    154          IF( nimpp           ==      1 ) nldi = 1 
    155          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    156          IF( njmpp           ==      1 ) nldj = 1 
    157          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
     152         Nis0_save = Nis0   ;   Nie0_save = Nie0 
     153         Njs0_save = Njs0   ;   Nje0_save = Nje0 
     154         IF( nimpp           ==      1 ) Nis0 = 1 
     155         IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 
     156         IF( njmpp           ==      1 ) Njs0 = 1 
     157         IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 
    158158      ENDIF  
    159159      IF(lwp) WRITE(numout,*) 
    … …  
    182182      ! 
    183183      ishape(1) = 1 
    184       ishape(2) = nlei-nldi+1 
     184      ishape(2) = Ni_0 
    185185      ishape(3) = 1 
    186       ishape(4) = nlej-nldj+1 
     186      ishape(4) = Nj_0 
    187187      ! 
    188188      ! ... Allocate memory for data exchange 
    189189      ! 
    190       ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
     190      ALLOCATE(exfld(Ni_0, Nj_0), stat = nerror) 
    191191      IF( nerror > 0 ) THEN 
    192192         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    … …  
    198198       
    199199      paral(1) = 2                                              ! box partitioning 
    200       paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset     
    201       paral(3) = nlei-nldi+1                                    ! local extent in i  
    202       paral(4) = nlej-nldj+1                                    ! local extent in j 
     200      paral(2) = jpiglo * (Njs0-1+njmpp-1) + (Nis0-1+nimpp-1)   ! NEMO lower left corner global offset     
     201      paral(3) = Ni_0                                           ! local extent in i  
     202      paral(4) = Nj_0                                           ! local extent in j 
    203203      paral(5) = jpiglo                                         ! global extent in x 
    204204       
    … …  
    206206         WRITE(numout,*) ' multiexchg: paral (1:5)', paral 
    207207         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj 
    208          WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp 
    209          WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp 
     208         WRITE(numout,*) ' multiexchg: Nis0, Nie0, nimpp =', Nis0, Nie0, nimpp 
     209         WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 
    210210      ENDIF 
    211211    
    … …  
    317317      ! 
    318318      IF( ltmp_wapatch ) THEN 
    319          nldi = nldi_save   ;   nlei = nlei_save 
    320          nldj = nldj_save   ;   nlej = nlej_save 
     319         Nis0 = Nis0_save   ;   Nie0 = Nie0_save 
     320         Njs0 = Njs0_save   ;   Nje0 = Nje0_save 
    321321      ENDIF 
    322322   END SUBROUTINE cpl_define 
    … …  
    339339      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    340340      IF( ltmp_wapatch ) THEN 
    341          nldi_save = nldi   ;   nlei_save = nlei 
    342          nldj_save = nldj   ;   nlej_save = nlej 
    343          IF( nimpp           ==      1 ) nldi = 1 
    344          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    345          IF( njmpp           ==      1 ) nldj = 1 
    346          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
     341         Nis0_save = Nis0   ;   Nie0_save = Nie0 
     342         Njs0_save = Njs0   ;   Nje0_save = Nje0 
     343         IF( nimpp           ==      1 ) Nis0 = 1 
     344         IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 
     345         IF( njmpp           ==      1 ) Njs0 = 1 
     346         IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 
    347347      ENDIF 
    348348      ! 
    … …  
    353353         
    354354            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 
    355                CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     355               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 
    356356                
    357357               IF ( sn_cfctl%l_oasout ) THEN         
    … …  
    363363                     WRITE(numout,*) 'oasis_put:  kstep ', kstep 
    364364                     WRITE(numout,*) 'oasis_put:   info ', kinfo 
    365                      WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    366                      WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    367                      WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(nldi:nlei,nldj:nlej,jc)) 
     365                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     366                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     367                     WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
    368368                     WRITE(numout,*) '****************' 
    369369                  ENDIF 
    … …  
    375375      ENDDO 
    376376      IF( ltmp_wapatch ) THEN 
    377          nldi = nldi_save   ;   nlei = nlei_save 
    378          nldj = nldj_save   ;   nlej = nlej_save 
     377         Nis0 = Nis0_save   ;   Nie0 = Nie0_save 
     378         Njs0 = Njs0_save   ;   Nje0 = Nje0_save 
    379379      ENDIF 
    380380      ! 
    … …  
    400400      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    401401      IF( ltmp_wapatch ) THEN 
    402          nldi_save = nldi   ;   nlei_save = nlei 
    403          nldj_save = nldj   ;   nlej_save = nlej 
     402         Nis0_save = Nis0   ;   Nie0_save = Nie0 
     403         Njs0_save = Njs0   ;   Nje0_save = Nje0 
    404404      ENDIF 
    405405      ! 
    … …  
    410410      DO jc = 1, srcv(kid)%nct 
    411411         IF( ltmp_wapatch ) THEN 
    412             IF( nimpp           ==      1 ) nldi = 1 
    413             IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    414             IF( njmpp           ==      1 ) nldj = 1 
    415             IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
     412            IF( nimpp           ==      1 ) Nis0 = 1 
     413            IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 
     414            IF( njmpp           ==      1 ) Njs0 = 1 
     415            IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 
    416416         ENDIF 
    417417         llfisrt = .TRUE. 
    … …  
    432432                  kinfo = OASIS_Rcv 
    433433                  IF( llfisrt ) THEN  
    434                      pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     434                     pdata(Nis0:Nie0,Njs0:Nje0,jc) =   exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    435435                     llfisrt = .FALSE. 
    436436                  ELSE 
    437                      pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     437                     pdata(Nis0:Nie0,Njs0:Nje0,jc) = pdata(Nis0:Nie0,Njs0:Nje0,jc)   & 
     438                        &                                + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    438439                  ENDIF 
    439440                   
    … …  
    444445                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
    445446                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
    446                      WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    447                      WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    448                      WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(nldi:nlei,nldj:nlej,jc)) 
     447                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     448                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     449                     WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
    449450                     WRITE(numout,*) '****************' 
    450451                  ENDIF 
    … …  
    457458 
    458459         IF( ltmp_wapatch ) THEN 
    459             nldi = nldi_save   ;   nlei = nlei_save 
    460             nldj = nldj_save   ;   nlej = nlej_save 
     460            Nis0 = Nis0_save   ;   Nie0 = Nie0_save 
     461            Njs0 = Njs0_save   ;   Nje0 = Nje0_save 
    461462         ENDIF 
    462463         !--- Fill the overlap areas and extra hallows (mpp) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbccpl.F90

    r12489 r12807  
    10361036         xcplmask(:,:,:) = 0. 
    10371037         CALL iom_open( 'cplmask', inum ) 
    1038          CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   & 
    1039             &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 
     1038         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel),   & 
     1039            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) ) 
    10401040         CALL iom_close( inum ) 
    10411041      ELSE 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcice_cice.F90

    r12489 r12807  
    872872!        pcg(:,:)=0.0 
    873873         DO jn=1,jpnij 
    874             DO jj=nldjt(jn),nlejt(jn) 
    875                DO ji=nldit(jn),nleit(jn) 
     874            DO jj=njs0all(jn),nje0all(jn) 
     875               DO ji=nis0all(jn),nie0all(jn) 
    876876                  png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 
    877877               ENDDO 
    … …  
    993993         png(:,:,:)=0.0 
    994994         DO jn=1,jpnij 
    995             DO jj=nldjt(jn),nlejt(jn) 
    996                DO ji=nldit(jn),nleit(jn) 
     995            DO jj=njs0all(jn),nje0all(jn) 
     996               DO ji=nis0all(jn),nie0all(jn) 
    997997                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 
    998998               ENDDO 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcwave.F90

    r12377 r12807  
    212212#if defined key_agrif 
    213213      IF( .NOT. Agrif_Root() ) THEN 
    214          IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
    215          IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
    216          IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
    217          IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
     214         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:      ,:) = 0._wp      ! west 
     215         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( jpi-nbghostcells:jpi-1,:,:) = 0._wp      ! east 
     216         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1      ,:) = 0._wp      ! south 
     217         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,jpj-nbghostcells:jpj-1,:) = 0._wp      ! north 
    218218      ENDIF 
    219219#endif 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/do_loop_substitute.h90

    r12760 r12807  
    5050! includes the possibility of strides for which an extra set of DO_3DS macros are defined. 
    5151! 
    52 ! In the following definitions the inner PE domain is defined by start indices of (_nIs_0, nJs_0) and end indices of (nIe_0, nJs_0) 
    53 ! The following macros are defined just below: _nIs_0, nJs_0, _nIs_1, nJs_1, _nIe_0, nJs_0, _nIe_1, nJe_1.  
     52! In the following definitions the inner PE domain is defined by start indices of (_Nis0, Njs0) and end indices of (Nie0, Njs0) 
     53! The following macros are defined just below: _Nis0, Njs0, _Nis1, Njs1, _Nie0, Njs0, _Nie1, Nje1.  
    5454! These names are chosen to, hopefully, avoid any future, unintended matches elsewhere in the code. 
    5555! 
    … …  
    5858! -0- fortran code : defined in par_oce.F90 the folowwing valiables : 
    5959!!#  
    60 !!#    INTEGER, PUBLIC ::   nIs_0, nIs_1, nIs_2   !: start I-index (_0: no halo, _1 & _2: 1 & 2-halos) 
    61 !!#    INTEGER, PUBLIC ::   nIe_0, nIe_1, nIe_2   !: end   I-index (_0: no halo, _1 & _2: 1 & 2-halos) 
    62 !!#    INTEGER, PUBLIC ::   nJs_0, nJs_1, nJs_2   !: start J-index (_0: no halo, _1 & _2: 1 & 2-halos) 
    63 !!#    INTEGER, PUBLIC ::   nJe_0, nJe_1, nJe_2   !: end   J-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     60!!#    INTEGER, PUBLIC ::   Nis0, Nis1, Nis2   !: start I-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     61!!#    INTEGER, PUBLIC ::   Nie0, Nie1, Nie2   !: end   I-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     62!!#    INTEGER, PUBLIC ::   Njs0, Njs1, Njs2   !: start J-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     63!!#    INTEGER, PUBLIC ::   Nje0, Nje1, Nje2   !: end   J-index (_0: no halo, _1 & _2: 1 & 2-halos) 
    6464!!#  
    6565! -1- fortran code  put in  mppinit.F90 :    
    … …  
    7676!!#      IF(     nn_hls == 1 ) THEN          !* halo size of 1 
    7777!!#         ! 
    78 !!#         nIs_0 =   2     ;   nIs_1 =   1     ;   nIs_2 = nIs_1 
    79 !!#         nJs_0 = nIs_0   ;   nJs_1 = nIs_1   ;   nJs_2 = nIs_1 
    80 !!#         ! 
    81 !!#         nIe_0 = jpi-1   ;   nJe_1 = jpi     ;   nIe_2 = nIe_1 
    82 !!#         nJe_0 = jpj-1   ;   nJe_1 = jpj-1   ;   nJe_2 = nIe_1 
     78!!#         Nis0 =   2     ;   Nis1 =   1     ;   Nis2 = Nis1 
     79!!#         Njs0 = Nis0    ;   Njs1 = Nis1    ;   Njs2 = Nis1 
     80!!#         ! 
     81!!#         Nie0 = jpi-1   ;   Nje1 = jpi     ;   Nie2 = Nie1 
     82!!#         Nje0 = jpj-1   ;   Nje1 = jpj-1   ;   Nje2 = Nie1 
    8383!!#         ! 
    8484!!#      ELSEIF( nn_hls == 2 ) THEN          !* halo size of 2 
    8585!!#         ! 
    86 !!#         nIs_0 =   3     ;   nIs_1 =   2     ;   nIs_2 =   1 
    87 !!#         nJs_0 = nIs_0   ;   nJs_1 = nIs_1   ;   nJs_2 = nIs_2 
    88 !!#         ! 
    89 !!#         nIe_0 = jpi-2   ;   nJe_1 = jpi-1   ;   nIe_2 = jpi 
    90 !!#         nJe_0 = jpj-2   ;   nJe_1 = jpj-1   ;   nJe_2 = jpj 
     86!!#         Nis0 =   3     ;   Nis1 =   2     ;   Nis2 =   1 
     87!!#         Njs0 = Nis0    ;   Njs1 = Nis1    ;   Njs2 = Nis2 
     88!!#         ! 
     89!!#         Nie0 = jpi-2   ;   Nje1 = jpi-1   ;   Nie2 = jpi 
     90!!#         Nje0 = jpj-2   ;   Nje1 = jpj-1   ;   Nje2 = jpj 
    9191!!#         ! 
    9292!!#      ELSE                                !* unexpected halo size 
    … …  
    103103! 2D loops with 1 
    104104 
    105 #define DO_2D_00_00   DO jj = nJs_0, nJe_0   ;   DO ji = nIs_0, nIe_0 
    106 #define DO_2D_00_01   DO jj = nJs_0, nJe_0   ;   DO ji = nIs_0, nIe_1 
    107 #define DO_2D_00_10   DO jj = nJs_0, nJe_0   ;   DO ji = nIs_1, nIe_0 
    108 #define DO_2D_00_11   DO jj = nJs_0, nJe_0   ;   DO ji = nIs_1, nIe_1 
    109   
    110 #define DO_2D_01_00   DO jj = nJs_0, nJe_1   ;   DO ji = nIs_0, nIe_0 
    111 #define DO_2D_01_01   DO jj = nJs_0, nJe_1   ;   DO ji = nIs_0, nIe_1 
    112 #define DO_2D_01_10   DO jj = nJs_0, nJe_1   ;   DO ji = nIs_1, nIe_0 
    113 #define DO_2D_01_11   DO jj = nJs_0, nJe_1   ;   DO ji = nIs_1, nIe_1 
    114   
    115 #define DO_2D_10_00   DO jj = nJs_1, nJe_0   ;   DO ji = nIs_0, nIe_0 
    116 #define DO_2D_10_01   DO jj = nJs_1, nJe_0   ;   DO ji = nIs_0, nIe_1   ! not used ? 
    117 #define DO_2D_10_10   DO jj = nJs_1, nJe_0   ;   DO ji = nIs_1, nIe_0 
    118 #define DO_2D_10_11   DO jj = nJs_1, nJe_0   ;   DO ji = nIs_1, nIe_1 
    119   
    120 #define DO_2D_11_00   DO jj = nJs_1, nJe_1   ;   DO ji = nIs_0, nIe_0 
    121 #define DO_2D_11_01   DO jj = nJs_1, nJe_1   ;   DO ji = nIs_0, nIe_1 
    122 #define DO_2D_11_10   DO jj = nJs_1, nJe_1   ;   DO ji = nIs_1, nIe_0 
    123 #define DO_2D_11_11   DO jj = nJs_1, nJe_1   ;   DO ji = nIs_1, nIe_1 
     105#define DO_2D_00_00   DO jj = Njs0, Nje0   ;   DO ji = Nis0, Nie0 
     106#define DO_2D_00_01   DO jj = Njs0, Nje0   ;   DO ji = Nis0, Nie1 
     107#define DO_2D_00_10   DO jj = Njs0, Nje0   ;   DO ji = Nis1, Nie0 
     108#define DO_2D_00_11   DO jj = Njs0, Nje0   ;   DO ji = Nis1, Nie1 
     109  
     110#define DO_2D_01_00   DO jj = Njs0, Nje1   ;   DO ji = Nis0, Nie0 
     111#define DO_2D_01_01   DO jj = Njs0, Nje1   ;   DO ji = Nis0, Nie1 
     112#define DO_2D_01_10   DO jj = Njs0, Nje1   ;   DO ji = Nis1, Nie0 
     113#define DO_2D_01_11   DO jj = Njs0, Nje1   ;   DO ji = Nis1, Nie1 
     114  
     115#define DO_2D_10_00   DO jj = Njs1, Nje0   ;   DO ji = Nis0, Nie0 
     116#define DO_2D_10_01   DO jj = Njs1, Nje0   ;   DO ji = Nis0, Nie1   ! not used ? 
     117#define DO_2D_10_10   DO jj = Njs1, Nje0   ;   DO ji = Nis1, Nie0 
     118#define DO_2D_10_11   DO jj = Njs1, Nje0   ;   DO ji = Nis1, Nie1 
     119  
     120#define DO_2D_11_00   DO jj = Njs1, Nje1   ;   DO ji = Nis0, Nie0 
     121#define DO_2D_11_01   DO jj = Njs1, Nje1   ;   DO ji = Nis0, Nie1 
     122#define DO_2D_11_10   DO jj = Njs1, Nje1   ;   DO ji = Nis1, Nie0 
     123#define DO_2D_11_11   DO jj = Njs1, Nje1   ;   DO ji = Nis1, Nie1 
    124124 
    125125! 2D loops with 1 following a 2/3D loop with 2 
    126126 
    127 #define DO_2D_00_01nxt2   DO jj = nJs_0    , nJe_0       ;   DO ji = nIs_0    , nIe_1nxt2 
    128 #define DO_2D_00_10nxt2   DO jj = nJs_0    , nJe_0       ;   DO ji = nIs_1nxt2, nIe_0 
    129 #define DO_2D_00_11nxt2   DO jj = nJs_0    , nJe_0       ;   DO ji = nIs_1nxt2, nIe_1nxt2 
    130  
    131 #define DO_2D_01_00nxt2   DO jj = nJs_0    , nJe_1nxt2   ;   DO ji = nIs_0    , nIe_0 
    132 #define DO_2D_01_01nxt2   DO jj = nJs_0    , nJe_1nxt2   ;   DO ji = nIs_0    , nIe_1nxt2 
    133 #define DO_2D_01_10nxt2   DO jj = nJs_0    , nJe_1nxt2   ;   DO ji = nIs_1nxt2, nIe_0 
    134 #define DO_2D_01_11nxt2   DO jj = nJs_0    , nJe_1nxt2   ;   DO ji = nIs_1nxt2, nIe_1nxt2 
    135  
    136 #define DO_2D_10_00nxt2   DO jj = nJs_1nxt2, nJe_0       ;   DO ji = nIs_0    , nIe_0 
    137 #define DO_2D_10_01nxt2   DO jj = nJs_1nxt2, nJe_0       ;   DO ji = nIs_0    , nIe_1nxt2   ! not used ? 
    138 #define DO_2D_10_10nxt2   DO jj = nJs_1nxt2, nJe_0       ;   DO ji = nIs_1nxt2, nIe_0 
    139 #define DO_2D_10_11nxt2   DO jj = nJs_1nxt2, nJe_0       ;   DO ji = nIs_1nxt2, nIe_1nxt2 
    140  
    141 #define DO_2D_11_00nxt2   DO jj = nJs_1nxt2, nJe_1nxt2   ;   DO ji = nIs_0    , nIe_0 
    142 #define DO_2D_11_01nxt2   DO jj = nJs_1nxt2, nJe_1nxt2   ;   DO ji = nIs_0    , nIe_1nxt2 
    143 #define DO_2D_11_10nxt2   DO jj = nJs_1nxt2, nJe_1nxt2   ;   DO ji = nIs_1nxt2, nIe_0 
    144 #define DO_2D_11_11nxt2   DO jj = nJs_1nxt2, nJe_1nxt2   ;   DO ji = nIs_1nxt2, nIe_1nxt2 
     127#define DO_2D_00_01nxt2   DO jj = Njs0    , Nje0       ;   DO ji = Nis0    , Nie1nxt2 
     128#define DO_2D_00_10nxt2   DO jj = Njs0    , Nje0       ;   DO ji = Nis1nxt2, Nie0 
     129#define DO_2D_00_11nxt2   DO jj = Njs0    , Nje0       ;   DO ji = Nis1nxt2, Nie1nxt2 
     130 
     131#define DO_2D_01_00nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis0    , Nie0 
     132#define DO_2D_01_01nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis0    , Nie1nxt2 
     133#define DO_2D_01_10nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis1nxt2, Nie0 
     134#define DO_2D_01_11nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis1nxt2, Nie1nxt2 
     135 
     136#define DO_2D_10_00nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis0    , Nie0 
     137#define DO_2D_10_01nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis0    , Nie1nxt2   ! not used ? 
     138#define DO_2D_10_10nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis1nxt2, Nie0 
     139#define DO_2D_10_11nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis1nxt2, Nie1nxt2 
     140 
     141#define DO_2D_11_00nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis0    , Nie0 
     142#define DO_2D_11_01nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis0    , Nie1nxt2 
     143#define DO_2D_11_10nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis1nxt2, Nie0 
     144#define DO_2D_11_11nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis1nxt2, Nie1nxt2 
    145145 
    146146! 2D loops with 2 
    147147 
    148 #define DO_2D_11_12   DO jj = nJs_1nxt2, nJe_1nxt2   ;   DO ji = nIs_1nxt2, nIe_2 
    149 #define DO_2D_11_21   DO jj = nJs_1nxt2, nJe_1nxt2   ;   DO ji = nIs_2    , nIe_1nxt2 
    150 #define DO_2D_11_22   DO jj = nJs_1nxt2, nJe_1nxt2   ;   DO ji = nIs_2    , nIe_2 
    151  
    152 #define DO_2D_12_11   DO jj = nJs_1nxt2, nJe_2       ;   DO ji = nIs_1nxt2, nIe_1nxt2 
    153 #define DO_2D_12_12   DO jj = nJs_1nxt2, nJe_2       ;   DO ji = nIs_1nxt2, nIe_2