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 6772 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90 – NEMO

Ignore:
Timestamp:
2016-07-01T18:02:45+02:00 (8 years ago)
Author:
cbricaud
Message:

clean in coarsening branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r6101 r6772  
    3838   USE crslbclnk 
    3939   USE lib_mpp 
    40 !cbr   USE ieee_arithmetic    
     40   USE ieee_arithmetic    
    4141 
    4242   IMPLICIT NONE 
     
    6161 
    6262   SUBROUTINE crs_dom_msk 
     63   !!=================================================================== 
     64   ! 
     65   ! 
     66   ! 
     67   !!=================================================================== 
     68   INTEGER  ::  ji, jj, jk                   ! dummy loop indices 
     69   INTEGER  ::  ijis,ijie,ijjs,ijje 
     70   REAL(wp) ::  zmask 
     71   !!------------------------------------------------------------------- 
    6372       
    64       INTEGER  ::  ji, jj, jk                   ! dummy loop indices 
    65       INTEGER  ::  ijie,ijis,ijje,ijjs,ij,je_2 
    66       INTEGER  ::  iji, ijj 
    67       REAL(wp) ::  zmask 
    68       INTEGER  :: ir,jr 
    69        
    70       ! Initialize 
    71       tmask_crs(:,:,:) = 0.0 
    72       vmask_crs(:,:,:) = 0.0 
    73       umask_crs(:,:,:) = 0.0 
    74       fmask_crs(:,:,:) = 0.0 
    75       ! 
    76       DO jk = 1, jpkm1 
    77          DO ji = 2, nlei_crs 
    78             ijie = mie_crs(ji) 
    79             ijis = mis_crs(ji) 
    80  
    81             IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2 
    82  
    83                IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 
    84  
    85                   jj = mje_crs(2) 
    86  
    87                   zmask = 0.0 
    88                   zmask = SUM( tmask(ijis:ijie,jj,jk) ) 
    89                   IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 
    90  
    91                   zmask = 0.0 
    92                   zmask = SUM( vmask(ijis:ijie,jj     ,jk) ) 
    93                   IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 
    94  
    95                   zmask = 0.0 
    96                   zmask = umask(ijie     ,jj,jk) 
    97                   IF( zmask > 0.0 )umask_crs(ji,2,jk) = 1.0 
    98  
    99                   fmask_crs(ji,jj,jk) = fmask(ijie,2,jk) 
    100                ENDIF 
    101             ELSE 
    102  
    103                jj   = mje_crs(2) 
    104                ij   = mjs_crs(2) 
    105  
    106                zmask = 0.0 
    107                zmask = SUM( tmask(ijis:ijie,ij:jj,jk) ) 
    108                IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 
    109  
    110                zmask = 0.0 
    111                zmask = SUM( vmask(ijis:ijie,jj     ,jk) ) 
    112                IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 
    113  
    114                zmask = 0.0 
    115                zmask = SUM(umask(ijie,ij:jj,jk)) 
    116                IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 
    117  
    118                fmask_crs(ji,jj,jk) = fmask(ijie,2,jk) 
    119  
    120             ENDIF 
    121   
    122             DO jj = 3, nlej_crs 
    123                ijje = mje_crs(jj) 
    124                ijjs = mjs_crs(jj) 
    125  
    126                !iji=117 ; ijj=211 
    127                !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
    128                !IF( ji ==iji .AND. jj==ijj .AND. jk==74 )THEN 
    129                !write(narea+5000,*)"mask ",ji,jj 
    130                !write(narea+5000,*)"mask ",ijie,ijis,ijjs,ijje 
    131                !ENDIF 
    132  
    133                ir=303-nimpp_crs+1 ; jr=302-njmpp_crs+1 
    134                IF( ji==ir .AND. jj==jr )THEN 
    135                    WRITE(narea+2000,*)"mask",ir,jr,ijis+nimpp-1,ijjs+njmpp-1 
    136                ENDIF 
    137  
    138                !IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 
    139                zmask = 0.0 
    140                zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
    141                IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 
    142  
    143                zmask = 0.0 
    144                zmask = SUM( vmask(ijis:ijie,ijje     ,jk) ) 
    145                IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 
    146  
    147                zmask = 0.0 
    148                zmask = SUM( umask(ijie     ,ijjs:ijje,jk) ) 
    149                IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 
    150  
    151                fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk) 
    152  
    153             ENDDO 
     73   ! Initialize 
     74   tmask_crs(:,:,:) = 0.0 
     75   vmask_crs(:,:,:) = 0.0 
     76   umask_crs(:,:,:) = 0.0 
     77   fmask_crs(:,:,:) = 0.0 
     78   ! 
     79   DO jk = 1, jpkm1 
     80      DO ji = nldi_crs, nlei_crs 
     81 
     82         ijis = mis_crs(ji) 
     83         ijie = mie_crs(ji) 
     84 
     85         DO jj = nldj_crs, nlej_crs 
     86 
     87            ijjs = mjs_crs(jj) 
     88            ijje = mje_crs(jj) 
     89 
     90            zmask = 0.0 
     91            zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
     92            IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 
     93 
     94            zmask = 0.0 
     95            zmask = SUM( vmask(ijis:ijie,ijje     ,jk) ) 
     96            IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 
     97 
     98            zmask = 0.0 
     99            zmask = SUM( umask(ijie     ,ijjs:ijje,jk) ) 
     100            IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 
     101 
     102            fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk) 
     103 
     104 
    154105         ENDDO 
    155106      ENDDO 
    156       CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 
    157       !cbr 
    158       !DO ji=1,jpi_crs-1 
    159       !DO jj=1,jpj_crs-1 
    160       !DO jk=1,jpk 
    161       !   umask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji+1,jj  ,jk) 
    162       !   vmask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji  ,jj+1,jk) 
    163       !   fmask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji  ,jj+1,jk) *  tmask_crs(ji+1,jj  ,jk) *   tmask_crs(ji+1,jj+1,jk)  
    164       !ENDDO 
    165       !ENDDO 
    166       !ENDDO 
    167       ! 
    168       CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 ) 
    169       CALL crs_lbc_lnk( umask_crs, 'U', 1.0 ) 
    170       CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 ) 
    171       ! 
    172       !cbr 
    173       !DO ji=2,jpi_crs-1 
    174       !DO jj=2,jpj_crs-1 
    175       !DO jk=1,jpk 
    176       !   IF( tmask(ji-1,jj  ,jk)==1. .AND. tmask(ji  ,jj  ,jk)==1. .AND. umask(ji-1,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK1",ji,jj,jk 
    177       !   IF( tmask(ji  ,jj  ,jk)==1. .AND. tmask(ji+1,jj  ,jk)==1. .AND. umask(ji  ,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK2",ji,jj,jk 
    178       !   IF( tmask(ji  ,jj-1,jk)==1. .AND. tmask(ji  ,jj  ,jk)==1. .AND. vmask(ji  ,jj-1,jk)==0. )WRITE(narea+5000,*)"MASK3",ji,jj,jk 
    179       !   IF( tmask(ji  ,jj  ,jk)==1. .AND. tmask(ji  ,jj+1,jk)==1. .AND. vmask(ji  ,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK4",ji,jj,jk 
    180       !   IF( umask(ji-1,jj  ,jk)==1. .AND. ( tmask(ji-1,jj  ,jk)==0. .OR. tmask(ji  ,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK5",ji,jj,jk 
    181       !   IF( umask(ji  ,jj  ,jk)==1. .AND. ( tmask(ji  ,jj  ,jk)==0. .OR. tmask(ji+1,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK6",ji,jj,jk 
    182       !   IF( vmask(ji  ,jj-1,jk)==1. .AND. ( tmask(ji  ,jj-1,jk)==0. .OR. tmask(ji  ,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK7",ji,jj,jk 
    183       !   IF( vmask(ji  ,jj  ,jk)==1. .AND. ( tmask(ji  ,jj  ,jk)==0. .OR. tmask(ji  ,jj+1,jk)==0. ) )WRITE(narea+5000,*)"MASK8",ji,jj,jk 
    184       !ENDDO 
    185       !ENDDO 
    186       !ENDDO 
    187       ! 
     107   ENDDO 
     108 
     109   CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 
     110   CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 ) 
     111   CALL crs_lbc_lnk( umask_crs, 'U', 1.0 ) 
     112   CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 ) 
     113   ! 
    188114   END SUBROUTINE crs_dom_msk 
    189115 
     
    219145      !! Local variables 
    220146      INTEGER :: ji, jj, jk                   ! dummy loop indices 
    221       INTEGER :: ijis, ijjs 
     147      INTEGER :: iji, ijj 
    222148      INTEGER  :: ir,jr 
     149      !!---------------------------------------------------------------- 
     150      p_gphi_crs(:,:)=0._wp 
     151      p_glam_crs(:,:)=0._wp 
    223152 
    224153   
     
    226155         CASE ( 'T' ) 
    227156            DO jj =  nldj_crs, nlej_crs 
    228                ijjs = mjs_crs(jj) + mybinctr 
    229                DO ji = 2, nlei_crs 
    230                   ijis = mis_crs(ji) + mxbinctr  
    231                   p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    232                   p_glam_crs(ji,jj) = p_glam(ijis,ijjs) 
    233                   ir=303-nimpp_crs+1 ; jr=302-njmpp_crs+1 
    234                   WRITE(narea+2000,*)"coordT1",ir,jr 
    235                   IF( ji==ir .AND. jj==jr )THEN 
    236                      WRITE(narea+2000,*)"coordT",ir,jr,ijis+nimpp-1,ijjs+njmpp-1 
    237                   ENDIF 
     157               ijj = mjs_crs(jj) + 1 
     158               DO ji = nldi_crs, nlei_crs 
     159                  iji = mis_crs(ji) + 1 
     160                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj) 
     161                  p_glam_crs(ji,jj) = p_glam(iji,ijj) 
    238162               ENDDO 
    239163            ENDDO 
    240164         CASE ( 'U' ) 
    241165            DO jj =  nldj_crs, nlej_crs 
    242                ijjs = mjs_crs(jj) + mybinctr                   
    243                DO ji = 2, nlei_crs 
    244                   ijis = mis_crs(ji) 
    245                   p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    246                   p_glam_crs(ji,jj) = p_glam(ijis,ijjs) 
     166               ijj = mjs_crs(jj) + 1 
     167               DO ji = nldi_crs, nlei_crs 
     168                  iji = mie_crs(ji) 
     169                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj) 
     170                  p_glam_crs(ji,jj) = p_glam(iji,ijj) 
     171  
    247172               ENDDO 
    248173            ENDDO 
    249174         CASE ( 'V' ) 
    250175            DO jj =  nldj_crs, nlej_crs 
    251                ijjs = mjs_crs(jj) 
    252                DO ji = 2, nlei_crs 
    253                   ijis = mis_crs(ji) + mxbinctr  
    254                   p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    255                   p_glam_crs(ji,jj) = p_glam(ijis,ijjs) 
     176               ijj = mje_crs(jj) 
     177               DO ji = nldi_crs, nlei_crs 
     178                  iji = mis_crs(ji) + 1 
     179                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj) 
     180                  p_glam_crs(ji,jj) = p_glam(iji,ijj) 
    256181               ENDDO 
    257182            ENDDO 
    258183         CASE ( 'F' ) 
    259184            DO jj =  nldj_crs, nlej_crs 
    260                ijjs = mjs_crs(jj) 
    261                DO ji = 2, nlei_crs 
    262                   ijis = mis_crs(ji) 
    263                   p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    264                   p_glam_crs(ji,jj) = p_glam(ijis,ijjs) 
     185               ijj = mje_crs(jj) 
     186               DO ji = nldi_crs, nlei_crs 
     187                  iji = mie_crs(ji) 
     188                  p_gphi_crs(ji,jj) = p_gphi(iji,ijj) 
     189                  p_glam_crs(ji,jj) = p_glam(iji,ijj) 
    265190               ENDDO 
    266191            ENDDO 
     
    271196      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 ) 
    272197          
    273       ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd 
    274       SELECT CASE ( cd_type ) 
    275          CASE ( 'T', 'V' ) 
    276             DO ji = 2, nlei_crs 
    277                ijis = mis_crs(ji) + mxbinctr  
    278                p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    279                p_glam_crs(ji,1) = p_glam(ijis,1) 
    280             ENDDO 
    281          CASE ( 'U', 'F' ) 
    282             DO ji = 2, nlei_crs 
    283                ijis = mis_crs(ji)  
    284                p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    285                p_glam_crs(ji,1) = p_glam(ijis,1) 
    286             ENDDO 
    287       END SELECT 
     198!cbr???      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd 
     199!      SELECT CASE ( cd_type ) 
     200!         CASE ( 'T', 'V' ) 
     201!            DO ji = 2, nlei_crs 
     202!               ijis = mis_crs(ji) + mxbinctr  
     203!               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
     204!               p_glam_crs(ji,1) = p_glam(ijis,1) 
     205!            ENDDO 
     206!         CASE ( 'U', 'F' ) 
     207!            DO ji = 2, nlei_crs 
     208!               ijis = mis_crs(ji)  
     209!               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
     210!               p_glam_crs(ji,1) = p_glam(ijis,1) 
     211!            ENDDO 
     212!      END SELECT 
    288213      ! 
    289214   END SUBROUTINE crs_dom_coordinates 
     
    317242      !! Local variables 
    318243      INTEGER :: ji, jj, jk     ! dummy loop indices 
    319       INTEGER :: ijie,ijje,ijrs 
     244      INTEGER :: ijis,ijie,ijjs,ijje 
     245      INTEGER :: ji1, jj1 
    320246   
    321247      !!----------------------------------------------------------------   
    322248      ! Initialize       
    323249 
    324       DO jk = 1, jpk     
    325          DO ji = 2, nlei_crs 
     250         DO ji = nldi_crs, nlei_crs 
     251 
     252            ijis = mis_crs(ji) 
    326253            ijie = mie_crs(ji) 
     254 
    327255            DO jj = nldj_crs, nlej_crs 
    328                ijje = mje_crs(jj)   ;   ijrs =  mje_crs(jj) - mjs_crs(jj) 
     256 
     257               ijjs = mjs_crs(jj) 
     258               ijje = mje_crs(jj) 
     259 
    329260               ! Only for a factro 3 coarsening 
    330261               SELECT CASE ( cd_type ) 
    331262                   CASE ( 'T' ) 
    332                       IF( ijrs == 0 .OR. ijrs == 1 ) THEN 
    333                         ! Si à la frontière sud on a pas assez de maille de la grille mère 
    334                          p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx 
    335                          p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty 
    336                       ELSE 
    337                          p_e1_crs(ji,jj) = p_e1(ijie-1,ijje-1) * nn_factx 
    338                          p_e2_crs(ji,jj) = p_e2(ijie-1,ijje-1) * nn_facty 
    339                       ENDIF 
     263                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis:ijie     ,ijjs+1       ) ) 
     264                      !p_e2_crs(ji,jj) = SUM( p_e2(ijis+1        ,ijjs:ijje    ) ) 
     265                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijjs+1) 
     266                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijis+1,ijjs+1) 
    340267                   CASE ( 'U' ) 
    341                       IF( ijrs == 0 .OR. ijrs == 1 ) THEN 
    342                          ! Si à la frontière sud on a pas assez de maille de la grille mère 
    343                          p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                             
    344                          p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty 
    345                       ELSE 
    346                          p_e1_crs(ji,jj) = p_e1(ijie,ijje-1) * nn_factx 
    347                          p_e2_crs(ji,jj) = p_e2(ijie,ijje-1) * nn_facty 
    348                       ENDIF 
     268                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis+1:ijie+1 ,ijjs+1       ) ) 
     269                      !p_e2_crs(ji,jj) = SUM( p_e2(ijie          ,ijjs:ijje    ) ) 
     270                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijjs+1       )  
     271                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijie  ,ijjs+1       )  
     272 
    349273                   CASE ( 'V' ) 
    350                          p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx                             
    351                          p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty 
     274                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis:ijie     ,ijje         ) ) 
     275                      !p_e2_crs(ji,jj) = SUM( p_e2(ijis+1        ,ijjs+1:ijje+1) ) 
     276                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijje       )  
     277                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijis+1,ijjs+1     )  
    352278                   CASE ( 'F' ) 
    353                          p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                             
    354                          p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty 
     279                      !p_e1_crs(ji,jj) = SUM( p_e1(ijis+1:ijie+1 ,ijje         ) ) 
     280                      !p_e2_crs(ji,jj) = SUM( p_e2(ijie          ,ijjs+1:ijje+1) ) 
     281                      p_e1_crs(ji,jj) = REAL(nn_factx,wp)*p_e1(ijis+1,ijje       )  
     282                      p_e2_crs(ji,jj) = REAL(nn_facty,wp)*p_e2(ijie  ,ijjs+1     )  
    355283               END SELECT 
    356284            ENDDO 
    357285         ENDDO 
    358       ENDDO 
    359  
    360       CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0, pval=1.0 ) 
    361       CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0, pval=1.0 ) 
     286 
     287 
     288      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0 ) !cbr , pval=1.0 ) 
     289      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0 ) !cbr , pval=1.0 ) 
    362290 
    363291   END SUBROUTINE crs_dom_hgr 
     
    416344      !! Local variables 
    417345      REAL(wp)                                :: zdAm 
    418       INTEGER                                 :: ji, jj, jk , ii, ij, je_2 
     346      INTEGER                                 :: ji, jj, jk 
     347      INTEGER :: ijis,ijie,ijjs,ijje 
    419348 
    420349      REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol, zmask       
     
    427356 
    428357      DO jk = 1, jpk 
    429          zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk)  
     358         zvol (:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk)  
     359         zmask(:,:,jk) = p_mask(:,:,jk)  
    430360      ENDDO 
    431361 
    432       zmask(:,:,:) = 0.0 
    433       !IF( cd_type == 'W' ) THEN 
    434       !   zmask(:,:,1) = p_mask(:,:,1)  
    435       !   DO jk = 2, jpk 
    436       !      zmask(:,:,jk) = p_mask(:,:,jk-1)  
    437       !   ENDDO 
    438       !ELSE 
    439          DO jk = 1, jpk 
    440              zmask(:,:,jk) = p_mask(:,:,jk)  
    441          ENDDO 
    442       !ENDIF 
    443  
    444       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    445          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    446             je_2 = mje_crs(2) 
    447             DO jk = 1, jpk            
    448                DO ji = nistr, niend, nn_factx 
    449                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    450                   p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  & 
    451                      &                 + zvol(ji,je_2-1,jk) + zvol(ji+1,je_2-1,jk) + zvol(ji+2,je_2-1,jk)  
    452                   ! 
    453                   zdAm =  zvol(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)  & 
    454                     &   + zvol(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)  & 
    455                     &   + zvol(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  
    456                   !  
    457                   p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)  
    458                ENDDO 
    459             ENDDO 
    460          ENDIF 
    461       ELSE 
    462          je_2 = mjs_crs(2) 
    463          DO jk = 1, jpk            
    464             DO ji = nistr, niend, nn_factx 
    465                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    466                p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  & 
    467                    &                + zvol(ji,je_2+1,jk) + zvol(ji+1,je_2+1,jk) + zvol(ji+2,je_2+1,jk)  & 
    468                    &                + zvol(ji,je_2+2,jk) + zvol(ji+1,je_2+2,jk) + zvol(ji+2,je_2+2,jk)   
    469               ! 
    470                zdAm = zvol(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)  & 
    471                  &  + zvol(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)  & 
    472                  &  + zvol(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)  & 
    473                  &  + zvol(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)  & 
    474                  &  + zvol(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)  & 
    475                  &  + zvol(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)  & 
    476                  &  + zvol(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)  & 
    477                  &  + zvol(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)  & 
    478                  &  + zvol(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) 
    479                  !  
    480                  p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)  
    481             ENDDO 
    482          ENDDO 
    483       ENDIF 
    484  
    485       DO jk = 1, jpk            
    486          DO jj  = njstr, njend, nn_facty 
    487             DO ji = nistr, niend, nn_factx 
    488                ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    489                ij  = ( jj - njstr ) * rfacty_r + 3 
    490                ! 
    491                p_fld1_crs(ii,ij,jk) =  zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  & 
    492                    &                 + zvol(ji,jj+1,jk) + zvol(ji+1,jj+1,jk) + zvol(ji+2,jj+1,jk)  & 
    493                    &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk)  
    494                ! 
    495                zdAm =  zvol(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)  & 
    496                  &   + zvol(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)  & 
    497                  &   + zvol(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)  & 
    498                  &   + zvol(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)  & 
    499                  &   + zvol(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)  & 
    500                  &   + zvol(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)  & 
    501                  &   + zvol(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)  & 
    502                  &   + zvol(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)  & 
    503                  &   + zvol(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) 
    504                  !  
    505                 p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk)  
     362      DO jk = 1, jpk 
     363         DO ji = nldi_crs, nlei_crs 
     364 
     365            ijis = mis_crs(ji) 
     366            ijie = mie_crs(ji) 
     367 
     368            DO jj = nldj_crs, nlej_crs 
     369 
     370               ijjs = mjs_crs(jj) 
     371               ijje = mje_crs(jj) 
     372 
     373               p_fld1_crs(ji,jj,jk) =  SUM( zvol(ijis:ijie,ijjs:ijje,jk) ) 
     374               zdAm                 =  SUM( zvol(ijis:ijie,ijjs:ijje,jk) * zmask(ijis:ijie,ijjs:ijje,jk) ) 
     375               p_fld2_crs(ji,jj,jk) = zdAm / p_fld1_crs(ji,jj,jk)  
    506376            ENDDO 
    507377         ENDDO 
     
    551421      REAL(wp),                                 INTENT(in)           :: psgn    ! sign  
    552422 
    553  
    554423      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    555424 
    556425      !! Local variables 
    557426      INTEGER  :: ji, jj, jk  
    558       INTEGER  :: ii, ij, ijie, ijje, je_2 
     427      INTEGER  :: ijis, ijie, ijjs, ijje 
    559428      REAL(wp) :: zflcrs, zsfcrs    
    560429      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask,ztabtmp 
    561       INTEGER  :: iji, ijj 
    562430      INTEGER  :: ir,jr 
    563431      REAL(wp), DIMENSION(nn_factx,nn_facty):: ztmp 
     
    579447             
    580448               CASE( 'T', 'W' ) 
    581                   !IF( cd_type == 'T' ) THEN 
    582                      DO jk = 1, jpk 
    583                         zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)  
    584                         zsurfmsk(:,:,jk) =  zsurf(:,:,jk)  
    585                     ENDDO 
    586                   !ELSE 
    587                   !  !cbr ???????????????????????????????? 
    588                   !   zsurf   (:,:,1) =  p_e12(:,:) * p_e3(:,:,1) 
    589                   !   zsurfmsk(:,:,1) =  zsurf(:,:,1) *  p_mask(:,:,1)  
    590                   !   DO jk = 2, jpk 
    591                   !      zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) 
    592                   !      zsurfmsk(:,:,jk) =  zsurf(:,:,jk) * p_mask(:,:,jk-1)  
    593                   !   ENDDO 
    594                   !ENDIF 
    595           
    596                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    597                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    598                         je_2 = mje_crs(2) 
    599                         DO jk = 1, jpk            
    600                            DO ji = nistr, niend, nn_factx 
    601                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
    602                               zflcrs =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk)   & 
    603                                 &     + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk)   & 
    604                                 &     + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk)  
    605   
    606                               zsfcrs =  zsurf(ji,je_2,jk) + zsurf(ji+1,je_2,jk) + zsurf(ji+2,je_2,jk)  
    607                               ! 
    608                               p_fld_crs(ii,2,jk) = zflcrs 
    609                               IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
    610                            ENDDO 
    611                         ENDDO 
    612                      ENDIF 
    613                   ELSE 
    614                      je_2 = mjs_crs(2) 
    615                      DO jk = 1, jpk            
    616                         DO ji = nistr, niend, nn_factx 
    617                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    618                            zflcrs =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk) & 
    619                              &     + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk) & 
    620                              &     + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk) & 
    621                              &     + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk) & 
    622                              &     + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk) & 
    623                              &     + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk) & 
    624                              &     + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk) & 
    625                              &     + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk) & 
    626                              &     + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk)  
    627  
    628                            zsfcrs =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) & 
    629                              &     + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk) & 
    630                              &     + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)  
    631                             ! 
    632                             p_fld_crs(ii,2,jk) = zflcrs 
    633                             IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
    634                         ENDDO 
    635                      ENDDO 
    636                   ENDIF 
     449                  DO jk = 1, jpk 
     450                     zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)  
     451                     zsurfmsk(:,:,jk) =  zsurf(:,:,jk)  
     452                  ENDDO 
    637453                  ! 
    638                   DO jk = 1, jpk            
    639                      DO jj  = njstr, njend, nn_facty 
    640                         DO ji = nistr, niend, nn_factx 
    641                            ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    642                            ij = ( jj - njstr ) * rfacty_r + 3 
    643                            zflcrs =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) & 
    644                              &     + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) & 
    645                              &     + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) & 
    646                              &     + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk) & 
    647                              &     + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk) & 
    648                              &     + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk) & 
    649                              &     + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk) & 
    650                              &     + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) & 
    651                              &     + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)  
    652                            zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) & 
    653                              &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) & 
    654                              &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)  
    655                             ! 
    656 !cbr                            IF( ieee_is_nan(p_fld_crs(ii,ij,jk))) THEN 
    657  
    658                            p_fld_crs(ii,ij,jk) = zflcrs 
    659                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
     454                  DO jk = 1, jpk           
     455                     DO jj  = nldj_crs,nlej_crs 
     456                        ijjs = mjs_crs(jj) 
     457                        ijje = mje_crs(jj) 
     458                        DO ji = nldi_crs, nlei_crs 
     459 
     460                           ijis = mis_crs(ji) 
     461                           ijie = mie_crs(ji) 
     462 
     463                           zflcrs = SUM( p_fld(ijis:ijie,ijjs:ijje,jk) * zsurfmsk(ijis:ijie,ijjs:ijje,jk) ) 
     464                           zsfcrs = SUM(                                 zsurfmsk(ijis:ijie,ijjs:ijje,jk) ) 
     465 
     466                           p_fld_crs(ji,jj,jk) = zflcrs 
     467                           IF( zsfcrs /= 0.0 )  p_fld_crs(ji,jj,jk) = zflcrs / zsfcrs 
    660468                        ENDDO       
    661469                     ENDDO 
    662470                  ENDDO   
     471                  ! 
    663472               CASE DEFAULT 
    664473                    STOP 
    665                END SELECT 
    666  
    667               CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     474            END SELECT 
     475 
     476            CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     477 
    668478         CASE ( 'LOGVOL' ) 
    669479 
    670480            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk, ztabtmp ) 
    671  
    672             zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"p_fld",zmin,zmax; CALL flush(numout) 
    673481 
    674482            ztabtmp(:,:,:)=0._wp 
    675483            WHERE(p_fld* p_mask .NE. 0._wp ) ztabtmp =  LOG10(p_fld * p_mask)*p_mask 
    676             zmin=MINVAL(ztabtmp) ; zmax=MAXVAL(ztabtmp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"LOG()",zmin,zmax; CALL flush(numout) 
    677484            ztabtmp = ztabtmp * p_mask 
    678             zmin=MINVAL(ztabtmp) ; zmax=MAXVAL(ztabtmp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"LOG()*tmask",zmin,zmax; CALL flush(numout) 
    679485 
    680486            SELECT CASE ( cd_type ) 
    681487 
    682488               CASE( 'T', 'W' ) 
    683                      DO jk = 1, jpk 
    684                         zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
    685                         zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
    686                     ENDDO 
    687  
    688                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    689                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    690                         je_2 = mje_crs(2) 
    691                         DO jk = 1, jpk 
    692                            DO ji = nistr, niend, nn_factx 
    693                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    694                               zflcrs =  ztabtmp(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk)   & 
    695                                 &     + ztabtmp(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk)   & 
    696                                 &     + ztabtmp(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk) 
    697  
    698                               zsfcrs =  zsurf(ji,je_2,jk) + zsurf(ji+1,je_2,jk) + zsurf(ji+2,je_2,jk) 
    699                               ! 
    700                               p_fld_crs(ii,2,jk) = 0._wp 
    701                               IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
    702                               p_fld_crs(ii,2,jk) = 10 ** ( p_fld_crs(ii,2,jk) * p_mask_crs(ii,2,jk) ) * p_mask_crs(ii,2,jk) 
    703                            ENDDO 
    704                         ENDDO 
    705                      ENDIF 
    706                   ELSE 
    707                      je_2 = mjs_crs(2) 
    708                      DO jk = 1, jpk 
    709                         DO ji = nistr, niend, nn_factx 
    710                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    711                            zflcrs =  ztabtmp(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk) & 
    712                              &     + ztabtmp(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk) & 
    713                              &     + ztabtmp(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk) & 
    714                              &     + ztabtmp(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk) & 
    715                              &     + ztabtmp(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk) & 
    716                              &     + ztabtmp(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk) & 
    717                              &     + ztabtmp(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk) & 
    718                              &     + ztabtmp(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk) & 
    719                              &     + ztabtmp(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk) 
    720  
    721                            zsfcrs =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) & 
    722                              &     + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk) & 
    723                              &     + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk) 
    724                             ! 
    725                             p_fld_crs(ii,2,jk) = 0._wp 
    726                             IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
    727                             p_fld_crs(ii,2,jk) = 10 ** ( p_fld_crs(ii,2,jk) * p_mask_crs(ii,2,jk) ) * p_mask_crs(ii,2,jk) 
     489 
     490                  DO jk = 1, jpk 
     491                     zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
     492                     zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
     493                  ENDDO 
     494                  ! 
     495                  DO jk = 1, jpk 
     496                     DO jj  = nldj_crs,nlej_crs 
     497                        ijjs = mjs_crs(jj) 
     498                        ijje = mje_crs(jj) 
     499                        DO ji = nldi_crs, nlei_crs 
     500                           ijis = mis_crs(ji) 
     501                           ijie = mie_crs(ji) 
     502                           zflcrs = SUM( p_fld(ijis:ijie,ijjs:ijje,jk) * zsurfmsk(ijis:ijie,ijjs:ijje,jk) ) 
     503                           zsfcrs = SUM(                                 zsurfmsk(ijis:ijie,ijjs:ijje,jk) ) 
     504                           p_fld_crs(ji,jj,jk) = zflcrs 
     505                           IF( zsfcrs /= 0.0 )  p_fld_crs(ji,jj,jk) = zflcrs / zsfcrs 
     506                           p_fld_crs(ji,jj,jk) = 10 ** ( p_fld_crs(ji,jj,jk) *  p_mask_crs(ji,jj,jk) ) * p_mask_crs(ji,jj,jk) 
    728507                        ENDDO 
    729508                     ENDDO 
    730                   ENDIF 
     509                  ENDDO 
     510               CASE DEFAULT 
     511                    STOP 
     512            END SELECT 
     513 
     514            CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ,ztabtmp ) 
     515 
     516         CASE ( 'MED' ) 
     517 
     518            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     519 
     520            SELECT CASE ( cd_type ) 
     521 
     522               CASE( 'T', 'W' ) 
     523                  DO jk = 1, jpk 
     524                     zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
     525                     zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
     526                  ENDDO 
    731527                  ! 
    732528                  DO jk = 1, jpk 
    733                      DO jj  = njstr, njend, nn_facty 
    734                         DO ji = nistr, niend, nn_factx 
    735                            ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    736                            ij = ( jj - njstr ) * rfacty_r + 3 
    737                            zflcrs =  ztabtmp(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) & 
    738                              &     + ztabtmp(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) & 
    739                              &     + ztabtmp(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) & 
    740                              &     + ztabtmp(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk) & 
    741                              &     + ztabtmp(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk) & 
    742                              &     + ztabtmp(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk) & 
    743                              &     + ztabtmp(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk) & 
    744                              &     + ztabtmp(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) & 
    745                              &     + ztabtmp(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk) 
    746                            zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) & 
    747                              &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) & 
    748                              &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 
    749                             ! 
    750                            p_fld_crs(ii,ij,jk) = 0._wp 
    751                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
    752                            p_fld_crs(ii,ij,jk) = 10 ** ( p_fld_crs(ii,ij,jk) *  p_mask_crs(ii,ij,jk) ) * p_mask_crs(ii,ij,jk) 
    753                         ENDDO 
    754                      ENDDO 
    755                   ENDDO 
    756                CASE DEFAULT 
    757                     STOP 
    758                END SELECT 
    759  
    760  
    761               !WHERE( p_fld .NE. 0._wp ) p_fld=10**(p_fld) 
    762               !zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld)",zmin,zmax ; CALL flush(numout) 
    763               !p_fld = p_fld * p_mask 
    764               !zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld)*tmask",zmin,zmax ; CALL flush(numout) 
    765  
    766               zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"p_fld_crs",zmin,zmax; CALL flush(numout) 
    767               !p_fld_crs=10**(p_fld_crs*p_mask_crs) 
    768               !zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld_crs)",zmin,zmax; CALL flush(numout) 
    769               !p_fld_crs=p_fld_crs*p_mask_crs 
    770               !zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld_crs)*tmask",zmin,zmax; CALL flush(numout) 
    771  
    772               CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ,ztabtmp ) 
    773          CASE ( 'MED' ) 
    774  
    775             CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    776  
    777             SELECT CASE ( cd_type ) 
    778  
    779                CASE( 'T', 'W' ) 
    780                      DO jk = 1, jpk 
    781                         zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
    782                         zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
    783                     ENDDO 
    784  
    785                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    786                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    787                         je_2 = mje_crs(2) 
    788                         DO jk = 1, jpk 
    789                            DO ji = nistr, niend, nn_factx 
    790                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    791  
    792                               ztmp1(:) = 0._wp 
    793                               ztmp1(1:3) =  p_fld(ji:ji+2,je_2,jk) 
    794                               CALL PIKSRT(nn_factx*nn_facty,ztmp1) 
    795                               ir=0 
    796                               jr=1 
    797                               DO WHILE( jr .LE. nn_factx*nn_facty ) 
    798                                  IF( ztmp1(jr) == 0. )THEN 
    799                                     ir=jr 
    800                                     jr=jr+1 
    801                                  ELSE 
    802                                     EXIT 
    803                                  ENDIF 
    804                               ENDDO 
    805                               IF( ir .LE. nn_factx*nn_facty-1 )THEN 
    806                                  ALLOCATE( ztmp2(nn_factx*nn_facty-ir) ) 
    807                                  ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty) 
    808                                  jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1 
    809                                  p_fld_crs(ii,2,jk) = ztmp2(jr) 
    810                                  DEALLOCATE( ztmp2 ) 
    811                               ELSE 
    812                                  p_fld_crs(ii,ij,jk) = 0._wp 
    813                               ENDIF 
    814  
    815                            ENDDO 
    816                         ENDDO 
    817                      ENDIF 
    818                   ELSE 
    819                      je_2 = mjs_crs(2) 
    820                      DO jk = 1, jpk 
    821                         DO ji = nistr, niend, nn_factx 
    822                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    823                             
    824                            ztmp(:,:)= p_fld(ji:ji+2,je_2:je_2+2,jk) 
    825                            zdim1(1)=nn_factx*nn_facty 
     529                     DO jj  = nldj_crs,nlej_crs 
     530                        ijjs = mjs_crs(jj) 
     531                        ijje = mje_crs(jj) 
     532                        DO ji = nldi_crs, nlei_crs 
     533                           ijis = mis_crs(ji) 
     534                           ijie = mie_crs(ji) 
     535 
     536                           ztmp(:,:)= p_fld(ijis:ijie,ijjs:ijje,jk) 
     537                           zdim1(1) = nn_factx*nn_facty 
    826538                           ztmp1(:) = RESHAPE( ztmp(:,:) , zdim1 ) 
    827539                           CALL PIKSRT(nn_factx*nn_facty,ztmp1) 
     540 
    828541                           ir=0 
    829542                           jr=1 
     
    840553                              ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty) 
    841554                              jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1 
    842                               p_fld_crs(ii,2,jk) = ztmp2(jr) 
     555                              p_fld_crs(ji,jj,jk) = ztmp2(jr) 
    843556                              DEALLOCATE( ztmp2 ) 
    844557                           ELSE 
    845                            p_fld_crs(ii,ij,jk) = 0._wp 
     558                              p_fld_crs(ji,jj,jk) = 0._wp 
    846559                           ENDIF 
    847560 
    848561                        ENDDO 
    849562                     ENDDO 
    850                   ENDIF 
    851                   ! 
    852                   DO jk = 1, jpk 
    853                      DO jj  = njstr, njend, nn_facty 
    854                         DO ji = nistr, niend, nn_factx 
    855                            ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    856                            ij = ( jj - njstr ) * rfacty_r + 3 
    857  
    858                            ztmp(:,:)= p_fld(ji:ji+2,jj:jj+2,jk)  
    859                            zdim1(1)=nn_factx*nn_facty 
    860                            ztmp1(:) = RESHAPE( ztmp(:,:) , zdim1 ) 
    861                            CALL PIKSRT(nn_factx*nn_facty,ztmp1) 
    862                            ir=0 
    863                            jr=1 
    864                            DO WHILE( jr .LE. nn_factx*nn_facty ) 
    865                               IF( ztmp1(jr) == 0. ) THEN 
    866                                  ir=jr 
    867                                  jr=jr+1 
    868                               ELSE 
    869                                  EXIT 
    870                               ENDIF 
    871                            ENDDO 
    872                            IF( ir .LE. nn_factx*nn_facty-1 )THEN 
    873                               ALLOCATE( ztmp2(nn_factx*nn_facty-ir) ) 
    874                               ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty) 
    875                               jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1 
    876                               p_fld_crs(ii,ij,jk) = ztmp2(jr) 
    877                               DEALLOCATE( ztmp2 ) 
    878                            ELSE 
    879                               p_fld_crs(ii,ij,jk) = 0._wp 
    880                            ENDIF 
    881  
    882                         ENDDO 
    883                      ENDDO 
    884563                  ENDDO 
    885564               CASE DEFAULT 
    886565                    STOP 
    887                END SELECT 
    888  
    889               CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     566            END SELECT 
     567 
     568           CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    890569  
    891570         CASE ( 'SUM' ) 
     
    893572            CALL wrk_alloc( jpi, jpj, jpk, zsurfmsk ) 
    894573 
    895             SELECT CASE ( cd_type ) 
    896               CASE( 'W' ) 
    897                   IF( PRESENT( p_e3 ) ) THEN 
    898                     !cbr ????????????? 
    899                     !zsurfmsk(:,:,1) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)  
    900                     !DO jk = 2, jpk 
    901                     !  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1)  
    902                     !ENDDO 
    903                     DO jk = 1, jpk 
    904                       zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk)  
    905                     ENDDO 
    906                  ELSE 
    907                     !zsurfmsk(:,:,1) =  p_e12(:,:) * p_mask(:,:,1)  
    908                     !DO jk = 2, jpk 
    909                     !  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk-1)  
    910                     !ENDDO 
    911                     DO jk = 1, jpk 
    912                       zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk)  
    913                     ENDDO 
    914                  ENDIF 
    915               CASE DEFAULT 
    916                  IF( PRESENT( p_e3 ) ) THEN 
    917                     DO jk = 1, jpk 
    918                       zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk)  
    919                     ENDDO 
    920                  ELSE 
    921                     DO jk = 1, jpk 
    922                       zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk)  
    923                     ENDDO 
    924                  ENDIF 
    925               END SELECT 
     574            IF( PRESENT( p_e3 ) ) THEN 
     575               DO jk = 1, jpk 
     576                  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk)  
     577               ENDDO 
     578            ELSE 
     579               DO jk = 1, jpk 
     580                  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk)  
     581               ENDDO 
     582            ENDIF 
    926583 
    927584            SELECT CASE ( cd_type ) 
    928585             
    929586               CASE( 'T', 'W' ) 
    930           
    931                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    932                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    933                         je_2 = mje_crs(2) 
    934                         DO jk = 1, jpk            
    935                            DO ji = nistr, niend, nn_factx 
    936                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2           
    937                               zflcrs  =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk) & 
    938                                 &      + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk) & 
    939                                 &      + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk)  
    940                                ! 
    941                               p_fld_crs(ii,2,jk) = zflcrs 
    942                            ENDDO 
    943                         ENDDO 
    944                       ENDIF 
    945                   ELSE 
    946                      je_2 = mjs_crs(2) 
    947                      DO jk = 1, jpk            
    948                         DO ji = nistr, niend, nn_factx 
    949                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    950                            zflcrs  =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk)  & 
    951                              &      + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk)  & 
    952                              &      + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk)  & 
    953                              &      + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk)  & 
    954                              &      + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk)  & 
    955                              &      + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk)  & 
    956                              &      + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk)  & 
    957                              &      + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk)  & 
    958                              &      + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk)   
    959                             ! 
    960                             p_fld_crs(ii,2,jk) = zflcrs 
     587         
     588                  DO jk = 1, jpk 
     589                     DO jj  = nldj_crs,nlej_crs 
     590                        ijjs = mjs_crs(jj) 
     591                        ijje = mje_crs(jj) 
     592                        DO ji = nldi_crs, nlei_crs 
     593                           ijis = mis_crs(ji) 
     594                           ijie = mie_crs(ji) 
     595 
     596                           p_fld_crs(ji,jj,jk) = SUM( p_fld(ijis:ijie,ijjs:ijje,jk) * zsurfmsk(ijis:ijie,ijjs:ijje,jk) ) 
    961597                        ENDDO 
    962598                     ENDDO 
    963                   ENDIF 
    964                   ! 
    965                   DO jk = 1, jpk            
    966                      DO jj  = njstr, njend, nn_facty 
    967                         DO ji = nistr, niend, nn_factx 
    968                            ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    969                            ij  = ( jj - njstr ) * rfacty_r + 3 
    970                            zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk)  & 
    971                              &      + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk)  & 
    972                              &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk)  & 
    973                              &      + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk)  & 
    974                              &      + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk)  & 
    975                              &      + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk)  & 
    976                              &      + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk)  & 
    977                              &      + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk)  & 
    978                              &      + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)   
    979                             ! 
    980                             p_fld_crs(ii,ij,jk) = zflcrs 
    981                             !  
    982                         ENDDO       
    983                      ENDDO 
    984                   ENDDO    
    985              
     599                  ENDDO 
     600 
    986601               CASE( 'V' ) 
    987602 
     603 
    988604                  DO jk = 1, jpk 
    989                      DO ji = nistr, niend, nn_factx 
    990                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    991                         IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2 
    992                            IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 
    993                               jj = mje_crs(2) 
    994                               zflcrs  = p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) & 
    995                                &      + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) & 
    996                                &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) 
    997  
    998                               !zsfcrs = zsurfmsk(ji  ,jj  ,jk) & 
    999                               ! &     + zsurfmsk(ji+1,jj  ,jk) & 
    1000                               ! &     + zsurfmsk(ji+2,jj  ,jk) 
    1001  
    1002                               !IF( zsfcrs == 0 ) THEN  ; p_fld_crs(ii,2,jk) = zflcrs 
    1003                               !ELSE                    ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
    1004                               !ENDIF 
    1005                            ENDIF 
    1006                         ELSE 
    1007                            ijje = mje_crs(2) 
    1008                            zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) & 
    1009                              &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 
    1010                              &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 
    1011                            ! 
    1012                            !zsfcrs =  zsurfmsk(ji  ,ijje,jk) & 
    1013                            !  &     + zsurfmsk(ji+1,ijje,jk) & 
    1014                            !  &     + zsurfmsk(ji+2,ijje,jk) 
    1015  
    1016                            p_fld_crs(ii,2,jk) = zflcrs 
    1017                            !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 
    1018                            !ELSE                   ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
    1019                            !ENDIF 
    1020  
    1021                         ENDIF 
    1022  
    1023                         DO jj = njstr, njend, nn_facty 
    1024                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    1025                            ij   = ( jj - njstr ) * rfacty_r + 3 
    1026                            ijje = mje_crs(ij) 
    1027                            ijie = mie_crs(ii) 
    1028                            !                   
    1029                            zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) & 
    1030                              &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 
    1031                              &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk)  
    1032                            ! 
    1033                            !zsfcrs =  zsurfmsk(ji  ,ijje,jk)  & 
    1034                            !  &     + zsurfmsk(ji+1,ijje,jk)  & 
    1035                            !  &     + zsurfmsk(ji+2,ijje,jk)  
    1036  
    1037                            p_fld_crs(ii,ij,jk) = zflcrs 
    1038                            !cbr1 
    1039                !iji=117 ; ijj=210 
    1040                !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
    1041                !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
    1042                !WRITE(narea+5000,*)"OPE V =======> " 
    1043                !WRITE(narea+5000,*)ii,ij,jk 
    1044                !WRITE(narea+5000,*)ji,jj,ijje 
    1045                !WRITE(narea+5000,*)p_fld(ji  ,ijje,jk) 
    1046                !WRITE(narea+5000,*)p_fld(ji+1,ijje,jk) 
    1047                !WRITE(narea+5000,*)p_fld(ji+2,ijje,jk) 
    1048                !WRITE(narea+5000,*)zflcrs 
    1049                !ENDIF 
    1050  
    1051                            !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs 
    1052                            !ELSE                   ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
    1053                            !ENDIF 
    1054                            ! 
    1055                !IF( ii==iji .AND. ij==ijj .AND. jk==74 )WRITE(narea+5000,*)" p_fld_crs(ii,ij,jk) = ", p_fld_crs(ii,ij,jk) 
     605                     DO jj  = nldj_crs,nlej_crs 
     606                        ijjs = mjs_crs(jj) 
     607                        ijje = mje_crs(jj) 
     608                        DO ji = nldi_crs, nlei_crs 
     609                           ijis = mis_crs(ji) 
     610                           ijie = mie_crs(ji) 
     611 
     612                           p_fld_crs(ji,jj,jk) = SUM( p_fld(ijis:ijie,ijje,jk) * zsurfmsk(ijis:ijie,ijje,jk) ) 
    1056613                        ENDDO 
    1057614                     ENDDO 
    1058615                  ENDDO 
    1059   
     616 
    1060617               CASE( 'U' ) 
    1061618 
    1062                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1063                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1064                         je_2 = mje_crs(2) 
    1065                         DO jk = 1, jpk            
    1066                            DO ji = nistr, niend, nn_factx 
    1067                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
    1068                               ijie = mie_crs(ii) 
    1069                               zflcrs  =  p_fld(ijie,je_2,jk) * zsurfmsk(ijie,je_2,jk)   
    1070                               p_fld_crs(ii,2,jk) = zflcrs 
    1071                            ENDDO 
    1072                         ENDDO 
    1073                       ENDIF 
    1074                   ELSE 
    1075                      je_2 = mjs_crs(2) 
    1076                      DO jk = 1, jpk            
    1077                         DO ji = nistr, niend, nn_factx 
    1078                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    1079                            ijie = mie_crs(ii) 
    1080                            zflcrs =  p_fld(ijie,je_2  ,jk) * zsurfmsk(ijie,je_2  ,jk)  & 
    1081                              &     + p_fld(ijie,je_2+1,jk) * zsurfmsk(ijie,je_2+1,jk)  & 
    1082                              &     + p_fld(ijie,je_2+2,jk) * zsurfmsk(ijie,je_2+2,jk)  
    1083  
    1084                            p_fld_crs(ii,2,jk) = zflcrs 
     619                  DO jk = 1, jpk 
     620                     DO jj  = nldj_crs,nlej_crs 
     621                        ijjs = mjs_crs(jj) 
     622                        ijje = mje_crs(jj) 
     623                        DO ji = nldi_crs, nlei_crs 
     624                           ijis = mis_crs(ji) 
     625                           ijie = mie_crs(ji) 
     626 
     627                           p_fld_crs(ji,jj,jk) = SUM( p_fld(ijie,ijjs:ijje,jk) * zsurfmsk(ijie,ijjs:ijje,jk) ) 
    1085628                        ENDDO 
    1086629                     ENDDO 
    1087                   ENDIF 
    1088                   ! 
    1089                   DO jk = 1, jpk            
    1090                      DO jj  = njstr, njend, nn_facty 
    1091                         DO ji = nistr, niend, nn_factx 
    1092                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1093                            ij   = ( jj - njstr ) * rfacty_r + 3 
    1094                            ijie = mie_crs(ii) 
    1095                            zflcrs =  p_fld(ijie,jj  ,jk) * zsurfmsk(ijie,jj  ,jk)  & 
    1096                               &    + p_fld(ijie,jj+1,jk) * zsurfmsk(ijie,jj+1,jk)  & 
    1097                               &    + p_fld(ijie,jj+2,jk) * zsurfmsk(ijie,jj+2,jk)  
    1098                              ! 
    1099                            p_fld_crs(ii,ij,jk) = zflcrs 
    1100                            !  
    1101                         ENDDO       
    1102                      ENDDO 
    1103                   ENDDO    
     630                  ENDDO 
    1104631 
    1105632              END SELECT 
     
    1109636              ENDIF 
    1110637 
    1111          !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) end SUM = ",p_fld(17,5,74) 
    1112638              CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk ) 
    1113639 
     
    1116642            CALL wrk_alloc( jpi, jpj, jpk, zmask ) 
    1117643 
    1118             SELECT CASE ( cd_type ) 
    1119               CASE( 'W' ) 
    1120                   zmask(:,:,1) = p_mask(:,:,1)  
    1121                   DO jk = 2, jpk 
    1122                      zmask(:,:,jk) = p_mask(:,:,jk-1)  
    1123                   ENDDO 
    1124               CASE ( 'T' ) 
    1125                   DO jk = 1, jpk 
    1126                      zmask(:,:,jk) = p_mask(:,:,jk)  
    1127                   ENDDO 
    1128             END SELECT 
     644            DO jk = 1, jpk 
     645               zmask(:,:,jk) = p_mask(:,:,jk)  
     646            ENDDO 
    1129647 
    1130648            SELECT CASE ( cd_type ) 
    1131649             
    1132650               CASE( 'T', 'W' ) 
    1133           
    1134                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1135                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1136                         je_2 = mje_crs(2) 
    1137                         DO jk = 1, jpk            
    1138                            DO ji = nistr, niend, nn_factx 
    1139                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2         
    1140                               zflcrs =  & 
    1141                                 & MAX( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) - ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  & 
    1142                                 &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) - ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  & 
    1143                                 &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) - ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  ) 
    1144                               ! 
    1145                               p_fld_crs(ii,2,jk) = zflcrs 
    1146                            ENDDO 
    1147                         ENDDO 
    1148                       ENDIF 
    1149                   ELSE 
    1150                      je_2 = mjs_crs(2) 
    1151                      DO jk = 1, jpk            
    1152                         DO ji = nistr, niend, nn_factx 
    1153                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    1154                            zflcrs =  & 
    1155                              & MAX( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) - ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  & 
    1156                              &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) - ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  & 
    1157                              &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) - ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  & 
    1158                              &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) - ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  & 
    1159                              &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) - ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  & 
    1160                              &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) - ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  & 
    1161                              &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) - ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  & 
    1162                              &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) - ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  & 
    1163                              &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) - ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   ) 
    1164                            ! 
    1165                            p_fld_crs(ii,2,jk) = zflcrs 
     651         
     652                  DO jk = 1, jpk 
     653                     DO jj  = nldj_crs,nlej_crs 
     654                        ijjs = mjs_crs(jj) 
     655                        ijje = mje_crs(jj) 
     656                        DO ji = nldi_crs, nlei_crs 
     657                           ijis = mis_crs(ji) 
     658                           ijie = mie_crs(ji) 
     659                           p_fld_crs(ji,jj,jk) = MAXVAL( p_fld(ijis:ijie,ijjs:ijje,jk) * zmask(ijis:ijie,ijjs:ijje,jk) - & 
     660                                                       & ( ( 1._wp - zmask(ijis:ijie,ijjs:ijje,jk))* r_inf )                ) 
    1166661                        ENDDO 
    1167662                     ENDDO 
    1168                   ENDIF 
    1169                   ! 
    1170                   DO jk = 1, jpk            
    1171                      DO jj  = njstr, njend, nn_facty 
    1172                         DO ji = nistr, niend, nn_factx 
    1173                            ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1174                            ij  = ( jj - njstr ) * rfacty_r + 3 
    1175                            zflcrs =  & 
    1176                              & MAX( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) - ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  & 
    1177                              &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) - ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  & 
    1178                              &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) - ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  & 
    1179                              &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) - ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  & 
    1180                              &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) - ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  & 
    1181                              &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) - ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  & 
    1182                              &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) - ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  & 
    1183                              &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) - ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  & 
    1184                              &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) - ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   ) 
    1185                            ! 
    1186                            p_fld_crs(ii,ij,jk) = zflcrs 
    1187                            ! 
    1188                         ENDDO       
    1189                      ENDDO 
    1190                   ENDDO    
    1191              
     663                  ENDDO 
     664  
    1192665               CASE( 'V' ) 
    1193  
    1194 !                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1195 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1196 !                        ijje = mje_crs(2) 
    1197 !                      ENDIF 
    1198 !                  ELSE 
    1199 !                     ijje = mjs_crs(2) 
    1200 !                  ENDIF 
    1201 ! 
    1202 !                  DO jk = 1, jpk 
    1203 !                     DO ji = nistr, niend, nn_factx 
    1204 !                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1205 !                        zflcrs = & 
    1206 !                          & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1207 !                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1208 !                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    1209 !                          ! 
    1210 !                        p_fld_crs(ii,2,jk) = zflcrs 
    1211 !                     ENDDO 
    1212 !                  ENDDO 
    1213 !                  ! 
    1214 !                  DO jk = 1, jpk            
    1215 !                     DO jj  = njstr, njend, nn_facty 
    1216 !                        DO ji = nistr, niend, nn_factx 
    1217 !                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1218 !                           ij  = ( jj - njstr ) * rfacty_r + 3 
    1219 !                           ijje = mje_crs(ij) 
    1220 !                           !                   
    1221 !                           zflcrs = & 
    1222 !                             & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1223 !                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1224 !                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    1225 !                           ! 
    1226 !                           p_fld_crs(ii,ij,jk) = zflcrs 
    1227 !                           ! 
    1228 !                        ENDDO       
    1229 !                     ENDDO 
    1230 !                  ENDDO    
    1231666                  CALL ctl_stop('MAX operator and V case not available') 
    1232667             
    1233668               CASE( 'U' ) 
    1234  
    1235 !                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1236 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1237 !                        je_2 = mje_crs(2) 
    1238 !                        DO jk = 1, jpk            
    1239 !                           DO ji = nistr, niend, nn_factx 
    1240 !                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
    1241 !                              ijie = mie_crs(ii) 
    1242 !                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
    1243 !                              ! 
    1244 !                              p_fld_crs(ii,2,jk) = zflcrs 
    1245 !                            ENDDO 
    1246 !                        ENDDO 
    1247 !                      ENDIF 
    1248 !                  ELSE 
    1249 !                     je_2 = mjs_crs(2) 
    1250 !                     DO jk = 1, jpk            
    1251 !                        DO ji = nistr, niend, nn_factx 
    1252 !                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    1253 !                           ijie = mie_crs(ii) 
    1254 !                           zflcrs = & 
    1255 !                             & MAX( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    1256 !                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    1257 !                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
    1258 !                            ! 
    1259 !                           p_fld_crs(ii,2,jk) = zflcrs 
    1260 !                        ENDDO 
    1261 !                     ENDDO 
    1262 !                  ENDIF 
    1263 !                  ! 
    1264 !                  DO jk = 1, jpk            
    1265 !                     DO jj  = njstr, njend, nn_facty 
    1266 !                        DO ji = nistr, niend, nn_factx 
    1267 !                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1268 !                           ij   = ( jj - njstr ) * rfacty_r + 3 
    1269 !                           ijie = mie_crs(ii) 
    1270 !                           zflcrs =  & 
    1271 !                             & MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    1272 !                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    1273 !                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf  ) 
    1274 !                           !  
    1275 !                           p_fld_crs(ii,ij,jk) = zflcrs 
    1276 !                           !  
    1277 !                        ENDDO       
    1278 !                     ENDDO 
    1279 !                  ENDDO    
    1280669                  CALL ctl_stop('MAX operator and U case not available') 
    1281670 
    1282               END SELECT 
    1283  
    1284               CALL wrk_dealloc( jpi, jpj, jpk, zmask ) 
     671            END SELECT 
     672 
     673            CALL wrk_dealloc( jpi, jpj, jpk, zmask ) 
    1285674 
    1286675         CASE ( 'MIN' )      !   Search the min of unmasked grid cells 
    1287676 
    1288677            CALL wrk_alloc( jpi, jpj, jpk, zmask ) 
    1289  
    1290             !SELECT CASE ( cd_type ) 
    1291             !  CASE( 'W' ) 
    1292             !      !cbr ????????????????????????????? 
    1293             !      zmask(:,:,1) = p_mask(:,:,1)  
    1294             !      DO jk = 2, jpk 
    1295             !         zmask(:,:,jk) = p_mask(:,:,jk-1)  
    1296             !      ENDDO 
    1297             !  CASE ( 'T' ) 
     678            DO jk = 1, jpk 
     679               zmask(:,:,jk) = p_mask(:,:,jk) 
     680            ENDDO 
     681 
     682            SELECT CASE ( cd_type ) 
     683 
     684               CASE( 'T', 'W' ) 
     685 
    1298686                  DO jk = 1, jpk 
    1299                      zmask(:,:,jk) = p_mask(:,:,jk)  
    1300                   ENDDO 
    1301             !END SELECT 
    1302  
    1303             SELECT CASE ( cd_type ) 
    1304  
    1305                CASE( 'T', 'W' ) 
    1306           
    1307                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1308                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1309                         je_2 = mje_crs(2) 
    1310                         DO jk = 1, jpk            
    1311                            DO ji = nistr, niend, nn_factx 
    1312                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2         
    1313                               zflcrs =  & 
    1314                                 & MIN( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) + ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  & 
    1315                                 &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) + ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  & 
    1316                                 &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) + ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  ) 
    1317                               ! 
    1318                               p_fld_crs(ii,2,jk) = zflcrs 
    1319                            ENDDO 
    1320                         ENDDO 
    1321                       ENDIF 
    1322                   ELSE 
    1323                      je_2 = mjs_crs(2) 
    1324                      DO jk = 1, jpk            
    1325                         DO ji = nistr, niend, nn_factx 
    1326                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    1327                            zflcrs =  & 
    1328                              & MIN( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) + ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  & 
    1329                              &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) + ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  & 
    1330                              &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) + ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  & 
    1331                              &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) + ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  & 
    1332                              &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) + ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  & 
    1333                              &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) + ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  & 
    1334                              &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) + ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  & 
    1335                              &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) + ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  & 
    1336                              &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) + ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   ) 
    1337                            ! 
    1338                            p_fld_crs(ii,2,jk) = zflcrs 
     687                     DO jj  = nldj_crs,nlej_crs 
     688                        ijjs = mjs_crs(jj) 
     689                        ijje = mje_crs(jj) 
     690                        DO ji = nldi_crs, nlei_crs 
     691                           ijis = mis_crs(ji) 
     692                           ijie = mie_crs(ji) 
     693 
     694                           p_fld_crs(ji,jj,jk) = MINVAL( p_fld(ijis:ijie,ijjs:ijje,jk) * zmask(ijis:ijie,ijjs:ijje,jk) + & 
     695                                                       & ( 1._wp - zmask(ijis:ijie,ijjs:ijje,jk)* r_inf )                ) 
    1339696                        ENDDO 
    1340697                     ENDDO 
    1341                   ENDIF 
    1342                   ! 
    1343                   DO jk = 1, jpk            
    1344                      DO jj  = njstr, njend, nn_facty 
    1345                         DO ji = nistr, niend, nn_factx 
    1346                            ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1347                            ij  = ( jj - njstr ) * rfacty_r + 3 
    1348                            zflcrs =  & 
    1349                              & MIN( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) + ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  & 
    1350                              &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) + ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  & 
    1351                              &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) + ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  & 
    1352                              &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) + ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  & 
    1353                              &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) + ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  & 
    1354                              &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) + ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  & 
    1355                              &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) + ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  & 
    1356                              &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) + ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  & 
    1357                              &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) + ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   ) 
    1358                            ! 
    1359                            p_fld_crs(ii,ij,jk) = zflcrs 
    1360                            ! 
    1361                         ENDDO       
    1362                      ENDDO 
    1363                   ENDDO    
     698                  ENDDO 
     699 
    1364700             
    1365701               CASE( 'V' ) 
    1366  
    1367 !                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1368 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1369 !                        ijje = mje_crs(2) 
    1370 !                      ENDIF 
    1371 !                  ELSE 
    1372 !                     ijje = mjs_crs(2) 
    1373 !                  ENDIF 
    1374 ! 
    1375 !                  DO jk = 1, jpk 
    1376 !                     DO ji = nistr, niend, nn_factx 
    1377 !                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1378 !                        zflcrs = & 
    1379 !                          & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1380 !                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1381 !                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    1382 !                          ! 
    1383 !                        p_fld_crs(ii,2,jk) = zflcrs 
    1384 !                     ENDDO 
    1385 !                  ENDDO 
    1386 !                  ! 
    1387 !                  DO jk = 1, jpk            
    1388 !                     DO jj  = njstr, njend, nn_facty 
    1389 !                        DO ji = nistr, niend, nn_factx 
    1390 !                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1391 !                           ij  = ( jj - njstr ) * rfacty_r + 3 
    1392 !                           ijje = mje_crs(ij) 
    1393 !                           zflcrs = & 
    1394 !                             & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1395 !                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1396 !                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    1397 !                           ! 
    1398 !                           p_fld_crs(ii,ij,jk) = zflcrs 
    1399 !                           ! 
    1400 !                        ENDDO       
    1401 !                     ENDDO 
    1402 !                  ENDDO    
    1403702                  CALL ctl_stop('MIN operator and V case not available') 
    1404  
    1405703             
    1406704               CASE( 'U' ) 
    1407  
    1408 !                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1409 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1410 !                        je_2 = mje_crs(2) 
    1411 !                        DO jk = 1, jpk            
    1412 !                           DO ji = nistr, niend, nn_factx 
    1413 !                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
    1414 !                              ijie = mie_crs(ii) 
    1415 !                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
    1416 !                              ! 
    1417 !                              p_fld_crs(ii,2,jk) = zflcrs 
    1418 !                            ENDDO 
    1419 !                        ENDDO 
    1420 !                      ENDIF 
    1421 !                  ELSE 
    1422 !                     je_2 = mjs_crs(2) 
    1423 !                     DO jk = 1, jpk            
    1424 !                        DO ji = nistr, niend, nn_factx 
    1425 !                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    1426 !                           ijie = mie_crs(ii) 
    1427 !                           zflcrs = & 
    1428 !                             & MIN( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    1429 !                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    1430 !                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
    1431 !                            ! 
    1432 !                           p_fld_crs(ii,2,jk) = zflcrs 
    1433 !                        ENDDO 
    1434 !                     ENDDO 
    1435 !                  ENDIF 
    1436 !                  ! 
    1437 !                  DO jk = 1, jpk            
    1438 !                     DO jj  = njstr, njend, nn_facty 
    1439 !                        DO ji = nistr, niend, nn_factx 
    1440 !                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1441 !                           ij   = ( jj - njstr ) * rfacty_r + 3 
    1442 !                           ijie = mie_crs(ii) 
    1443 !                           zflcrs = & 
    1444 !                             & MIN( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    1445 !                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    1446 !                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf  ) 
    1447 !                           !  
    1448 !                           p_fld_crs(ii,ij,jk) = zflcrs 
    1449 !                           !  
    1450 !                        ENDDO       
    1451 !                     ENDDO 
    1452 !                  ENDDO    
    1453705                  CALL ctl_stop('MIN operator and U case not available') 
    1454706           
     
    1459711         END SELECT 
    1460712         ! 
    1461          !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) avt lbc = ",p_fld(17,5,74) 
    1462713         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn ) 
    1463          !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) apr lbc = ",p_fld(17,5,74) 
    1464714         ! 
    1465715    END SUBROUTINE crs_dom_ope_3d 
     
    1504754      !! Local variables 
    1505755      INTEGER  :: ji, jj, jk                 ! dummy loop indices 
    1506       INTEGER  :: ijie, ijje, ii, ij, je_2 
     756      INTEGER ::  ijis, ijie, ijjs, ijje 
    1507757      REAL(wp) :: zflcrs, zsfcrs    
    1508758      REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk    
     
    1515765       
    1516766        CASE ( 'VOL' ) 
    1517        
     767 
    1518768            CALL wrk_alloc( jpi, jpj, zsurfmsk ) 
    1519769            zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
    1520770 
    1521             IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1522                IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1523                   je_2 = mje_crs(2) 
    1524                   DO ji = nistr, niend, nn_factx 
    1525                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
    1526                      zflcrs =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2)   & 
    1527                        &     + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2)   & 
    1528                        &     + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2)  
    1529  
    1530                      zsfcrs =  zsurfmsk(ji,je_2) + zsurfmsk(ji+1,je_2) + zsurfmsk(ji+2,je_2)  
    1531                      ! 
    1532                      p_fld_crs(ii,2) = zflcrs 
    1533                      IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs 
    1534                   ENDDO 
    1535                ENDIF 
    1536             ELSE 
    1537                je_2 = mjs_crs(2) 
    1538                DO ji = nistr, niend, nn_factx 
    1539                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    1540                   zflcrs =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  ) & 
    1541                     &     + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  ) & 
    1542                     &     + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  ) & 
    1543                     &     + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1) & 
    1544                     &     + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1) & 
    1545                     &     + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1) & 
    1546                     &     + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2) & 
    1547                     &     + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2) & 
    1548                     &     + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2)  
    1549  
    1550                    zsfcrs =  zsurfmsk(ji,je_2  ) + zsurfmsk(ji+1,je_2  ) + zsurfmsk(ji+2,je_2  ) & 
    1551                      &     + zsurfmsk(ji,je_2+1) + zsurfmsk(ji+1,je_2+1) + zsurfmsk(ji+2,je_2+1) & 
    1552                      &     + zsurfmsk(ji,je_2+2) + zsurfmsk(ji+1,je_2+2) + zsurfmsk(ji+2,je_2+2)  
    1553                     ! 
    1554                     p_fld_crs(ii,2) = zflcrs 
    1555                     IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs 
    1556                 ENDDO 
    1557             ENDIF 
    1558                   ! 
    1559             DO jj  = njstr, njend, nn_facty 
    1560                DO ji = nistr, niend, nn_factx 
    1561                   ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1562                   ij  = ( jj - njstr ) * rfacty_r + 3 
    1563                   zflcrs =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  ) & 
    1564                     &     + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  ) & 
    1565                     &     + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  ) & 
    1566                     &     + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1) & 
    1567                     &     + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1) & 
    1568                     &     + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1) & 
    1569                     &     + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2) & 
    1570                     &     + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2) & 
    1571                     &     + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2)  
    1572    
    1573                   zsfcrs =  zsurfmsk(ji,jj  ) + zsurfmsk(ji+1,jj  ) + zsurfmsk(ji+2,jj  ) & 
    1574                     &     + zsurfmsk(ji,jj+1) + zsurfmsk(ji+1,jj+1) + zsurfmsk(ji+2,jj+1) & 
    1575                     &     + zsurfmsk(ji,jj+2) + zsurfmsk(ji+1,jj+2) + zsurfmsk(ji+2,jj+2)  
    1576                    ! 
    1577                   p_fld_crs(ii,ij) = zflcrs 
    1578                   IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij) = zflcrs / zsfcrs 
    1579                ENDDO       
    1580             ENDDO 
    1581  
     771            DO jj  = nldj_crs,nlej_crs 
     772               ijjs = mjs_crs(jj) 
     773               ijje = mje_crs(jj) 
     774               DO ji = nldi_crs, nlei_crs 
     775                  ijis = mis_crs(ji) 
     776                  ijie = mie_crs(ji) 
     777 
     778                  zflcrs = SUM( p_fld(ijis:ijie,ijjs:ijje) * zsurfmsk(ijis:ijie,ijjs:ijje) ) 
     779                  zsfcrs = SUM(                              zsurfmsk(ijis:ijie,ijjs:ijje) ) 
     780 
     781                  p_fld_crs(ji,jj) = zflcrs 
     782                  IF( zsfcrs /= 0.0 )  p_fld_crs(ji,jj) = zflcrs / zsfcrs 
     783               ENDDO 
     784            ENDDO 
    1582785            CALL wrk_dealloc( jpi, jpj, zsurfmsk ) 
     786            ! 
    1583787 
    1584788         CASE ( 'SUM' ) 
     
    1595799               CASE( 'T', 'W' ) 
    1596800 
    1597                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1598                       IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1599                          je_2 = mje_crs(2) 
    1600                          DO ji = nistr, niend, nn_factx 
    1601                             ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1602                             zflcrs  =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2) & 
    1603                               &      + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2) & 
    1604                               &      + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2)  
    1605                               ! 
    1606                              p_fld_crs(ii,2) = zflcrs 
    1607                          ENDDO 
    1608                       ENDIF 
    1609                    ELSE 
    1610                       je_2 = mjs_crs(2) 
    1611                       DO ji = nistr, niend, nn_factx 
    1612                          ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1613                          zflcrs  =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  )  & 
    1614                            &      + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  )  & 
    1615                            &      + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  )  & 
    1616                            &      + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1)  & 
    1617                            &      + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1)  & 
    1618                            &      + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1)  & 
    1619                            &      + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2)  & 
    1620                            &      + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2)  & 
    1621                            &      + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2)   
    1622                             ! 
    1623                             p_fld_crs(ii,2) = zflcrs 
    1624                       ENDDO 
    1625                    ENDIF 
    1626                    ! 
    1627                    DO jj = njstr, njend, nn_facty 
    1628                       DO ji = nistr, niend, nn_factx 
    1629                          ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1630                          ij   = ( jj - njstr ) * rfacty_r + 3 
    1631                          zflcrs  =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  )  & 
    1632                            &      + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  )  & 
    1633                            &      + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  )  & 
    1634                            &      + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1)  & 
    1635                            &      + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1)  & 
    1636                            &      + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1)  & 
    1637                            &      + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2)  & 
    1638                            &      + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2)  & 
    1639                            &      + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2)   
    1640                           ! 
    1641                           p_fld_crs(ii,ij) = zflcrs 
    1642                           !  
    1643                       ENDDO       
    1644                    ENDDO 
     801                  DO jj  = nldj_crs,nlej_crs 
     802                     ijjs = mjs_crs(jj) 
     803                     ijje = mje_crs(jj) 
     804                     DO ji = nldi_crs, nlei_crs 
     805                        ijis = mis_crs(ji) 
     806                        ijie = mie_crs(ji) 
     807                        p_fld_crs(ji,jj) = SUM( p_fld(ijis:ijie,ijjs:ijje) * zsurfmsk(ijis:ijie,ijjs:ijje) ) 
     808                     ENDDO 
     809                  ENDDO 
    1645810             
    1646811               CASE( 'V' ) 
    1647                    DO ji = nistr, niend, nn_factx 
    1648                       ii  = ( ji - mis_crs(2) ) * rfactx_r + 2 
    1649                       IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2 
    1650                          IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 
    1651                             jj = mje_crs(2) 
    1652                             zflcrs  = p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  )  & 
    1653                              &      + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  )  & 
    1654                              &      + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  ) 
    1655                             p_fld_crs(ii,2) = zflcrs 
    1656                          ENDIF 
    1657                       ELSE 
    1658                          ijje = mje_crs(2) 
    1659                          zflcrs  = p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje)  & 
    1660                            &     + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje)  & 
    1661                            &     + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 
    1662                          ! 
    1663                          p_fld_crs(ii,2) = zflcrs 
    1664                       ENDIF 
    1665  
    1666                       DO jj = njstr, njend, nn_facty 
    1667                          ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    1668                          ij   = ( jj - njstr ) * rfacty_r + 3 
    1669                          ijje = mje_crs(ij) 
    1670                          ijie = mie_crs(ii) 
    1671                          !                   
    1672                          zflcrs  = p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje)  & 
    1673                           &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje)  & 
    1674                           &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 
    1675                          ! 
    1676                          p_fld_crs(ii,ij) = zflcrs 
    1677                          ! 
    1678                       ENDDO 
    1679                    ENDDO 
    1680              
     812 
     813                  DO jj  = nldj_crs,nlej_crs 
     814                     ijjs = mjs_crs(jj) 
     815                     ijje = mje_crs(jj) 
     816                     DO ji = nldi_crs, nlei_crs 
     817                        ijis = mis_crs(ji) 
     818                        ijie = mie_crs(ji) 
     819                        p_fld_crs(ji,jj) = SUM( p_fld(ijis:ijie,ijje) * zsurfmsk(ijis:ijie,ijje) ) 
     820                     ENDDO 
     821                  ENDDO 
     822 
    1681823               CASE( 'U' ) 
    1682824 
    1683                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1684                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1685                         je_2 = mje_crs(2) 
    1686                         DO ji = nistr, niend, nn_factx 
    1687                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1688                            ijie = mie_crs(ii) 
    1689                            zflcrs  =  p_fld(ijie,je_2) * zsurfmsk(ijie,je_2)   
    1690                            p_fld_crs(ii,2) = zflcrs 
    1691                         ENDDO 
    1692                      ENDIF 
    1693                   ELSE 
    1694                      je_2 = mjs_crs(2) 
    1695                      DO ji = nistr, niend, nn_factx 
    1696                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1697                         ijie = mie_crs(ii) 
    1698                         zflcrs =  p_fld(ijie,je_2  ) * zsurfmsk(ijie,je_2  )  & 
    1699                           &     + p_fld(ijie,je_2+1) * zsurfmsk(ijie,je_2+1)  & 
    1700                           &     + p_fld(ijie,je_2+2) * zsurfmsk(ijie,je_2+2)  
    1701     
    1702                         p_fld_crs(ii,2) = zflcrs 
     825                  DO jj  = nldj_crs,nlej_crs 
     826                     ijjs = mjs_crs(jj) 
     827                     ijje = mje_crs(jj) 
     828                     DO ji = nldi_crs, nlei_crs 
     829                        ijis = mis_crs(ji) 
     830                        ijie = mie_crs(ji) 
     831                        p_fld_crs(ji,jj) = SUM( p_fld(ijie,ijjs:ijje) * zsurfmsk(ijie,ijjs:ijje) ) 
    1703832                     ENDDO 
    1704                  ENDIF 
    1705  
    1706                  DO jj = njstr, njend, nn_facty 
    1707                     DO ji = nistr, niend, nn_factx 
    1708                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1709                        ij   = ( jj - njstr ) * rfacty_r + 3 
    1710                        ijie = mie_crs(ii) 
    1711                        zflcrs =  p_fld(ijie,jj  ) * zsurfmsk(ijie,jj  )  & 
    1712                           &    + p_fld(ijie,jj+1) * zsurfmsk(ijie,jj+1)  & 
    1713                           &    + p_fld(ijie,jj+2) * zsurfmsk(ijie,jj+2)  
    1714                          ! 
    1715                        p_fld_crs(ii,ij) = zflcrs 
    1716                        !  
    1717                     ENDDO       
    1718                  ENDDO 
     833                  ENDDO 
    1719834 
    1720835              END SELECT 
     
    1731846             
    1732847               CASE( 'T', 'W' ) 
    1733    
    1734                    DO ji = nistr, niend, nn_factx 
    1735                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1736                       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1737                          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1738                             je_2 = mje_crs(2) 
    1739                             zflcrs =  & 
    1740                               & MAX( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) - ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  & 
    1741                               &      p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  & 
    1742                               &      p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  ) 
    1743                             ! 
    1744                             p_fld_crs(ii,2) = zflcrs 
    1745                          ENDIF 
    1746                       ELSE 
    1747                          je_2 = mjs_crs(2)  
    1748                          zflcrs =  & 
    1749                            &  MAX( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) - ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  & 
    1750                            &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) - ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  & 
    1751                            &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) - ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  & 
    1752                            &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) - ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  & 
    1753                            &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) - ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  & 
    1754                            &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) - ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  & 
    1755                            &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) - ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  & 
    1756                            &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) - ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  & 
    1757                            &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) - ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   ) 
    1758                          ! 
    1759                          p_fld_crs(ii,2) = zflcrs 
    1760                       ENDIF 
    1761  
    1762                       DO jj = njstr, njend, nn_facty 
    1763                          ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1764                          ij   = ( jj - njstr ) * rfacty_r + 3 
    1765                          zflcrs = & 
    1766                           &  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) - ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  & 
    1767                           &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) - ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  & 
    1768                           &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) - ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  & 
    1769                           &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) - ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  & 
    1770                           &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) - ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  & 
    1771                           &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) - ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  & 
    1772                           &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) - ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  & 
    1773                           &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) - ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  & 
    1774                           &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) - ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   ) 
    1775                          ! 
    1776                          p_fld_crs(ii,ij) = zflcrs 
    1777                          ! 
    1778                       ENDDO       
    1779                    ENDDO 
     848  
     849                  DO jj  = nldj_crs,nlej_crs 
     850                     ijjs = mjs_crs(jj) 
     851                     ijje = mje_crs(jj) 
     852                     DO ji = nldi_crs, nlei_crs 
     853                        ijis = mis_crs(ji) 
     854                        ijie = mie_crs(ji) 
     855                        p_fld_crs(ji,jj) = MAXVAL( p_fld(ijis:ijie,ijjs:ijje) * p_mask(ijis:ijie,ijjs:ijje,1) - & 
     856                                                 & ( 1._wp - p_mask(ijis:ijie,ijjs:ijje,1) )                    ) 
     857                     ENDDO 
     858                  ENDDO 
    1780859             
    1781860               CASE( 'V' ) 
    1782  
    1783 !                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1784 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1785 !                        ijje = mje_crs(2) 
    1786 !                      ENDIF 
    1787 !                  ELSE 
    1788 !                     ijje = mjs_crs(2) 
    1789 !                  ENDIF 
    1790 ! 
    1791 !                  DO ji = nistr, niend, nn_factx 
    1792 !                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1793 !                     zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1794 !                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1795 !                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1796 !                       ! 
    1797 !                     p_fld_crs(ii,2) = zflcrs 
    1798 !                  ENDDO       
    1799 !                  DO jj = njstr, njend, nn_facty 
    1800 !                     DO ji = nistr, niend, nn_factx 
    1801 !                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1802 !                        ij   = ( jj - njstr ) * rfacty_r + 3                
    1803 !                        ijje = mje_crs(ij)  
    1804 !                        !                   
    1805 !                        zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1806 !                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1807 !                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1808 !                        ! 
    1809 !                        p_fld_crs(ii,ij) = zflcrs 
    1810 !                        ! 
    1811 !                     ENDDO       
    1812 !                  ENDDO 
    1813861                  CALL ctl_stop('MAX operator and V case not available') 
    1814862             
    1815863               CASE( 'U' ) 
    1816  
    1817 !                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1818 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1819 !                        je_2 = mje_crs(2) 
    1820 !                        DO ji = nistr, niend, nn_factx 
    1821 !                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1822 !                           ijie = mie_crs(ii) 
    1823 !                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
    1824 !                           p_fld_crs(ii,2) = zflcrs 
    1825 !                        ENDDO 
    1826 !                     ENDIF 
    1827 !                 ELSE 
    1828 !                     je_2 = mjs_crs(2) 
    1829 !                     DO ji = nistr, niend, nn_factx 
    1830 !                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1831 !                        ijie = mie_crs(ii) 
    1832 !                        zflcrs =  & 
    1833 !                          &  MAX( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1834 !                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1835 !                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
    1836 !                        p_fld_crs(ii,2) = zflcrs 
    1837 !                     ENDDO 
    1838 !                 ENDIF 
    1839 !                 DO jj = njstr, njend, nn_facty 
    1840 !                    DO ji = nistr, niend, nn_factx 
    1841 !                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1842 !                       ij   = ( jj - njstr ) * rfacty_r + 3 
    1843 !                       ijie = mie_crs(ii) 
    1844 !                       zflcrs =  & 
    1845 !                         &  MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1846 !                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1847 !                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
    1848 !                        p_fld_crs(ii,ij) = zflcrs 
    1849 !                        !  
    1850 !                     ENDDO       
    1851 !                  ENDDO 
    1852864                  CALL ctl_stop('MAX operator and U case not available') 
    1853865 
     
    1859871 
    1860872              CASE( 'T', 'W' ) 
    1861    
    1862                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1863                       IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1864                          je_2 = mje_crs(2) 
    1865                          DO ji = nistr, niend, nn_factx 
    1866                             ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1867                             zflcrs =  & 
    1868                               & MIN( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) + ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  & 
    1869                              &       p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) + ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  & 
    1870                              &       p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) + ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  ) 
    1871                             ! 
    1872                             p_fld_crs(ii,2) = zflcrs 
    1873                          ENDDO 
    1874                       ENDIF 
    1875                    ELSE 
    1876                       DO ji = nistr, niend, nn_factx 
    1877                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1878                       je_2 = mjs_crs(2)  
    1879                       zflcrs =  & 
    1880                         &  MIN( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) + ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  & 
    1881                         &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) + ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  & 
    1882                         &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) + ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  & 
    1883                         &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) + ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  & 
    1884                         &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) + ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  & 
    1885                         &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) + ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  & 
    1886                         &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) + ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  & 
    1887                         &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) + ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  & 
    1888                         &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) + ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   ) 
    1889                       ! 
    1890                       p_fld_crs(ii,2) = zflcrs 
    1891                       ENDDO 
    1892                    ENDIF 
    1893  
    1894                    DO jj = njstr, njend, nn_facty 
    1895                       DO ji = nistr, niend, nn_factx 
    1896                          ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1897                          ij   = ( jj - njstr ) * rfacty_r + 3 
    1898                          zflcrs = & 
    1899                           &  MIN( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) + ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  & 
    1900                           &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) + ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  & 
    1901                           &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) + ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  & 
    1902                           &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) + ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  & 
    1903                           &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) + ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  & 
    1904                           &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) + ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  & 
    1905                           &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) + ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  & 
    1906                           &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) + ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  & 
    1907                           &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) + ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   ) 
    1908                          ! 
    1909                          p_fld_crs(ii,ij) = zflcrs 
    1910                          ! 
    1911                       ENDDO       
    1912                    ENDDO 
     873 
     874                  DO jj  = nldj_crs,nlej_crs 
     875                     ijjs = mjs_crs(jj) 
     876                     ijje = mje_crs(jj) 
     877                     DO ji = nldi_crs, nlei_crs 
     878                        ijis = mis_crs(ji) 
     879                        ijie = mie_crs(ji) 
     880                        p_fld_crs(ji,jj) = MINVAL( p_fld(ijis:ijie,ijjs:ijje) * p_mask(ijis:ijie,ijjs:ijje,1) + & 
     881                                                 & ( 1._wp - p_mask(ijis:ijie,ijjs:ijje,1) )                    ) 
     882                     ENDDO 
     883                  ENDDO 
    1913884             
    1914885               CASE( 'V' ) 
    1915  
    1916 !                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1917 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1918 !                        ijje = mje_crs(2) 
    1919 !                      ENDIF 
    1920 !                  ELSE 
    1921 !                     ijje = mjs_crs(2) 
    1922 !                  ENDIF 
    1923 ! 
    1924 !                  DO ji = nistr, niend, nn_factx 
    1925 !                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1926 !                     zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1927 !                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1928 !                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1929 !                       ! 
    1930 !                     p_fld_crs(ii,2) = zflcrs 
    1931 !                  ENDDO       
    1932 !                  DO jj = njstr, njend, nn_facty 
    1933 !                     DO ji = nistr, niend, nn_factx 
    1934 !                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1935 !                        ij   = ( jj - njstr ) * rfacty_r + 3                
    1936 !                        ijje = mje_crs(ij)  
    1937 !                        !                   
    1938 !                        zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1939 !                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1940 !                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1941 !                        ! 
    1942 !                        p_fld_crs(ii,ij) = zflcrs 
    1943 !                        ! 
    1944 !                     ENDDO       
    1945 !                  ENDDO 
    1946886                  CALL ctl_stop('MIN operator and V case not available') 
    1947887             
    1948888               CASE( 'U' ) 
    1949  
    1950 !                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1951 !                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1952 !                        je_2 = mje_crs(2) 
    1953 !                        DO ji = nistr, niend, nn_factx 
    1954 !                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1955 !                           ijie = mie_crs(ii) 
    1956 !                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
    1957 !  
    1958 !                           p_fld_crs(ii,2) = zflcrs 
    1959 !                        ENDDO 
    1960 !                     ENDIF 
    1961 !                 ELSE 
    1962 !                     je_2 = mjs_crs(2) 
    1963 !                     DO ji = nistr, niend, nn_factx 
    1964 !                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1965 !                        ijie = mie_crs(ii) 
    1966 !                        zflcrs =  & 
    1967 !                          &  MIN( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1968 !                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1969 !                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
    1970 !                        p_fld_crs(ii,2) = zflcrs 
    1971 !                     ENDDO 
    1972 !                 ENDIF 
    1973 !                 DO jj = njstr, njend, nn_facty 
    1974 !                    DO ji = nistr, niend, nn_factx 
    1975 !                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1976 !                       ij   = ( jj - njstr ) * rfacty_r + 3 
    1977 !                       ijie = mie_crs(ii) 
    1978 !                       zflcrs =  & 
    1979 !                         &  MIN( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1980 !                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1981 !                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
    1982 !                        p_fld_crs(ii,ij) = zflcrs 
    1983 !                        !  
    1984 !                     ENDDO       
    1985 !                  ENDDO 
    1986889                  CALL ctl_stop('MIN operator and U case not available') 
    1987890 
     
    1994897   END SUBROUTINE crs_dom_ope_2d 
    1995898 
    1996    SUBROUTINE crs_dom_e3( p_e1, p_e2, p_e3, p_sfc_crs, cd_type, p_mask, p_e3_crs, p_e3_max_crs) 
     899   SUBROUTINE crs_dom_e3( p_e1, p_e2, p_e3, p_sfc_2d_crs,  p_sfc_3d_crs, cd_type, p_mask, p_e3_crs, p_e3_max_crs) 
    1997900      !!----------------------------------------------------------------   
     901      !! 
     902      !! 
     903      !! 
     904      !! 
     905      !!---------------------------------------------------------------- 
    1998906      !!  Arguments 
    1999       CHARACTER(len=1),                         INTENT(in) :: cd_type      ! grid type T, W ( U, V, F) 
    2000       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_mask       ! Parent grid T mask 
    2001       REAL(wp), DIMENSION(jpi,jpj)    ,         INTENT(in) :: p_e1, p_e2   ! 2D tracer T or W on parent grid 
    2002       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_e3         ! 3D tracer T or W on parent grid 
    2003       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: p_sfc_crs ! Coarse grid box east or north face quantity 
    2004       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_crs ! Coarse grid box east or north face quantity  
    2005       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_max_crs ! Coarse grid box east or north face quantity  
     907      CHARACTER(len=1),                         INTENT(in)          :: cd_type           ! grid type T, W ( U, V, F) 
     908      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)          :: p_mask            ! Parent grid T mask 
     909      REAL(wp), DIMENSION(jpi,jpj)    ,         INTENT(in)          :: p_e1, p_e2        ! 2D tracer T or W on parent grid 
     910      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)          :: p_e3              ! 3D tracer T or W on parent grid 
     911      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in),OPTIONAL :: p_sfc_2d_crs      ! Coarse grid box east or north face quantity 
     912      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in),OPTIONAL :: p_sfc_3d_crs      ! Coarse grid box east or north face quantity 
     913      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)       :: p_e3_crs          ! Coarse grid box east or north face quantity  
     914      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)       :: p_e3_max_crs      ! Coarse grid box east or north face quantity  
    2006915 
    2007916      !! Local variables 
    2008917      INTEGER ::  ji, jj, jk                   ! dummy loop indices 
    2009       INTEGER ::  ijie, ijje, ii, ij, je_2 
     918      INTEGER ::  ijis, ijie, ijjs, ijje  
    2010919      REAL(wp) :: ze3crs   
    2011       !REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf    
    2012920 
    2013921      !!----------------------------------------------------------------   
    2014  
    2015        p_e3_crs    (:,:,:) = 0. 
    2016        p_e3_max_crs(:,:,:) = 1. 
     922      p_e3_crs    (:,:,:) = 0._wp 
     923      p_e3_max_crs(:,:,:) = 0._wp 
    2017924    
    2018925 
    2019        !CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf ) 
    2020  
    2021        SELECT CASE ( cd_type ) 
     926      SELECT CASE ( cd_type ) 
    2022927 
    2023928         CASE ('T') 
    2024929 
    2025             DO jk = 1 , jpk 
    2026                DO ji = nistr, niend, nn_factx 
    2027  
    2028                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2029                   IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
    2030  
    2031                   IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2032  
    2033                     jj = mje_crs(2) 
    2034  
    2035  
    2036                     ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
    2037                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
    2038                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)) 
    2039  
    2040                     p_e3_max_crs(ii,2,jk) = ze3crs 
    2041  
    2042                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
    2043                         &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
    2044                         &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
    2045  
    2046  
    2047                     p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2048                   ENDIF 
    2049                   ELSE 
    2050                      jj = mjs_crs(2) 
    2051  
    2052                      ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
    2053                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
    2054                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
    2055                         &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  & 
    2056                         &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  & 
    2057                         &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
    2058                         &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
    2059                         &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
    2060                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
    2061  
    2062                      p_e3_max_crs(ii,2,jk) = ze3crs 
    2063  
    2064                      ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
    2065                         &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
    2066                         &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
    2067                         &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  & 
    2068                         &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  & 
    2069                         &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
    2070                         &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
    2071                         &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
    2072                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
    2073  
    2074                        p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2075                   ENDIF 
    2076  
    2077                   DO jj = njstr, njend, nn_facty 
    2078                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    2079                      ij   = ( jj - njstr ) * rfacty_r + 3 
    2080                      ijje = mje_crs(ij) 
    2081                      ijie = mie_crs(ii) 
    2082                      !   
    2083                      ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
    2084                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
    2085                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
    2086                         &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  & 
    2087                         &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  & 
    2088                         &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
    2089                         &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
    2090                         &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
    2091                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
    2092  
    2093                      p_e3_max_crs(ii,ij,jk) = ze3crs 
    2094                      ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
    2095                         &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
    2096                         &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
    2097                         &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  & 
    2098                         &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  & 
    2099                         &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
    2100                         &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
    2101                         &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
    2102                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
    2103  
    2104                        p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     930            DO jk = 1, jpk 
     931               DO ji = nldi_crs, nlei_crs 
     932 
     933                  ijis = mis_crs(ji) 
     934                  ijie = mie_crs(ji) 
     935 
     936                  DO jj = nldj_crs, nlej_crs 
     937 
     938                     ijjs = mjs_crs(jj) 
     939                     ijje = mje_crs(jj) 
     940 
     941                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) ) 
     942 
     943                     ze3crs = SUM( p_e1(ijis:ijie,ijjs:ijje) * p_e2(ijis:ijie,ijjs:ijje) * p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) ) 
     944                     IF( p_sfc_3d_crs(ji,jj,jk) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_3d_crs(ji,jj,jk) 
    2105945 
    2106946                  ENDDO 
     
    2110950         CASE ('U') 
    2111951 
    2112          DO jk = 1 , jpk 
    2113                DO ji = nistr, niend, nn_factx 
    2114                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2115                   IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
    2116  
    2117                      IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2118  
    2119                     jj = mje_crs(2) 
    2120  
    2121  
    2122                     ze3crs = p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) 
    2123  
    2124                     p_e3_max_crs(ii,2,jk) = ze3crs 
    2125  
    2126                     ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
    2127  
    2128  
    2129                      p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2130                      ENDIF 
    2131                   ELSE 
    2132                      jj = mjs_crs(2) 
    2133  
    2134                      ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
    2135                                    p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
    2136                                    p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
    2137  
    2138                      p_e3_max_crs(ii,2,jk) = ze3crs 
    2139  
    2140                      ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
    2141                         &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
    2142                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
    2143  
    2144                        p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2145                   ENDIF 
    2146                   DO jj = njstr, njend, nn_facty 
    2147                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    2148                      ij   = ( jj - njstr ) * rfacty_r + 3 
    2149                      ijje = mje_crs(ij) 
    2150                      ijie = mie_crs(ii) 
    2151                      !   
    2152                      ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
    2153                         &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
    2154                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
    2155  
    2156                      p_e3_max_crs(ii,ij,jk) = ze3crs 
    2157  
    2158                      ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
    2159                         &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
    2160                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
    2161  
    2162                        p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
    2163  
     952            DO jk = 1, jpk 
     953               DO ji = nldi_crs, nlei_crs 
     954 
     955                  ijis = mis_crs(ji) 
     956                  ijie = mie_crs(ji) 
     957 
     958                  DO jj = nldj_crs, nlej_crs 
     959 
     960                     ijjs = mjs_crs(jj) 
     961                     ijje = mje_crs(jj) 
     962 
     963                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijie,ijjs:ijje,jk) * p_mask(ijie,ijjs:ijje,jk) ) 
     964 
     965                     ze3crs = SUM( p_e2(ijie,ijjs:ijje) * p_e3(ijie,ijjs:ijje,jk) * p_mask(ijie,ijjs:ijje,jk) ) 
     966                     IF( p_sfc_2d_crs(ji,jj) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_2d_crs(ji,jj) 
    2164967                  ENDDO 
    2165968               ENDDO 
     
    2167970 
    2168971         CASE ('V') 
    2169          DO jk = 1 , jpk 
    2170                DO ji = nistr, niend, nn_factx 
    2171  
    2172                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2173                   IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
    2174  
    2175                      IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2176  
    2177                     jj = mje_crs(2) 
    2178  
    2179  
    2180                     ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
    2181                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
    2182                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)) 
    2183  
    2184                     p_e3_max_crs(ii,2,jk) = ze3crs 
    2185  
    2186                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
    2187                         &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
    2188                         &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
    2189  
    2190  
    2191                      p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2192                      ENDIF 
    2193                   ELSE 
    2194                      jj = mjs_crs(2) 
    2195  
    2196                      ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
    2197                         &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
    2198                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
    2199  
    2200                      p_e3_max_crs(ii,2,jk) = ze3crs 
    2201  
    2202                      ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
    2203                         &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
    2204                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
    2205  
    2206                        p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2207                   ENDIF 
    2208  
    2209                   DO jj = njstr, njend, nn_facty 
    2210                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    2211                      ij   = ( jj - njstr ) * rfacty_r + 3 
    2212                      ijje = mje_crs(ij) 
    2213                      ijie = mie_crs(ii) 
    2214                      !   
    2215                      ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
    2216                         &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
    2217                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
    2218  
    2219                      p_e3_max_crs(ii,ij,jk) = ze3crs 
    2220  
    2221                      ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
    2222                         &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
    2223                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
    2224  
    2225                        p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     972 
     973            DO jk = 1, jpk 
     974               DO ji = nldi_crs, nlei_crs 
     975 
     976                  ijis = mis_crs(ji) 
     977                  ijie = mie_crs(ji) 
     978 
     979                  DO jj = nldj_crs, nlej_crs 
     980 
     981                     ijjs = mjs_crs(jj) 
     982                     ijje = mje_crs(jj) 
     983 
     984                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijis:ijie,ijje,jk) * p_mask(ijis:ijie,ijje,jk) ) 
     985 
     986                     ze3crs = SUM( p_e1(ijis:ijie,ijje) * p_e3(ijis:ijie,ijje,jk) * p_mask(ijis:ijie,ijje,jk) ) 
     987                     IF( p_sfc_2d_crs(ji,jj) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_2d_crs(ji,jj) 
    2226988 
    2227989                  ENDDO 
    2228990               ENDDO 
    2229991            ENDDO 
     992 
    2230993         CASE ('W') 
    2231994 
    2232             DO jk = 2 , jpk 
    2233                DO ji = nistr, niend, nn_factx 
    2234                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2235                IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
    2236  
    2237                  IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2238  
    2239                     jj = mje_crs(2) 
    2240  
    2241  
    2242                     ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
    2243                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
    2244                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)) 
    2245  
    2246                      p_e3_max_crs(ii,2,jk) = ze3crs 
    2247  
    2248                      ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  & 
    2249                         &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  & 
    2250                         &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) 
    2251  
    2252  
    2253                        p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2254                   ENDIF 
    2255                ELSE 
    2256                   jj = mjs_crs(2) 
    2257  
    2258                   ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
    2259                      &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
    2260                      &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  & 
    2261                      &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  & 
    2262                      &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  & 
    2263                      &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  & 
    2264                      &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  & 
    2265                      &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  & 
    2266                      &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 
    2267  
    2268                   p_e3_max_crs(ii,2,jk) = ze3crs 
    2269                   ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  & 
    2270                      &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  & 
    2271                      &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  & 
    2272                      &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  & 
    2273                      &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  & 
    2274                      &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  & 
    2275                      &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  & 
    2276                      &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  & 
    2277                      &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 
    2278  
    2279                   p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    2280                ENDIF 
    2281  
    2282  
    2283                   DO jj = njstr, njend, nn_facty 
    2284                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    2285                      ij   = ( jj - njstr ) * rfacty_r + 3 
    2286                      ijje = mje_crs(ij) 
    2287                      ijie = mie_crs(ii) 
    2288                      !   
    2289                      ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
    2290                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
    2291                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  & 
    2292                         &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  & 
    2293                         &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  & 
    2294                         &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  & 
    2295                         &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  & 
    2296                         &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  & 
    2297                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 
    2298  
    2299                      p_e3_max_crs(ii,ij,jk) = ze3crs 
    2300  
    2301                      ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  & 
    2302                         &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  & 
    2303                         &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  & 
    2304                         &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  & 
    2305                         &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  & 
    2306                         &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  & 
    2307                         &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  & 
    2308                         &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  & 
    2309                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 
    2310  
    2311                        p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     995            DO jk = 1, jpk 
     996               DO ji = nldi_crs, nlei_crs 
     997 
     998                  ijis = mis_crs(ji) 
     999                  ijie = mie_crs(ji) 
     1000 
     1001                  DO jj = nldj_crs, nlej_crs 
     1002 
     1003                     ijjs = mjs_crs(jj) 
     1004                     ijje = mje_crs(jj) 
     1005 
     1006                     p_e3_max_crs(ji,jj,jk) = MAXVAL( p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) ) 
     1007 
     1008                     ze3crs = SUM( p_e1(ijis:ijie,ijjs:ijje) * p_e2(ijis:ijie,ijjs:ijje) * p_e3(ijis:ijie,ijjs:ijje,jk) * p_mask(ijis:ijie,ijjs:ijje,jk) ) 
     1009                     IF( p_sfc_3d_crs(ji,jj,jk) .NE. 0._wp )p_e3_crs(ji,jj,jk) = ze3crs / p_sfc_3d_crs(ji,jj,jk) 
    23121010 
    23131011                  ENDDO 
     
    23151013            ENDDO 
    23161014 
    2317  
    2318             !first level 
    2319             DO ji = nistr, niend, nn_factx 
    2320                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2321                IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
    2322  
    2323                  IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2324  
    2325                     jj = mje_crs(2) 
    2326  
    2327                     ze3crs = MAX(  p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
    2328                         &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
    2329                         &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)) 
    2330  
    2331                     p_e3_max_crs(ii,2,1) = ze3crs 
    2332  
    2333                     ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  & 
    2334                         &      p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  & 
    2335                         &      p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) 
    2336  
    2337                     p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1) 
    2338                   ENDIF 
    2339                ELSE 
    2340                   jj = mjs_crs(2) 
    2341  
    2342                   ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
    2343                      &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
    2344                      &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  & 
    2345                      &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  & 
    2346                      &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  & 
    2347                      &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  & 
    2348                      &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  & 
    2349                      &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  & 
    2350                      &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) ) 
    2351  
    2352                   p_e3_max_crs(ii,2,1) = ze3crs 
    2353                   ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  & 
    2354                         &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  & 
    2355                         &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  & 
    2356                         &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  & 
    2357                         &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  & 
    2358                         &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  & 
    2359                         &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  & 
    2360                         &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  & 
    2361                         &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 
    2362  
    2363                    p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1) 
    2364  
    2365                ENDIF 
    2366                DO jj = njstr, njend, nn_facty 
    2367                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    2368                   ij   = ( jj - njstr ) * rfacty_r + 3 
    2369                   ijje = mje_crs(ij) 
    2370                   ijie = mie_crs(ii) 
    2371                   !   
    2372                   ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
    2373                      &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
    2374                      &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  & 
    2375                      &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  & 
    2376                      &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  & 
    2377                      &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  & 
    2378                      &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  & 
    2379                      &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  & 
    2380                      &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) ) 
    2381  
    2382                   p_e3_max_crs(ii,ij,1) = ze3crs 
    2383  
    2384                    ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  & 
    2385                         &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  & 
    2386                         &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  & 
    2387                         &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  & 
    2388                         &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  & 
    2389                         &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  & 
    2390                         &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  & 
    2391                         &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  & 
    2392                         &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 
    2393  
    2394                        p_e3_crs(ii,ij,1) = ze3crs / p_sfc_crs(ii,ij,1) 
    2395  
    2396                ENDDO 
    2397             ENDDO 
    2398         !               
    2399        END SELECT 
    2400  
    2401          CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 
    2402          CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 ) 
    2403        !               
    2404        !CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask ) 
    2405        ! 
     1015      END SELECT 
     1016 
     1017      CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 
     1018      CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 ) 
     1019 
    24061020   END SUBROUTINE crs_dom_e3 
    24071021 
    2408    SUBROUTINE crs_dom_sfc( p_mask, cd_type, p_surf_crs, p_surf_crs_msk,  p_e1, p_e2, p_e3 ) 
    2409  
     1022   SUBROUTINE crs_dom_sfc(p_mask, cd_type, p_surf_crs, p_surf_crs_msk,  p_e1, p_e2, p_e3 ) 
     1023      !!========================================================================================= 
     1024      !! 
     1025      !! 
     1026      !!========================================================================================= 
    24101027      !!  Arguments 
    24111028      CHARACTER(len=1),                         INTENT(in)           :: cd_type      ! grid type T, W ( U, V, F) 
     
    24181035      !! Local variables 
    24191036      INTEGER  :: ji, jj, jk                   ! dummy loop indices 
    2420       INTEGER  :: ii, ij, je_2 
    2421       INTEGER  :: iji,ijj 
     1037      INTEGER  :: ijis,ijie,ijjs,ijje 
    24221038      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk    
    24231039      !!----------------------------------------------------------------   
     
    24341050               zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:)  
    24351051            ENDDO 
    2436             !zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1)  
    2437             !cbr DO jk = 2, jpk 
    2438             DO jk = 1, jpk 
    2439                !cbr zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1)  
    2440                zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
    2441             ENDDO 
    24421052 
    24431053         CASE ('V')      
     
    24451055               zsurf(:,:,jk) = p_e1(:,:) * p_e3(:,:,jk)  
    24461056            ENDDO 
    2447             DO jk = 1, jpk 
    2448                zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
    2449             ENDDO 
    2450  
     1057  
    24511058         CASE ('U')      
    24521059            DO jk = 1, jpk 
    24531060               zsurf(:,:,jk) = p_e2(:,:) * p_e3(:,:,jk)  
    24541061            ENDDO 
    2455             DO jk = 1, jpk 
    2456                zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
    2457             ENDDO 
    24581062 
    24591063         CASE DEFAULT 
     
    24611065               zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:)  
    24621066            ENDDO 
     1067      END SELECT 
     1068 
     1069      DO jk = 1, jpk 
     1070         zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
     1071      ENDDO 
     1072 
     1073      SELECT CASE ( cd_type ) 
     1074 
     1075         CASE ('W') 
     1076 
    24631077            DO jk = 1, jpk 
    2464                zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
    2465             ENDDO 
     1078               DO jj = nldj_crs,nlej_crs 
     1079                  ijjs=mjs_crs(jj) 
     1080                  ijje=mje_crs(jj) 
     1081                  DO ji = nldi_crs,nlei_crs 
     1082                     ijis=mis_crs(ji) 
     1083                     ijie=mie_crs(ji) 
     1084                     p_surf_crs    (ji,jj,jk) =  SUM(zsurf   (ijis:ijie,ijjs:ijje,jk) ) 
     1085                     p_surf_crs_msk(ji,jj,jk) =  SUM(zsurfmsk(ijis:ijie,ijjs:ijje,jk) ) 
     1086                  ENDDO       
     1087               ENDDO 
     1088            ENDDO    
     1089 
     1090         CASE ('U') 
     1091 
     1092            DO jk = 1, jpk 
     1093               DO jj = nldj_crs,nlej_crs 
     1094                  ijjs=mjs_crs(jj) 
     1095                  ijje=mje_crs(jj) 
     1096                  DO ji = nldi_crs,nlei_crs 
     1097                     ijis=mis_crs(ji) 
     1098                     ijie=mie_crs(ji) 
     1099                     p_surf_crs    (ji,jj,jk) =  SUM(zsurf   (ijie,ijjs:ijje,jk) ) 
     1100                     p_surf_crs_msk(ji,jj,jk) =  SUM(zsurfmsk(ijie,ijjs:ijje,jk) ) 
     1101                  ENDDO 
     1102               ENDDO 
     1103            ENDDO 
     1104 
     1105         CASE ('V') 
     1106 
     1107            DO jk = 1, jpk 
     1108               DO jj = nldj_crs,nlej_crs 
     1109                  ijjs=mjs_crs(jj) 
     1110                  ijje=mje_crs(jj) 
     1111                  DO ji = nldi_crs,nlei_crs 
     1112                     ijis=mis_crs(ji) 
     1113                     ijie=mie_crs(ji) 
     1114                     p_surf_crs    (ji,jj,jk) =  SUM(zsurf   (ijis:ijie,ijje,jk) ) 
     1115                     p_surf_crs_msk(ji,jj,jk) =  SUM(zsurfmsk(ijis:ijie,ijje,jk) ) 
     1116                  ENDDO 
     1117               ENDDO 
     1118            ENDDO 
     1119 
    24661120      END SELECT 
    24671121 
    2468       !WRITE(narea+200,*)"TOTO",nldj_crs,mjs_crs(1), mje_crs(1),mjs_crs(2), mje_crs(2),mjs_crs(3), mje_crs(3),mjs_crs(4), mje_crs(4) ; CALL FLUSH(narea+200) 
    2469  
    2470       SELECT CASE ( cd_type ) 
    2471  
    2472       CASE ('W') 
    2473  
    2474       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    2475          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2476             je_2 = mje_crs(2) 
    2477             DO jk = 1, jpk 
    2478                DO ji = nistr, niend, nn_factx 
    2479                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
    2480                   !     
    2481                   p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) & 
    2482                     &                      + zsurf(ji,je_2-1,jk) + zsurf(ji+1,je_2-1,jk) + zsurf(ji+2,je_2-1,jk)  ! Why ????? 
    2483                   ! 
    2484                   p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk)  
    2485                   ! 
    2486                ENDDO 
    2487             ENDDO 
    2488          ENDIF 
    2489       ELSE 
    2490          je_2 = mjs_crs(2) 
    2491          DO jk = 1, jpk 
    2492             DO ji = nistr, niend, nn_factx 
    2493                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
    2494                !   
    2495                p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk)  & 
    2496                     &                   + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk)  & 
    2497                     &                   + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)   
    2498  
    2499                p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2  ,jk) + zsurfmsk(ji+1,je_2  ,jk) + zsurfmsk(ji+2,je_2  ,jk)  & 
    2500                     &                   + zsurfmsk(ji,je_2+1,jk) + zsurfmsk(ji+1,je_2+1,jk) + zsurfmsk(ji+2,je_2+1,jk)  & 
    2501                     &                   + zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk)   
    2502                 ENDDO 
    2503             ENDDO 
    2504       ENDIF 
    2505           
    2506       DO jk = 1, jpk 
    2507          DO jj = njstr, njend, nn_facty 
    2508             DO ji = nistr, niend, nn_factx 
    2509                ii = ( ji - mis_crs(2) ) * rfactx_r + 2   
    2510                ij = ( jj - njstr ) * rfacty_r + 3 
    2511                ! 
    2512                p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk)  & 
    2513                     &                    + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk)  & 
    2514                     &                    + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)   
    2515                p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj  ,jk) + zsurfmsk(ji+1,jj  ,jk) + zsurfmsk(ji+2,jj  ,jk)  & 
    2516                     &                    + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk)  & 
    2517                     &                    + zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk)   
    2518  
    2519             ENDDO       
    2520          ENDDO 
    2521       ENDDO    
    2522  
    2523       CASE ('U') 
    2524  
    2525      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    2526          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2527             je_2 = mje_crs(2) 
    2528             DO jk = 1, jpk 
    2529                DO ji = nistr, niend, nn_factx 
    2530                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2531                   !     
    2532                   p_surf_crs    (ii,2,jk) =  zsurf(ji+2,je_2  ,jk) 
    2533                   ! 
    2534                   p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji+2,je_2,jk) 
    2535                   ! 
    2536                ENDDO 
    2537             ENDDO 
    2538          ENDIF 
    2539       ELSE 
    2540          je_2 = mjs_crs(2) 
    2541          DO jk = 1, jpk 
    2542             DO ji = nistr, niend, nn_factx 
    2543                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2544                !   
    2545                p_surf_crs    (ii,2,jk) =  zsurf(ji+2,je_2  ,jk)  & 
    2546                     &                   + zsurf(ji+2,je_2+1,jk)  & 
    2547                     &                   + zsurf(ji+2,je_2+2,jk) 
    2548  
    2549                p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji+2,je_2  ,jk)  & 
    2550                     &                   + zsurfmsk(ji+2,je_2+1,jk)  & 
    2551                     &                   + zsurfmsk(ji+2,je_2+2,jk) 
    2552                 ENDDO 
    2553             ENDDO 
    2554       ENDIF 
    2555  
    2556       DO jk = 1, jpk 
    2557          DO jj = njstr, njend, nn_facty 
    2558             DO ji = nistr, niend, nn_factx 
    2559                ii = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2560                ij = ( jj - njstr ) * rfacty_r + 3 
    2561                ! 
    2562                p_surf_crs    (ii,ij,jk) =  zsurf(ji+2,jj  ,jk)  & 
    2563                     &                    + zsurf(ji+2,jj+1,jk)  & 
    2564                     &                    + zsurf(ji+2,jj+2,jk) 
    2565                p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji+2,jj  ,jk)  & 
    2566                     &                    + zsurfmsk(ji+2,jj+1,jk)  & 
    2567                     &                    + zsurfmsk(ji+2,jj+2,jk) 
    2568             ENDDO 
    2569          ENDDO 
    2570       ENDDO 
    2571  
    2572       CASE ('V') 
    2573  
    2574       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    2575          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    2576             je_2 = mje_crs(2) 
    2577             DO jk = 1, jpk 
    2578                DO ji = nistr, niend, nn_factx 
    2579                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2580                   !     
    2581                   p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) 
    2582                   ! 
    2583                   p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk) 
    2584                   ! 
    2585                ENDDO 
    2586             ENDDO 
    2587          ENDIF 
    2588       ELSE 
    2589          je_2 = mjs_crs(2) 
    2590          DO jk = 1, jpk 
    2591             DO ji = nistr, niend, nn_factx 
    2592                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2593                !   
    2594                p_surf_crs    (ii,2,jk) = zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk) 
    2595                p_surf_crs_msk(ii,2,jk) = zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk) 
    2596             ENDDO 
    2597          ENDDO 
    2598       ENDIF 
    2599  
    2600       DO jk = 1, jpk 
    2601          DO jj = njstr, njend, nn_facty 
    2602             DO ji = nistr, niend, nn_factx 
    2603                ii = ( ji - mis_crs(2) ) * rfactx_r + 2 
    2604                ij = ( jj - njstr ) * rfacty_r + 3 
    2605                ! 
    2606                p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 
    2607                p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk) 
    2608                !iji=117 ; ijj=210 
    2609                !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
    2610                !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
    2611                !WRITE(narea+5000,*)"SFC V =======> " 
    2612                !WRITE(narea+5000,*)ii,ij,jk 
    2613                !WRITE(narea+5000,*)ji,jj 
    2614                !WRITE(narea+5000,*)zsurfmsk(ji,jj+2,jk),zsurfmsk(ji+1,jj+2,jk),zsurfmsk(ji+2,jj+2,jk) 
    2615                !WRITE(narea+5000,*)p_surf_crs    (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 
    2616                !ENDIF 
    2617             ENDDO 
    2618          ENDDO 
    2619       ENDDO 
    2620  
    2621      END SELECT 
    2622       !DO jk=1,jpk 
    2623       !DO ji=1,jpi_crs 
    2624       !DO jj=1,jpj_crs 
    2625       !   IF( p_surf_crs_msk(ji,jj,jk) .NE. p_surf_crs_msk(ji,jj,jk) )WRITE(narea+200,*)"SFC 4 ",ji,jj,jk,p_surf_crs_msk(ji,jj,jk)  ; call flush(narea+200) 
    2626       !ENDDO 
    2627       !ENDDO 
    2628       !ENDDO 
    2629       CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 ) 
    2630       CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
     1122      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0 ) !cbr , pval=1.0 ) 
     1123      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0 ) !cbr , pval=1.0 ) 
    26311124 
    26321125      CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     
    26471140      INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices 
    26481141      INTEGER  :: ierr                                ! allocation error status 
    2649       INTEGER :: ii,ij,iproc,iprocno,iprocso,iimppt_crs 
     1142      INTEGER :: iproci,iprocj,iproc,iprocno,iprocso,iimppt_crs 
     1143      INTEGER :: ii_start,ii_end,ij_start,ij_end 
    26501144  
    26511145   
     
    26541148  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj 
    26551149  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3 
    2656       jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3 
     1150      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 2 
    26571151      jpiglo_crsm1 = jpiglo_crs - 1 
    26581152      jpjglo_crsm1 = jpjglo_crs - 1   
    26591153 
    26601154      jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci 
    2661       jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj    
    2662       !WRITE(narea+200,*)"jpj_crs noso = ", jpj_crs , noso         
    2663       IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors   ! celle qui est faite de zeros 
    2664       !WRITE(narea+200,*)"jpj_crs = ", jpj_crs 
     1155      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj 
     1156!cbr?      IF( njmpp==1 )THEN 
     1157!         jpj_crs=jpj_crs+1 
     1158!      ENDIF 
     1159 
    26651160        
    26661161      jpi_crsm1   = jpi_crs - 1 
     
    26951190        ! mpp_ini2 
    26961191        !============================================================================================== 
    2697  
    2698         !cbr 
    2699         DO jn = 1, jpnij 
    2700            !WRITE(narea+200,*)"=====> jn",jn  ; call flush(narea+200) 
    2701  
    2702            !proc jn 
    2703            DO ji = 1 , jpni 
    2704               DO jj = 1 ,jpnj 
    2705                  IF( nfipproc(ji,jj)  == jn-1 )THEN 
    2706                     ii=ji 
    2707                     ij=jj 
    2708                  ENDIF 
    2709               ENDDO  
    2710            ENDDO  
    2711            iproc =  ii + jpni * ( ij-1 ) - 1 
    2712            ! mppini :   
    2713            !iprocso =  ii + jpni * ( ij-2 ) - 1  
    2714            ! mppini2:           
    2715            IF( ij .GT. 1 )THEN ; iprocso =  nfipproc(ii,ij-1) 
    2716            ELSE                ; iprocso =  -1 
     1192        DO ji = 1 , jpni 
     1193           DO jj = 1 ,jpnj 
     1194              IF( nfipproc(ji,jj)  == narea-1 )THEN 
     1195                 iproci=ji 
     1196                 iprocj=jj 
     1197              ENDIF 
     1198           ENDDO 
     1199        ENDDO 
     1200 
     1201        !WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 
     1202        !WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 
     1203        !WRITE(narea+8000-1,*)"nowe noea",nowe,noea 
     1204        !WRITE(narea+8000-1,*)"noso nono",noso,nono 
     1205        !WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 
     1206        !WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 
     1207        !WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 
     1208        !WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 
     1209        !WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 
     1210        !WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi        ,nlei         ,nlci 
     1211        !WRITE(narea+8000-1,*)"glo jpi nldi,nlei      ",jpi, nldi+nimpp-1,nlei+nimpp-1 
     1212        !WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj        ,nlej         ,nlcj 
     1213        !WRITE(narea+8000-1,*)"glo jpj nldj,nlej      ",jpj, nldj+njmpp-1,nlej+njmpp-1 
     1214        !WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 
     1215        !WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 
     1216        !WRITE(narea+8000-1,*)"jpni  jpnj jpnij ",jpni,jpnj,jpnij 
     1217        !WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 
     1218        !========================================================================== 
     1219        ! dim along I 
     1220        !========================================================================== 
     1221        SELECT CASE ( nperio ) 
     1222        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold 
     1223 
     1224           DO ji=1,jpiglo_crs 
     1225              ijis=nn_factx*(ji-1)-2 
     1226              ijie=nn_factx*(ji-1) 
     1227              mis2_crs(ji)=ijis 
     1228              mie2_crs(ji)=ijie 
     1229           ENDDO 
     1230 
     1231           ji=1 
     1232           DO WHILE( mis2_crs(ji) - nimpp + 1 .LT. 1 )  
     1233              ji=ji+1 
     1234              IF( ji==jpiglo_crs )EXIT 
     1235           END DO 
     1236           ijis=ji 
     1237 
     1238           !mjs2_crs(ijis)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 
     1239           !ijis          =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur 
     1240           !ii_start      =indice local de mjs2_crs(jj) 
     1241           ii_start = mis2_crs(ijis)-nimpp+1 
     1242           nimpp_crs = ijis-1 
     1243 
     1244           nldi_crs = 2 
     1245           IF( nowe == -1 )THEN 
     1246 
     1247               mie2_crs(ijis-1) = mis2_crs(ijis)-1 
     1248               
     1249               SELECT CASE(ii_start) 
     1250                  CASE(1) 
     1251                     nldi_crs=2 
     1252                     mie2_crs(ijis-1) = -1 
     1253                     mis2_crs(ijis-1) = -1 
     1254                  CASE(2) 
     1255!CBR?                     nldi_crs=1 
     1256                     nldi_crs=2 
     1257                     mis2_crs(ijis-1) = mie2_crs(ijis-1) 
     1258                  CASE(3) 
     1259!CBR?                     nldi_crs=1 
     1260                     nldi_crs=2 
     1261                     mis2_crs(ijis-1) = mie2_crs(ijis-1) -1 
     1262                  CASE DEFAULT 
     1263                     WRITE(narea+8000-1,*)"WRONG VALUE FOR iistart ",ii_start 
     1264               END SELECT 
     1265 
     1266           ENDIF 
     1267 
     1268           IF( nimpp==1 )nimpp_crs=1 
     1269 
     1270           !---------------------------------------- 
     1271           ji=jpiglo_crs 
     1272           DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. jpi ) 
     1273              ji=ji-1 
     1274              IF( ji==1 )EXIT 
     1275           END DO 
     1276           ijie=ji 
     1277           nlei_crs=ijie-nimpp_crs+1 
     1278           nlci_crs=nlei_crs+jpreci 
     1279 
     1280           !---------------------------------------- 
     1281           DO ji = 1, jpi_crs 
     1282              mig_crs(ji) = ji + nimpp_crs - 1 
     1283           ENDDO 
     1284           DO ji = 1, jpiglo_crs 
     1285              mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 
     1286              mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) ) 
     1287           ENDDO 
     1288 
     1289           !---------------------------------------- 
     1290           DO ji = 1, nlei_crs 
     1291              mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
     1292              mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
     1293              nfactx(ji)  = mie_crs(ji)-mie_crs(ji)+1 
     1294           ENDDO 
     1295 
     1296           IF( iproci == jpni )THEN 
     1297              nlei_crs=nlci_crs 
     1298              mis_crs(nlei_crs)=mis_crs(nlei_crs-1) 
     1299              mie_crs(nlei_crs)=mie_crs(nlei_crs-1) 
     1300           ENDIF 
     1301 
     1302           !---------------------------------------- 
     1303 
     1304        CASE DEFAULT 
     1305           WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 
     1306        END SELECT 
     1307 
     1308        !========================================================================== 
     1309        ! dim along J 
     1310        !========================================================================== 
     1311        SELECT CASE ( nperio ) 
     1312        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold 
     1313 
     1314           DO jj=1,jpjglo_crs 
     1315              ijjs=nn_facty*(jj)-5 
     1316              ijje=nn_facty*(jj)-3 
     1317              mjs2_crs(jj)=ijjs 
     1318              mje2_crs(jj)=ijje 
     1319           ENDDO 
     1320 
     1321           jj=1 
     1322           DO WHILE( mjs2_crs(jj) - njmpp + 1 .LT. 1 ) 
     1323              jj=jj+1 
     1324              IF( jj==jpjglo_crs )EXIT 
     1325           END DO 
     1326           ijjs=jj 
     1327 
     1328           !mjs2_crs(jj)=indice global ds la grille no crs de la premiere maille du premier pavé contenu ds le domaine intérieur 
     1329           !ijjs        =indice global ds la grille    crs de la premire maille qui est ds le domaine intérieur 
     1330           !ij_start    =indice local de mjs2_crs(jj) 
     1331           ij_start = mjs2_crs(ijjs)-njmpp+1 
     1332           njmpp_crs = ijjs-1 
     1333 
     1334           nldj_crs = 2 
     1335           IF( noso == -1 )THEN 
     1336 
     1337               mje2_crs(ijjs-1) = mjs2_crs(ijjs)-1 
     1338 
     1339               SELECT CASE(ij_start) 
     1340                  CASE(1) 
     1341                     nldj_crs=2 
     1342                     mje2_crs(ijjs-1) = -1 
     1343                     mjs2_crs(ijjs-1) = -1 
     1344                  CASE(2) 
     1345!CBR?                     nldj_crs=1 
     1346                     nldj_crs=2 
     1347                     mjs2_crs(ijjs-1) = mje2_crs(ijjs-1) 
     1348                  CASE(3) 
     1349!CBR?                     nldj_crs=1 
     1350                     nldj_crs=2 
     1351                     mjs2_crs(ijjs-1) = mje2_crs(ijjs-1) -1 
     1352                  CASE DEFAULT 
     1353                     WRITE(narea+8000-1,*)"WRONG VALUE FOR iistart ",ii_start 
     1354               END SELECT 
     1355 
     1356           ENDIF 
     1357           IF( njmpp==1 )njmpp_crs=1 
     1358 
     1359 
     1360           !---------------------------------------- 
     1361           jj=jpjglo_crs 
     1362           DO WHILE( mje2_crs(jj) - njmpp + 1 .GT. nlcj ) 
     1363              jj=jj-1 
     1364              IF( jj==1 )EXIT 
     1365           END DO 
     1366           ijje=jj 
     1367 
     1368           nlej_crs=ijje-njmpp_crs+1 
     1369 
     1370           !---------------------------------------- 
     1371           nlcj_crs=nlej_crs+jprecj 
     1372           IF( iprocj == jpnj )THEN 
     1373              nlej_crs=jpj_crs ! cbr -1 ???????????????????? 
     1374              nlcj_crs=nlej_crs 
    27171375           ENDIF 
    27181376  
    2719            !WRITE(narea+200,*)ii,ij  ; call flush(narea+200) 
    2720            !WRITE(narea+200,*)"iproc iprocso ",iproc,iprocso 
    2721            !WRITE(narea+200,*)"jpiglo jpjglo ",jpiglo,jpjglo 
    2722            !WRITE(narea+200,*)"ibonit(jn) ibonjt(jn) ",ibonit(jn),ibonjt(jn) ; call flush(narea+200) 
    2723            !WRITE(narea+200,*)"nimppt(jn) njmppt(jn) ",nimppt(jn),njmppt(jn) ; call flush(narea+200) 
    2724            !WRITE(narea+200,*)"loc jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn),nlejt(jn),nlcjt(jn) ; call flush(narea+200) 
    2725            !WRITE(narea+200,*)"glo jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn)+njmppt(jn)-1,nlejt(jn)+njmppt(jn)-1,nlcjt(jn) ; call flush(narea+200) 
    2726  
    2727            !dimension selon j 
    2728            !------------------- 
    2729            IF( ibonjt(jn) .NE. 1 )THEN !on a besoin de savoir si jn est au nord 
    2730               !iprocno=nfipproc(ii,ij+1)  
    2731                  !iprocno=iprocno+1 
    2732                  !WRITE(narea+200,*)"ii,ij+1 ",ii,ij+1; call flush(narea+200) 
    2733                  !WRITE(narea+200,*)"njmppt  jn njmpptno(jn) ",njmppt(jn),njmpptno(jn); call flush(narea+200) 
    2734                  !WRITE(narea+200,*)"jpjglo",jpjglo ; call flush(narea+200) 
    2735  
    2736                  !WRITE(narea+200,*)REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ),REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ); call flush(narea+200) 
    2737                  !WRITE(narea+200,*)AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ),AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ); call flush(narea+200) 
    2738  
    2739                  nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ) & 
    2740                       &        - AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ) 
    2741            ELSE ! ibonjt=1 : au nord 
    2742               nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1 
     1377           !---------------------------------------- 
     1378           DO jj = 1, jpj_crs 
     1379              mjg_crs(jj) = jj + njmpp_crs - 1 
     1380           ENDDO 
     1381           DO jj = 1, jpjglo_crs 
     1382              mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 
     1383              mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) ) 
     1384           ENDDO 
     1385 
     1386           !---------------------------------------- 
     1387           DO jj = 1, nlej_crs 
     1388              mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
     1389              mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
     1390              nfacty(jj)   = mje_crs(jj)-mje_crs(jj)+1 
     1391           ENDDO 
     1392 
     1393           IF( iprocj == jpnj )THEN 
     1394              mjs_crs(nlej_crs)=mjs_crs(nlej_crs-1) 
     1395              mje_crs(nlej_crs)=mje_crs(nlej_crs-1) 
    27431396           ENDIF 
    2744            !==> nbondj = -1 au sud, 0 au milieu, 1 au nord, 2 si jpnj=1 
    2745            !WRITE(narea+200,*)"nlejt_crs(jn) ",nlejt_crs(jn) ; call flush(narea+200) 
    2746            !!!noso== nbre de proc sud du proc sur lequel on tourne !!!! ; dangeureux car on est ds une boucle sur jn 
    2747            IF( iprocso < 0 .AND. ibonjt(jn) == -1 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 
    2748            SELECT CASE( ibonjt(jn) ) 
    2749               CASE ( -1 ) 
    2750                 !WRITE(narea+200,*)"MOD( jpjglo - njmppt(jn), nn_facty)",MOD( jpjglo - njmppt(jn), nn_facty) ; call flush(narea+200) 
    2751                 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1  ! au cas où il reste des lignes en bas 
    2752                 IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    2753                 nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
    2754                 nldjt_crs(jn) = nldjt(jn) 
    2755                 !???nlejt_crs(jn) = nlejt_crs(jn) + 1 ! 2 !cbr   
    2756               CASE ( 0 ) 
    2757  
    2758                 nldjt_crs(jn) = nldjt(jn) 
    2759                 IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    2760                 nlejt_crs(jn) = nlejt_crs(jn) + jprecj 
    2761                 nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
    2762  
    2763               CASE ( 1, 2 ) 
    2764     
    2765                 nlejt_crs(jn) = nlejt_crs(jn) + jprecj 
    2766                 nlcjt_crs(jn) = nlejt_crs(jn) 
    2767                 nldjt_crs(jn) = nldjt(jn) 
    2768               CASE DEFAULT 
    2769                  STOP 
    2770            END SELECT 
    2771            !WRITE(narea+200,*)"jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) " ; call flush(narea+200) 
    2772            !WRITE(narea+200,*) jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
    2773            IF( nlcjt_crs(jn) > jpj_crs )THEN 
    2774               jpj_crs = jpj_crs + 1 
    2775               nlejt_crs(jn) = nlejt_crs(jn) + 1 
    2776            ENDIF 
    2777            !cbr pas bon !!!! 
    2778            !on augmente la taille des domaines alors que les tblx st deja alloués 
    2779            !du coup on alloue les tblx apres: 
    2780            IF(nldjt_crs(jn) == 1 ) THEN 
    2781               njmppt_crs(jn) = 1 
    2782            ELSE 
    2783               njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) ) 
    2784            ENDIF 
    2785            !WRITE(narea+200,*)"tutu loc ",jn,jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
    2786            !WRITE(narea+200,*)"tutu glo ",jn,jpj_crs, nldjt_crs(jn)+njmppt_crs(jn)-1,nlejt_crs(jn)+njmppt_crs(jn)-1,nlcjt_crs(jn)+njmppt_crs(jn)-1 ; call flush(narea+200) 
    2787  
    2788  
    2789            !dimensions selon i 
    2790            !------------------- 
    2791            !IF( jn == 1 ) THEN 
    2792            !IF( ibonit(jn)==-1 )THEN !on a besoin de savoir si jn est un proc west 
    2793            IF( ii==1 )THEN !on a besoin de savoir si jn est un proc west 
    2794               nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) 
    2795            ELSE 
    2796               !WRITE(narea+200,*)"njmppt  jn njmpptea(jn) ",nimppt(jn),nimpptea(jn); call flush(narea+200) 
    2797               !WRITE(narea+200,*)"nlcit  (jn) nlcitea(jn) ) ",nlcit  (jn),nlcitea(jn); call flush(narea+200) 
    2798               nleit_crs(jn) = AINT( REAL( ( nimppt  (jn) - 1 + nlcit  (jn) )  / nn_factx, wp) ) & 
    2799                  &          - AINT( REAL( ( nimpptea(jn) - 1 + nlcitea(jn) )  / nn_factx, wp) ) 
    2800            ENDIF 
    2801            !WRITE(narea+200,*)"nleji_crs(jn),noso ",nleit_crs(jn); call flush(narea+200) 
    2802  
    2803  
    2804            SELECT CASE( ibonit(jn) ) 
    2805               CASE ( -1 ) 
    2806                  nleit_crs(jn) = nleit_crs(jn) + jpreci 
    2807                  nlcit_crs(jn) = nleit_crs(jn) + jpreci 
    2808                  nldit_crs(jn) = nldit(jn) 
    2809  
    2810               CASE ( 0 ) 
    2811                  nleit_crs(jn) = nleit_crs(jn) + jpreci 
    2812                  nlcit_crs(jn) = nleit_crs(jn) + jpreci 
    2813                  nldit_crs(jn) = nldit(jn) 
    2814  
    2815               CASE ( 1, 2 ) 
    2816                  IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1 
    2817                  nleit_crs(jn) = nleit_crs(jn) + jpreci 
    2818                  nlcit_crs(jn) = nleit_crs(jn) 
    2819                  nldit_crs(jn) = nldit(jn) 
    2820  
    2821               CASE DEFAULT 
    2822                  STOP 
    2823            END SELECT 
    2824            !WRITE(narea+200,*)"jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ",jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 
    2825            nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 
    2826  
    2827            !WRITE(narea+200,*)"tutu loc ",jn,jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 
    2828            !WRITE(narea+200,*)"tutu glo ",jn,jpi_crs, nldit_crs(jn)+nimppt_crs(jn)-1,nleit_crs(jn)+nimppt_crs(jn)-1,nlcit_crs(jn)+nimppt_crs(jn)-1 ; call flush(narea+200) 
    2829  
    2830            nfiimpp_crs(ii,ij) = nimppt_crs(jn) 
    2831            !WRITE(narea+200,*)"tutu nimppt_crs(jn) ",ii,ij,nimppt_crs(jn) ; call flush(narea+200) 
    2832            
    2833         ENDDO 
    2834  
    2835         DO ji = 1 , jpni 
    2836            DO jj = 1 ,jpnj 
     1397 
     1398           !---------------------------------------- 
     1399 
     1400        CASE DEFAULT 
     1401           WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4 supported' 
     1402        END SELECT 
     1403 
     1404        !========================================================================== 
     1405        IF( nlci_crs .GT. jpi_crs .OR. nlei_crs .GT. jpi_crs )WRITE(narea+8000-1,*)"BUGDIM ",nlei_crs,nlci_crs,jpi_crs; CALL FLUSH(narea+8000-1) 
     1406        IF( nlcj_crs .GT. jpj_crs .OR. nlej_crs .GT. jpj_crs )WRITE(narea+8000-1,*)"BUGDIM ",nlej_crs,nlcj_crs,jpj_crs; CALL FLUSH(narea+8000-1) 
     1407        !========================================================================== 
     1408 
     1409        nldit_crs(:)=0 ; nleit_crs(:)=0 ; nlcit_crs(:)=0 ; nimppt_crs(:)=0 
     1410        nldjt_crs(:)=0 ; nlejt_crs(:)=0 ; nlcjt_crs(:)=0 ; njmppt_crs(:)=0 
     1411 
     1412        CALL mppgatheri((/nlci_crs/),0,nlcit_crs) ; CALL mppgatheri((/nlcj_crs/),0,nlcjt_crs)  
     1413        CALL mppgatheri((/nldi_crs/),0,nldit_crs) ; CALL mppgatheri((/nldj_crs/),0,nldjt_crs)  
     1414        CALL mppgatheri((/nlei_crs/),0,nleit_crs) ; CALL mppgatheri((/nlej_crs/),0,nlejt_crs)  
     1415        CALL mppgatheri((/nimpp_crs/),0,nimppt_crs) ; CALL mppgatheri((/njmpp_crs/),0,njmppt_crs)  
     1416 
     1417        DO jj = 1 ,jpnj 
     1418           DO ji = 1 , jpni 
    28371419              jn=nfipproc(ji,jj)+1 
    2838               iimppt_crs = ANINT( REAL( (nfiimpp(ji,jj) + 1 ) / nn_factx, wp ) ) + 1 
    2839               nfiimpp_crs(ji,jj) = iimppt_crs 
    2840               IF( jn .GE. 1 )nimppt_crs(jn) = iimppt_crs 
    2841               !PRINT*," nfiimpp_crs(ji,jj) ",ji,jj,jn,nfiimpp(ji,jj),nfiimpp_crs(ji,jj) 
     1420              IF( jn .GE. 1 )THEN 
     1421                 nfiimpp_crs(ji,jj)=nimppt_crs(jn) 
     1422              ELSE 
     1423                 nfiimpp_crs(ji,jj) = ANINT( REAL( (nfiimpp(ji,jj) + 1 ) / nn_factx, wp ) ) + 1 
     1424              ENDIF 
    28421425           ENDDO 
    28431426        ENDDO 
    2844  
    2845         nlej_crs  = nlejt_crs(nproc + 1) 
    2846         nlcj_crs  = nlcjt_crs(nproc + 1) 
    2847         nldj_crs  = nldjt_crs(nproc + 1) 
    2848         njmpp_crs = njmppt_crs(nproc + 1) 
    2849  
    2850         nlei_crs  = nleit_crs(nproc + 1) 
    2851         nlci_crs  = nlcit_crs(nproc + 1) 
    2852         nldi_crs  = nldit_crs(nproc + 1) 
    2853         nimpp_crs = nimppt_crs(nproc + 1) 
    2854  
     1427  
    28551428        !nogather=T 
    28561429        nfsloop_crs = 1 
     
    28671440        END DO 
    28681441 
     1442        !WRITE(narea+8000-1,*)"loc crs jpi nldi,nlei,nlci ",jpi_crs, nldi_crs            ,nlei_crs             ,nlci_crs 
     1443        !WRITE(narea+8000-1,*)"glo crs jpi nldi,nlei      ",jpi_crs, nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 
     1444        !WRITE(narea+8000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs            ,nlej_crs             ,nlcj_crs 
     1445        !WRITE(narea+8000-1,*)"glo crs jpj nldj,nlej      ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 
    28691446        !============================================================================================== 
    2870          !write(narea+200,*)"jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1" ; call flush(narea+200) 
    2871          !write(narea+200,*)jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 ; call flush(narea+200) 
    2872          !write(narea+200,*)"jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1" ; call flush(narea+200) 
    2873          !write(narea+200,*)jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 ; call flush(narea+200) 
    2874          !write(narea+200,*)"nfsloop_crs nfeloop_crs ",nfsloop_crs,nfeloop_crs ; call flush(narea+200) 
    2875  
    2876          ! No coarsening with zoom 
    28771447         IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP  
    28781448 
    2879          !cbr 
    2880          ierr = crs_dom_alloc1()  
    2881  
    2882          DO ji = 1, jpi_crs 
    2883             mig_crs(ji) = ji + nimpp_crs - 1 
    2884             !WRITE(narea+200,*)"fifi ",ji,mig_crs(ji)  ; call flush(narea+200) 
    2885          ENDDO 
    2886          DO jj = 1, jpj_crs 
    2887             mjg_crs(jj) = jj + njmpp_crs - 1! 
    2888             !WRITE(narea+200,*)"fufu ",jj,mjg_crs(jj)  ; call flush(narea+200) 
    2889          ENDDO 
    2890         
    2891          DO ji = 1, jpiglo_crs 
    2892             mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 
    2893             mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) ) 
    2894             !WRITE(narea+200,*)"mi ",ji,mi0_crs(ji),mi1_crs(ji)  ; call flush(narea+200) 
    2895          ENDDO 
    2896           
    2897          DO jj = 1, jpjglo_crs 
    2898             mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 
    2899             mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) ) 
    2900             !WRITE(narea+200,*)"mj ",jj, mj0_crs(jj),mj1_crs(jj) ; call flush(narea+200) 
    2901          ENDDO 
    2902  
    2903       ENDIF 
    2904        
    29051449      !                         Save the parent grid information 
    29061450      jpi_full    = jpi 
     
    29871531      rfactxy = nn_factx * nn_facty 
    29881532       
    2989       ! 2.b. Set up bins for coarse grid, horizontal only. 
    2990       ierr = crs_dom_alloc2() 
    2991       
    2992       mis2_crs(:) = 0      ;      mie2_crs(:) = 0 
    2993       mjs2_crs(:) = 0      ;      mje2_crs(:) = 0 
    2994  
    2995        
    2996       SELECT CASE ( nn_binref ) 
    2997  
    2998       CASE ( 0 )  
    2999  
    3000          SELECT CASE ( nperio ) 
    3001       
    3002   
    3003         CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold 
    3004          
    3005             DO ji = 2, jpiglo_crsm1 
    3006                ijie = ( ji * nn_factx ) - nn_factx   !cc 
    3007                ijis = ijie - nn_factx + 1 
    3008                mis2_crs(ji) = ijis 
    3009                mie2_crs(ji) = ijie 
    3010             ENDDO 
    3011             IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1) = jpiglo - 2   
    3012  
    3013             ! Handle first the northernmost bin 
    3014             IF ( nn_facty == 2 ) THEN   ;    ijjgloT = jpjglo - 1  
    3015             ELSE                        ;    ijjgloT = jpjglo 
    3016             ENDIF 
    3017  
    3018             DO jj = 2, jpjglo_crs 
    3019                 ijje = ijjgloT - nn_facty * ( jj - 3 ) 
    3020                 ijjs = ijje - nn_facty + 1                    
    3021                 mjs2_crs(jpjglo_crs-jj+2) = ijjs 
    3022                 mje2_crs(jpjglo_crs-jj+2) = ijje 
    3023                !WRITE(narea+200,*)"jpjglo_crs-jj+2,ijje,ijjs ",jpjglo_crs-jj+2,ijjs,ijje ; call flush(narea+200) 
    3024             ENDDO 
    3025  
    3026          CASE ( 2 )  
    3027             WRITE(numout,*)  'crs_init, jperio=2 not supported'  
    3028          
    3029          CASE ( 5, 6 )    ! F-pivot at North Fold 
    3030  
    3031             DO ji = 2, jpiglo_crsm1 
    3032                ijie = ( ji * nn_factx ) - nn_factx  
    3033                ijis = ijie - nn_factx + 1 
    3034                mis2_crs(ji) = ijis 
    3035                mie2_crs(ji) = ijie 
    3036             ENDDO 
    3037             IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1)  = jpiglo - 2  
    3038  
    3039             ! Treat the northernmost bin separately. 
    3040             jj = 2 
    3041             ijje = jpj - nn_facty * ( jj - 2 ) 
    3042             IF ( nn_facty == 3 ) THEN   ;  ijjs = ijje - 1  
    3043             ELSE                        ;  ijjs = ijje - nn_facty + 1 
    3044             ENDIF 
    3045             mjs2_crs(jpj_crs-jj+1) = ijjs 
    3046             mje2_crs(jpj_crs-jj+1) = ijje 
    3047  
    3048             ! Now bin the rest, any remainder at the south is lumped in the southern bin 
    3049             DO jj = 3, jpjglo_crsm1 
    3050                 ijje = jpjglo - nn_facty * ( jj - 2 ) 
    3051                 ijjs = ijje - nn_facty + 1                   
    3052                 IF ( ijjs <= nn_facty )  ijjs = 2 
    3053                 WRITE(narea+200,*)"fufu",jj,ijjs,ijje ; call flush(narea+200) 
    3054                 mjs2_crs(jpj_crs-jj+1)   = ijjs 
    3055                 mje2_crs(jpj_crs-jj+1)   = ijje 
    3056             ENDDO 
    3057  
    3058          CASE DEFAULT 
    3059             WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4, 5, 6 supported'  
    3060   
    3061          END SELECT 
    3062  
    3063       CASE (1 ) 
    3064          WRITE(numout,*) 'crs_init.  Equator-centered bins option not yet available'  
    3065  
    3066       END SELECT 
    3067  
    3068      ! Pad the boundaries, do not know if it is necessary 
    3069       mis2_crs(2) = 1             ;  mis2_crs(jpiglo_crs) = mie2_crs(jpiglo_crs - 1) + 1    
    3070       mie2_crs(2) = nn_factx      ;  mie2_crs(jpiglo_crs) = jpiglo                          
    3071       ! 
    3072       mjs2_crs(1) = 1 
    3073       mje2_crs(1) = 1 
    3074       ! 
    3075       mje2_crs(2) = mjs2_crs(3)-1 ;  mje2_crs(jpjglo_crs) = jpjglo 
    3076       mjs2_crs(2) = 1             ;  mjs2_crs(jpjglo_crs) = mje2_crs(jpjglo_crs) - nn_facty + 1  
    3077   
    3078       IF( .NOT. lk_mpp ) THEN      
    3079         mis_crs(:) = mis2_crs(:)  
    3080         mie_crs(:) = mie2_crs(:) 
    3081         mjs_crs(:) = mjs2_crs(:)  
    3082         mje_crs(:) = mje2_crs(:)  
    3083       ELSE 
    3084        !write(narea+200,*)"njmpp ",njmpp 
    3085         DO jj = 1, nlej_crs 
    3086            !write(narea+200,*)jj,"mjs2_crs mje2_crs ",mjg_crs(jj),mjs2_crs(mjg_crs(jj)),mje2_crs(mjg_crs(jj)) ; call flush(narea+200) 
    3087            mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
    3088            mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
    3089            !write(narea+200,*)"mjs_crs mje_crs ",mjs_crs(jj),mje_crs(jj) ; call flush(narea+200) 
    3090         ENDDO 
    3091         !write(narea+200,*)"nimpp ",nimpp 
    3092         DO ji = 1, nlei_crs 
    3093            !write(narea+200,*)ji,"mis2_crs mie2_crs ",mig_crs(ji),mis2_crs(mig_crs(ji)),mie2_crs(mig_crs(ji)) ; call flush(narea+200) 
    3094            mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
    3095            mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
    3096            !write(narea+200,*)"mis_crs mie_crs ",mis_crs(jj),mie_crs(jj) ; call flush(narea+200) 
    3097         ENDDO 
    30981533      ENDIF 
    30991534      ! 
    3100       !IF( nlcj_crs -1 .GT. nlej_crs )WRITE(narea+200,*)"tutututu",nlcj_crs,nlej_crs ; call flush(narea+200) 
    31011535      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1) 
    31021536      njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1) 
     1537      ! 
    31031538      ! 
    31041539   END SUBROUTINE crs_dom_def 
Note: See TracChangeset for help on using the changeset viewer.