Changeset 5007


Ignore:
Timestamp:
2015-01-05T10:37:56+01:00 (6 years ago)
Author:
cbricaud
Message:

first modifications for output coarsening . see tieck 1426

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC
Files:
6 edited

Legend:

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

    r4064 r5007  
    1717    
    1818   PUBLIC crs_dom_alloc  ! Called from crsini.F90 
     19   PUBLIC crs_dom_alloc1  ! Called from crsini.F90 
    1920   PUBLIC crs_dom_alloc2  ! Called from crsini.F90 
    2021   PUBLIC dom_grid_glo    
     
    166167CONTAINS 
    167168    
    168    INTEGER FUNCTION crs_dom_alloc() 
     169   INTEGER FUNCTION crs_dom_alloc1() 
    169170      !!------------------------------------------------------------------- 
    170171      !!                     *** FUNCTION crs_dom_alloc *** 
     
    172173      !!------------------------------------------------------------------- 
    173174      !! Local variables 
    174       INTEGER, DIMENSION(17) :: ierr 
     175      INTEGER, DIMENSION(14) :: ierr 
    175176 
    176177      ierr(:) = 0 
     
    247248      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , & 
    248249         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 
     250 
     251      crs_dom_alloc1 = MAXVAL(ierr) 
     252 
     253   END FUNCTION crs_dom_alloc1 
     254 
     255   INTEGER FUNCTION crs_dom_alloc() 
     256      !!------------------------------------------------------------------- 
     257      !!                     *** FUNCTION crs_dom_alloc *** 
     258      !!  ** Purpose :   Allocate public crs arrays   
     259      !!------------------------------------------------------------------- 
     260      !! Local variables 
     261      INTEGER, DIMENSION(1) :: ierr 
     262 
     263      ierr(:) = 0 
    249264          
    250265      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), & 
    251266       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
    252267                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), & 
    253        &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) ) 
    254  
    255           
     268       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(1) ) 
     269 
    256270      crs_dom_alloc = MAXVAL(ierr) 
    257271 
     
    268282      ierr(:) = 0 
    269283       
    270       ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) ) 
     284      !cbr ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) ) 
     285      !cbr pk on alloue ac nlej_crs ?????? 
     286      !cbrALLOCATE( mjs_crs(nlcj_crs) , mje_crs(nlcj_crs), mis_crs(nlci_crs) , mie_crs(nlci_crs), STAT=ierr(1) ) 
     287      ALLOCATE( mjs_crs(jpj_crs) , mje_crs(jpj_crs), mis_crs(jpi_crs) , mie_crs(jpi_crs), STAT=ierr(1) ) 
    271288      crs_dom_alloc2 = MAXVAL(ierr) 
    272289 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r4314 r5007  
    6767       
    6868      ! Initialize 
    69  
    7069      tmask_crs(:,:,:) = 0.0 
    7170      vmask_crs(:,:,:) = 0.0 
    7271      umask_crs(:,:,:) = 0.0 
    7372      fmask_crs(:,:,:) = 0.0 
    74    
    75              
    76       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    77          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    78             je_2 = mje_crs(2)   ;  ij = je_2 
    79          ENDIF 
    80       ELSE 
    81          je_2 = mje_crs(2)      ;  ij = mjs_crs(2)  
    82       ENDIF 
     73      ! 
    8374      DO jk = 1, jpkm1 
    84          DO ji = 2, nlei_crs   
    85             ijis = mis_crs(ji)  ;  ijie = mie_crs(ji)     
    86             !           
    87             zmask = 0.0 
    88             zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) )  
    89             IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 
    90                 
    91             zmask = 0.0 
    92             zmask = SUM( vmask(ijis:ijie,je_2     ,jk) )   
    93             IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 
    94                 
    95             zmask = 0.0 
    96             zmask = SUM(umask(ijie,ij:je_2,jk))    
    97             IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 
    98                 
    99             fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk) 
     75         DO ji = 2, nlei_crs 
     76            ijie = mie_crs(ji) 
     77            ijis = mis_crs(ji) 
     78 
     79            IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2 
     80 
     81               IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 
     82 
     83                  jj = mje_crs(2) 
     84 
     85                  zmask = 0.0 
     86                  zmask = SUM( tmask(ijis:ijie,jj,jk) ) 
     87                  IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 
     88 
     89                  zmask = 0.0 
     90                  zmask = SUM( vmask(ijis:ijie,jj     ,jk) ) 
     91                  IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 
     92 
     93                  zmask = 0.0 
     94                  zmask = umask(ijie     ,jj,jk) 
     95                  IF( zmask > 0.0 )umask_crs(ji,2,jk) = 1.0 
     96 
     97                  fmask_crs(ji,jj,jk) = fmask(ijie,2,jk) 
     98               ENDIF 
     99            ELSE 
     100 
     101               jj   = mje_crs(2) 
     102               ij   = mjs_crs(2) 
     103 
     104               zmask = 0.0 
     105               zmask = SUM( tmask(ijis:ijie,ij:jj,jk) ) 
     106               IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 
     107 
     108               zmask = 0.0 
     109               zmask = SUM( vmask(ijis:ijie,jj     ,jk) ) 
     110               IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 
     111 
     112               zmask = 0.0 
     113               zmask = SUM(umask(ijie,ij:jj,jk)) 
     114               IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 
     115 
     116               fmask_crs(ji,jj,jk) = fmask(ijie,2,jk) 
     117 
     118            ENDIF 
     119  
     120            DO jj = 3, nlej_crs 
     121               ijje = mje_crs(jj) 
     122               ijjs = mjs_crs(jj) 
     123 
     124               IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 
     125               zmask = 0.0 
     126               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
     127               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 
     128 
     129               zmask = 0.0 
     130               zmask = SUM( vmask(ijis:ijie,ijje     ,jk) ) 
     131               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 
     132 
     133               zmask = 0.0 
     134               zmask = SUM( umask(ijie     ,ijjs:ijje,jk) ) 
     135               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 
     136 
     137               fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk) 
     138 
     139            ENDDO 
    100140         ENDDO 
    101141      ENDDO 
    102       ! 
    103       DO jk = 1, jpkm1 
    104          DO ji = 2, nlei_crs   
    105             ijis = mis_crs(ji)     ;   ijie = mie_crs(ji)        
    106             DO jj = 3, nlej_crs 
    107                ijjs = mjs_crs(jj)  ;   ijje = mje_crs(jj) 
    108                            
    109                zmask = 0.0 
    110                zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) )  
    111                IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 
    112                 
    113                zmask = 0.0 
    114                zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )   
    115                IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 
    116                 
    117                zmask = 0.0 
    118                zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )   
    119                IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 
    120                 
    121                fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)   
    122             ENDDO 
    123          ENDDO 
    124       ENDDO 
    125  
    126142      ! 
    127143      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 
     
    686702               CASE( 'V' ) 
    687703 
    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                         ijje = mje_crs(2) 
    691                      ENDIF 
    692                   ELSE 
    693                      ijje = mjs_crs(2) 
    694                   ENDIF 
    695                   ! 
    696                   DO jk = 1, jpk            
     704                  DO jk = 1, jpk 
    697705                     DO ji = nistr, niend, nn_factx 
    698                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    699                         zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) & 
    700                           &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 
    701                           &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk)  
    702                           ! 
    703                         p_fld_crs(ii,2,jk) = zflcrs 
    704                      ENDDO 
    705                   ENDDO 
    706                   ! 
    707                   DO jk = 1, jpk            
    708                      DO jj  = njstr, njend, nn_facty 
    709                         DO ji = nistr, niend, nn_factx 
    710                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     706                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     707                        IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2 
     708                           IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 
     709                              jj = mje_crs(2) 
     710                              zflcrs  = p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) & 
     711                               &      + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) & 
     712                               &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) 
     713 
     714                              zsfcrs = zsurfmsk(ji  ,jj  ,jk) & 
     715                               &     + zsurfmsk(ji+1,jj  ,jk) & 
     716                               &     + zsurfmsk(ji+2,jj  ,jk) 
     717 
     718                              IF( zsfcrs == 0 ) THEN  ; p_fld_crs(ii,2,jk) = zflcrs 
     719                              ELSE                    ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     720                              ENDIF 
     721                           ENDIF 
     722                        ELSE 
     723                           ijje = mje_crs(2) 
     724                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) & 
     725                             &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 
     726                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 
     727                           ! 
     728                           zsfcrs =  zsurfmsk(ji  ,ijje,jk) & 
     729                             &     + zsurfmsk(ji+1,ijje,jk) & 
     730                             &     + zsurfmsk(ji+2,ijje,jk) 
     731 
     732                           IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 
     733                           ELSE                   ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     734                           ENDIF 
     735 
     736                        ENDIF 
     737 
     738                        DO jj = njstr, njend, nn_facty 
     739                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
    711740                           ij   = ( jj - njstr ) * rfacty_r + 3 
    712741                           ijje = mje_crs(ij) 
     742                           ijie = mie_crs(ii) 
     743                           !                   
    713744                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) & 
    714745                             &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 
    715746                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk)  
    716                              ! 
    717                            p_fld_crs(ii,ij,jk) = zflcrs 
    718                            !  
    719                         ENDDO       
     747                           ! 
     748                           zsfcrs =  zsurfmsk(ji  ,ijje,jk)  & 
     749                             &     + zsurfmsk(ji+1,ijje,jk)  & 
     750                             &     + zsurfmsk(ji+2,ijje,jk)  
     751 
     752                           IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs 
     753                           ELSE                   ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
     754                           ENDIF 
     755                           ! 
     756                        ENDDO 
    720757                     ENDDO 
    721                   ENDDO    
    722              
     758                  ENDDO 
     759  
    723760               CASE( 'U' ) 
    724761 
     
    854891               CASE( 'V' ) 
    855892 
    856                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    857                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    858                         ijje = mje_crs(2) 
    859                       ENDIF 
    860                   ELSE 
    861                      ijje = mjs_crs(2) 
    862                   ENDIF 
    863  
    864                   DO jk = 1, jpk 
    865                      DO ji = nistr, niend, nn_factx 
    866                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    867                         zflcrs = & 
    868                           & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    869                           &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    870                           &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    871                           ! 
    872                         p_fld_crs(ii,2,jk) = zflcrs 
    873                      ENDDO 
    874                   ENDDO 
    875                   ! 
    876                   DO jk = 1, jpk            
    877                      DO jj  = njstr, njend, nn_facty 
    878                         DO ji = nistr, niend, nn_factx 
    879                            ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    880                            ij  = ( jj - njstr ) * rfacty_r + 3 
    881                            ijje = mje_crs(ij) 
    882                            !                   
    883                            zflcrs = & 
    884                              & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    885                              &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    886                              &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    887                            ! 
    888                            p_fld_crs(ii,ij,jk) = zflcrs 
    889                            ! 
    890                         ENDDO       
    891                      ENDDO 
    892                   ENDDO    
    893  
     893!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     894!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     895!                        ijje = mje_crs(2) 
     896!                      ENDIF 
     897!                  ELSE 
     898!                     ijje = mjs_crs(2) 
     899!                  ENDIF 
     900! 
     901!                  DO jk = 1, jpk 
     902!                     DO ji = nistr, niend, nn_factx 
     903!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     904!                        zflcrs = & 
     905!                          & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     906!                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     907!                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
     908!                          ! 
     909!                        p_fld_crs(ii,2,jk) = zflcrs 
     910!                     ENDDO 
     911!                  ENDDO 
     912!                  ! 
     913!                  DO jk = 1, jpk            
     914!                     DO jj  = njstr, njend, nn_facty 
     915!                        DO ji = nistr, niend, nn_factx 
     916!                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     917!                           ij  = ( jj - njstr ) * rfacty_r + 3 
     918!                           ijje = mje_crs(ij) 
     919!                           !                   
     920!                           zflcrs = & 
     921!                             & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     922!                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     923!                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
     924!                           ! 
     925!                           p_fld_crs(ii,ij,jk) = zflcrs 
     926!                           ! 
     927!                        ENDDO       
     928!                     ENDDO 
     929!                  ENDDO    
     930                  CALL ctl_stop('MAX operator and V case not available') 
    894931             
    895932               CASE( 'U' ) 
    896933 
    897                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    898                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    899                         je_2 = mje_crs(2) 
    900                         DO jk = 1, jpk            
    901                            DO ji = nistr, niend, nn_factx 
    902                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
    903                               ijie = mie_crs(ii) 
    904                               zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
    905                               ! 
    906                               p_fld_crs(ii,2,jk) = zflcrs 
    907                             ENDDO 
    908                         ENDDO 
    909                       ENDIF 
    910                   ELSE 
    911                      je_2 = mjs_crs(2) 
    912                      DO jk = 1, jpk            
    913                         DO ji = nistr, niend, nn_factx 
    914                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    915                            ijie = mie_crs(ii) 
    916                            zflcrs = & 
    917                              & MAX( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    918                              &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    919                              &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
    920                             ! 
    921                            p_fld_crs(ii,2,jk) = zflcrs 
    922                         ENDDO 
    923                      ENDDO 
    924                   ENDIF 
    925                   ! 
    926                   DO jk = 1, jpk            
    927                      DO jj  = njstr, njend, nn_facty 
    928                         DO ji = nistr, niend, nn_factx 
    929                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    930                            ij   = ( jj - njstr ) * rfacty_r + 3 
    931                            ijie = mie_crs(ii) 
    932                            zflcrs =  & 
    933                              & MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    934                              &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    935                              &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf  ) 
    936                            !  
    937                            p_fld_crs(ii,ij,jk) = zflcrs 
    938                            !  
    939                         ENDDO       
    940                      ENDDO 
    941                   ENDDO    
     934!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     935!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     936!                        je_2 = mje_crs(2) 
     937!                        DO jk = 1, jpk            
     938!                           DO ji = nistr, niend, nn_factx 
     939!                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
     940!                              ijie = mie_crs(ii) 
     941!                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
     942!                              ! 
     943!                              p_fld_crs(ii,2,jk) = zflcrs 
     944!                            ENDDO 
     945!                        ENDDO 
     946!                      ENDIF 
     947!                  ELSE 
     948!                     je_2 = mjs_crs(2) 
     949!                     DO jk = 1, jpk            
     950!                        DO ji = nistr, niend, nn_factx 
     951!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     952!                           ijie = mie_crs(ii) 
     953!                           zflcrs = & 
     954!                             & MAX( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     955!                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     956!                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
     957!                            ! 
     958!                           p_fld_crs(ii,2,jk) = zflcrs 
     959!                        ENDDO 
     960!                     ENDDO 
     961!                  ENDIF 
     962!                  ! 
     963!                  DO jk = 1, jpk            
     964!                     DO jj  = njstr, njend, nn_facty 
     965!                        DO ji = nistr, niend, nn_factx 
     966!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     967!                           ij   = ( jj - njstr ) * rfacty_r + 3 
     968!                           ijie = mie_crs(ii) 
     969!                           zflcrs =  & 
     970!                             & MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
     971!                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
     972!                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf  ) 
     973!                           !  
     974!                           p_fld_crs(ii,ij,jk) = zflcrs 
     975!                           !  
     976!                        ENDDO       
     977!                     ENDDO 
     978!                  ENDDO    
     979                  CALL ctl_stop('MAX operator and U case not available') 
    942980 
    943981              END SELECT 
     
    10251063               CASE( 'V' ) 
    10261064 
    1027                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1028                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1029                         ijje = mje_crs(2) 
    1030                       ENDIF 
    1031                   ELSE 
    1032                      ijje = mjs_crs(2) 
    1033                   ENDIF 
    1034  
    1035                   DO jk = 1, jpk 
    1036                      DO ji = nistr, niend, nn_factx 
    1037                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1038                         zflcrs = & 
    1039                           & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1040                           &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1041                           &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    1042                           ! 
    1043                         p_fld_crs(ii,2,jk) = zflcrs 
    1044                      ENDDO 
    1045                   ENDDO 
    1046                   ! 
    1047                   DO jk = 1, jpk            
    1048                      DO jj  = njstr, njend, nn_facty 
    1049                         DO ji = nistr, niend, nn_factx 
    1050                            ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1051                            ij  = ( jj - njstr ) * rfacty_r + 3 
    1052                            ijje = mje_crs(ij) 
    1053                            zflcrs = & 
    1054                              & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1055                              &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
    1056                              &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    1057                            ! 
    1058                            p_fld_crs(ii,ij,jk) = zflcrs 
    1059                            ! 
    1060                         ENDDO       
    1061                      ENDDO 
    1062                   ENDDO    
     1065!                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1066!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1067!                        ijje = mje_crs(2) 
     1068!                      ENDIF 
     1069!                  ELSE 
     1070!                     ijje = mjs_crs(2) 
     1071!                  ENDIF 
     1072! 
     1073!                  DO jk = 1, jpk 
     1074!                     DO ji = nistr, niend, nn_factx 
     1075!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1076!                        zflcrs = & 
     1077!                          & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1078!                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1079!                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
     1080!                          ! 
     1081!                        p_fld_crs(ii,2,jk) = zflcrs 
     1082!                     ENDDO 
     1083!                  ENDDO 
     1084!                  ! 
     1085!                  DO jk = 1, jpk            
     1086!                     DO jj  = njstr, njend, nn_facty 
     1087!                        DO ji = nistr, niend, nn_factx 
     1088!                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     1089!                           ij  = ( jj - njstr ) * rfacty_r + 3 
     1090!                           ijje = mje_crs(ij) 
     1091!                           zflcrs = & 
     1092!                             & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1093!                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1094!                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
     1095!                           ! 
     1096!                           p_fld_crs(ii,ij,jk) = zflcrs 
     1097!                           ! 
     1098!                        ENDDO       
     1099!                     ENDDO 
     1100!                  ENDDO    
     1101                  CALL ctl_stop('MIN operator and V case not available') 
    10631102 
    10641103             
    10651104               CASE( 'U' ) 
    10661105 
    1067                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1068                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1069                         je_2 = mje_crs(2) 
    1070                         DO jk = 1, jpk            
    1071                            DO ji = nistr, niend, nn_factx 
    1072                               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
    1073                               ijie = mie_crs(ii) 
    1074                               zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
    1075                               ! 
    1076                               p_fld_crs(ii,2,jk) = zflcrs 
    1077                             ENDDO 
    1078                         ENDDO 
    1079                       ENDIF 
    1080                   ELSE 
    1081                      je_2 = mjs_crs(2) 
    1082                      DO jk = 1, jpk            
    1083                         DO ji = nistr, niend, nn_factx 
    1084                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
    1085                            ijie = mie_crs(ii) 
    1086                            zflcrs = & 
    1087                              & MIN( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    1088                              &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
    1089                              &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
    1090                             ! 
    1091                            p_fld_crs(ii,2,jk) = zflcrs 
    1092                         ENDDO 
    1093                      ENDDO 
    1094                   ENDIF 
    1095                   ! 
    1096                   DO jk = 1, jpk            
    1097                      DO jj  = njstr, njend, nn_facty 
    1098                         DO ji = nistr, niend, nn_factx 
    1099                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1100                            ij   = ( jj - njstr ) * rfacty_r + 3 
    1101                            ijie = mie_crs(ii) 
    1102                            zflcrs = & 
    1103                              & MIN( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    1104                              &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
    1105                              &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf  ) 
    1106                            !  
    1107                            p_fld_crs(ii,ij,jk) = zflcrs 
    1108                            !  
    1109                         ENDDO       
    1110                      ENDDO 
    1111                   ENDDO    
     1106!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1107!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1108!                        je_2 = mje_crs(2) 
     1109!                        DO jk = 1, jpk            
     1110!                           DO ji = nistr, niend, nn_factx 
     1111!                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
     1112!                              ijie = mie_crs(ii) 
     1113!                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
     1114!                              ! 
     1115!                              p_fld_crs(ii,2,jk) = zflcrs 
     1116!                            ENDDO 
     1117!                        ENDDO 
     1118!                      ENDIF 
     1119!                  ELSE 
     1120!                     je_2 = mjs_crs(2) 
     1121!                     DO jk = 1, jpk            
     1122!                        DO ji = nistr, niend, nn_factx 
     1123!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     1124!                           ijie = mie_crs(ii) 
     1125!                           zflcrs = & 
     1126!                             & MIN( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     1127!                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     1128!                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
     1129!                            ! 
     1130!                           p_fld_crs(ii,2,jk) = zflcrs 
     1131!                        ENDDO 
     1132!                     ENDDO 
     1133!                  ENDIF 
     1134!                  ! 
     1135!                  DO jk = 1, jpk            
     1136!                     DO jj  = njstr, njend, nn_facty 
     1137!                        DO ji = nistr, niend, nn_factx 
     1138!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1139!                           ij   = ( jj - njstr ) * rfacty_r + 3 
     1140!                           ijie = mie_crs(ii) 
     1141!                           zflcrs = & 
     1142!                             & MIN( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
     1143!                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
     1144!                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf  ) 
     1145!                           !  
     1146!                           p_fld_crs(ii,ij,jk) = zflcrs 
     1147!                           !  
     1148!                        ENDDO       
     1149!                     ENDDO 
     1150!                  ENDDO    
     1151                  CALL ctl_stop('MIN operator and U case not available') 
    11121152           
    11131153            END SELECT 
     
    12801320                      ENDDO 
    12811321                   ENDIF 
    1282                      ! 
     1322                   ! 
    12831323                   DO jj = njstr, njend, nn_facty 
    12841324                      DO ji = nistr, niend, nn_factx 
     
    12941334                           &      + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2)  & 
    12951335                           &      + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2)   
    1296                            ! 
     1336                          ! 
    12971337                          p_fld_crs(ii,ij) = zflcrs 
    12981338                          !  
     
    13011341             
    13021342               CASE( 'V' ) 
    1303  
    1304                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1305                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1306                         ijje = mje_crs(2) 
     1343                   DO ji = nistr, niend, nn_factx 
     1344                      ii  = ( ji - mis_crs(2) ) * rfactx_r + 2 
     1345                      IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN     !!cc bande du sud style ORCA2 
     1346                         IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 
     1347                            jj = mje_crs(2) 
     1348                            zflcrs  = p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  )  & 
     1349                             &      + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  )  & 
     1350                             &      + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  ) 
     1351                            p_fld_crs(ii,2) = zflcrs 
     1352                         ENDIF 
     1353                      ELSE 
     1354                         ijje = mje_crs(2) 
     1355                         zflcrs  = p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje)  & 
     1356                           &     + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje)  & 
     1357                           &     + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 
     1358                         ! 
     1359                         p_fld_crs(ii,2) = zflcrs 
    13071360                      ENDIF 
    1308                   ELSE 
    1309                      ijje = mjs_crs(2) 
    1310                   ENDIF 
    1311  
    1312                   DO ji = nistr, niend, nn_factx 
    1313                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1314                      zflcrs  =  p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje) & 
    1315                        &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 
    1316                        &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje)  
    1317                             ! 
    1318                      p_fld_crs(ii,2) = zflcrs 
    1319                   ENDDO 
    1320  
    1321                   DO jj = njstr, njend, nn_facty 
    1322                      DO ji = nistr, niend, nn_factx 
    1323                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1324                         ij   = ( jj - njstr ) * rfacty_r + 3 
    1325                         ijje = mje_crs(ij) 
    1326                         zflcrs  =  p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje) & 
    1327                           &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 
    1328                           &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje)  
    1329                           ! 
    1330                         p_fld_crs(ii,ij) = zflcrs 
    1331                         !  
    1332                      ENDDO       
    1333                   ENDDO 
     1361 
     1362                      DO jj = njstr, njend, nn_facty 
     1363                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     1364                         ij   = ( jj - njstr ) * rfacty_r + 3 
     1365                         ijje = mje_crs(ij) 
     1366                         ijie = mie_crs(ii) 
     1367                         !                   
     1368                         zflcrs  = p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje)  & 
     1369                          &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje)  & 
     1370                          &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 
     1371                         ! 
     1372                         p_fld_crs(ii,ij) = zflcrs 
     1373                         ! 
     1374                      ENDDO 
     1375                   ENDDO 
    13341376             
    13351377               CASE( 'U' ) 
     
    13861428               CASE( 'T', 'W' ) 
    13871429   
    1388                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1389                       IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1390                          je_2 = mje_crs(2) 
    1391                          DO ji = nistr, niend, nn_factx 
    1392                             ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1430                   DO ji = nistr, niend, nn_factx 
     1431                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1432                      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1433                         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1434                            je_2 = mje_crs(2) 
    13931435                            zflcrs =  & 
    13941436                              & MAX( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) - ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  & 
    1395                              &       p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  & 
    1396                              &       p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  ) 
     1437                              &      p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  & 
     1438                              &      p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  ) 
    13971439                            ! 
    13981440                            p_fld_crs(ii,2) = zflcrs 
    1399                          ENDDO 
     1441                         ENDIF 
     1442                      ELSE 
     1443                         je_2 = mjs_crs(2)  
     1444                         zflcrs =  & 
     1445                           &  MAX( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) - ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  & 
     1446                           &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) - ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  & 
     1447                           &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) - ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  & 
     1448                           &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) - ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  & 
     1449                           &       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 ,  & 
     1450                           &       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 ,  & 
     1451                           &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) - ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  & 
     1452                           &       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 ,  & 
     1453                           &       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   ) 
     1454                         ! 
     1455                         p_fld_crs(ii,2) = zflcrs 
    14001456                      ENDIF 
    1401                    ELSE 
    1402                       je_2 = mjs_crs(2)  
    1403                       zflcrs =  & 
    1404                         &  MAX( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) - ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  & 
    1405                         &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) - ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  & 
    1406                         &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) - ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  & 
    1407                         &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) - ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  & 
    1408                         &       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 ,  & 
    1409                         &       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 ,  & 
    1410                         &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) - ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  & 
    1411                         &       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 ,  & 
    1412                         &       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   ) 
    1413                       ! 
    1414                       p_fld_crs(ii,2) = zflcrs 
    1415                    ENDIF 
    1416  
    1417                    DO jj = njstr, njend, nn_facty 
    1418                       DO ji = nistr, niend, nn_factx 
     1457 
     1458                      DO jj = njstr, njend, nn_facty 
    14191459                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    14201460                         ij   = ( jj - njstr ) * rfacty_r + 3 
     
    14371477               CASE( 'V' ) 
    14381478 
    1439                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1440                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1441                         ijje = mje_crs(2) 
    1442                       ENDIF 
    1443                   ELSE 
    1444                      ijje = mjs_crs(2) 
    1445                   ENDIF 
    1446  
    1447                   DO ji = nistr, niend, nn_factx 
    1448                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1449                      zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1450                        &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1451                        &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1452                        ! 
    1453                      p_fld_crs(ii,2) = zflcrs 
    1454                   ENDDO       
    1455                   DO jj = njstr, njend, nn_facty 
    1456                      DO ji = nistr, niend, nn_factx 
    1457                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1458                         ij   = ( jj - njstr ) * rfacty_r + 3                
    1459                         ijje = mje_crs(ij)  
    1460                         !                   
    1461                         zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1462                           &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1463                           &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1464                         ! 
    1465                         p_fld_crs(ii,ij) = zflcrs 
    1466                         ! 
    1467                      ENDDO       
    1468                   ENDDO 
     1479!                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1480!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1481!                        ijje = mje_crs(2) 
     1482!                      ENDIF 
     1483!                  ELSE 
     1484!                     ijje = mjs_crs(2) 
     1485!                  ENDIF 
     1486! 
     1487!                  DO ji = nistr, niend, nn_factx 
     1488!                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1489!                     zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1490!                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1491!                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
     1492!                       ! 
     1493!                     p_fld_crs(ii,2) = zflcrs 
     1494!                  ENDDO       
     1495!                  DO jj = njstr, njend, nn_facty 
     1496!                     DO ji = nistr, niend, nn_factx 
     1497!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1498!                        ij   = ( jj - njstr ) * rfacty_r + 3                
     1499!                        ijje = mje_crs(ij)  
     1500!                        !                   
     1501!                        zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1502!                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1503!                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
     1504!                        ! 
     1505!                        p_fld_crs(ii,ij) = zflcrs 
     1506!                        ! 
     1507!                     ENDDO       
     1508!                  ENDDO 
     1509                  CALL ctl_stop('MAX operator and V case not available') 
    14691510             
    14701511               CASE( 'U' ) 
    14711512 
    1472                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1473                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1474                         je_2 = mje_crs(2) 
    1475                         DO ji = nistr, niend, nn_factx 
    1476                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1477                            ijie = mie_crs(ii) 
    1478                            zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
    1479                            p_fld_crs(ii,2) = zflcrs 
    1480                         ENDDO 
    1481                      ENDIF 
    1482                  ELSE 
    1483                      je_2 = mjs_crs(2) 
    1484                      DO ji = nistr, niend, nn_factx 
    1485                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1486                         ijie = mie_crs(ii) 
    1487                         zflcrs =  & 
    1488                           &  MAX( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1489                           &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1490                           &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
    1491                         p_fld_crs(ii,2) = zflcrs 
    1492                      ENDDO 
    1493                  ENDIF 
    1494                  DO jj = njstr, njend, nn_facty 
    1495                     DO ji = nistr, niend, nn_factx 
    1496                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1497                        ij   = ( jj - njstr ) * rfacty_r + 3 
    1498                        ijie = mie_crs(ii) 
    1499                        zflcrs =  & 
    1500                          &  MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1501                          &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1502                           &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
    1503                         p_fld_crs(ii,ij) = zflcrs 
    1504                         !  
    1505                      ENDDO       
    1506                   ENDDO 
     1513!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1514!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1515!                        je_2 = mje_crs(2) 
     1516!                        DO ji = nistr, niend, nn_factx 
     1517!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1518!                           ijie = mie_crs(ii) 
     1519!                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
     1520!                           p_fld_crs(ii,2) = zflcrs 
     1521!                        ENDDO 
     1522!                     ENDIF 
     1523!                 ELSE 
     1524!                     je_2 = mjs_crs(2) 
     1525!                     DO ji = nistr, niend, nn_factx 
     1526!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1527!                        ijie = mie_crs(ii) 
     1528!                        zflcrs =  & 
     1529!                          &  MAX( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1530!                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1531!                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
     1532!                        p_fld_crs(ii,2) = zflcrs 
     1533!                     ENDDO 
     1534!                 ENDIF 
     1535!                 DO jj = njstr, njend, nn_facty 
     1536!                    DO ji = nistr, niend, nn_factx 
     1537!                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1538!                       ij   = ( jj - njstr ) * rfacty_r + 3 
     1539!                       ijie = mie_crs(ii) 
     1540!                       zflcrs =  & 
     1541!                         &  MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1542!                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1543!                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
     1544!                        p_fld_crs(ii,ij) = zflcrs 
     1545!                        !  
     1546!                     ENDDO       
     1547!                  ENDDO 
     1548                  CALL ctl_stop('MAX operator and U case not available') 
    15071549 
    15081550              END SELECT 
     
    15651607               CASE( 'V' ) 
    15661608 
    1567                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1568                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1569                         ijje = mje_crs(2) 
    1570                       ENDIF 
    1571                   ELSE 
    1572                      ijje = mjs_crs(2) 
    1573                   ENDIF 
    1574  
    1575                   DO ji = nistr, niend, nn_factx 
    1576                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1577                      zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1578                        &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1579                        &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1580                        ! 
    1581                      p_fld_crs(ii,2) = zflcrs 
    1582                   ENDDO       
    1583                   DO jj = njstr, njend, nn_facty 
    1584                      DO ji = nistr, niend, nn_factx 
    1585                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1586                         ij   = ( jj - njstr ) * rfacty_r + 3                
    1587                         ijje = mje_crs(ij)  
    1588                         !                   
    1589                         zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1590                           &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
    1591                           &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    1592                         ! 
    1593                         p_fld_crs(ii,ij) = zflcrs 
    1594                         ! 
    1595                      ENDDO       
    1596                   ENDDO 
     1609!                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1610!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1611!                        ijje = mje_crs(2) 
     1612!                      ENDIF 
     1613!                  ELSE 
     1614!                     ijje = mjs_crs(2) 
     1615!                  ENDIF 
     1616! 
     1617!                  DO ji = nistr, niend, nn_factx 
     1618!                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1619!                     zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1620!                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1621!                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
     1622!                       ! 
     1623!                     p_fld_crs(ii,2) = zflcrs 
     1624!                  ENDDO       
     1625!                  DO jj = njstr, njend, nn_facty 
     1626!                     DO ji = nistr, niend, nn_factx 
     1627!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1628!                        ij   = ( jj - njstr ) * rfacty_r + 3                
     1629!                        ijje = mje_crs(ij)  
     1630!                        !                   
     1631!                        zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1632!                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1633!                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
     1634!                        ! 
     1635!                        p_fld_crs(ii,ij) = zflcrs 
     1636!                        ! 
     1637!                     ENDDO       
     1638!                  ENDDO 
     1639                  CALL ctl_stop('MIN operator and V case not available') 
    15971640             
    15981641               CASE( 'U' ) 
    15991642 
    1600                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1601                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1602                         je_2 = mje_crs(2) 
    1603                         DO ji = nistr, niend, nn_factx 
    1604                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1605                            ijie = mie_crs(ii) 
    1606                            zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
    1607   
    1608                            p_fld_crs(ii,2) = zflcrs 
    1609                         ENDDO 
    1610                      ENDIF 
    1611                  ELSE 
    1612                      je_2 = mjs_crs(2) 
    1613                      DO ji = nistr, niend, nn_factx 
    1614                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
    1615                         ijie = mie_crs(ii) 
    1616                         zflcrs =  & 
    1617                           &  MIN( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1618                           &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
    1619                           &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
    1620                         p_fld_crs(ii,2) = zflcrs 
    1621                      ENDDO 
    1622                  ENDIF 
    1623                  DO jj = njstr, njend, nn_facty 
    1624                     DO ji = nistr, niend, nn_factx 
    1625                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1626                        ij   = ( jj - njstr ) * rfacty_r + 3 
    1627                        ijie = mie_crs(ii) 
    1628                        zflcrs =  & 
    1629                          &  MIN( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1630                          &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
    1631                           &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
    1632                         p_fld_crs(ii,ij) = zflcrs 
    1633                         !  
    1634                      ENDDO       
    1635                   ENDDO 
     1643!                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1644!                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1645!                        je_2 = mje_crs(2) 
     1646!                        DO ji = nistr, niend, nn_factx 
     1647!                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1648!                           ijie = mie_crs(ii) 
     1649!                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
     1650!  
     1651!                           p_fld_crs(ii,2) = zflcrs 
     1652!                        ENDDO 
     1653!                     ENDIF 
     1654!                 ELSE 
     1655!                     je_2 = mjs_crs(2) 
     1656!                     DO ji = nistr, niend, nn_factx 
     1657!                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1658!                        ijie = mie_crs(ii) 
     1659!                        zflcrs =  & 
     1660!                          &  MIN( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1661!                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1662!                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
     1663!                        p_fld_crs(ii,2) = zflcrs 
     1664!                     ENDDO 
     1665!                 ENDIF 
     1666!                 DO jj = njstr, njend, nn_facty 
     1667!                    DO ji = nistr, niend, nn_factx 
     1668!                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1669!                       ij   = ( jj - njstr ) * rfacty_r + 3 
     1670!                       ijie = mie_crs(ii) 
     1671!                       zflcrs =  & 
     1672!                         &  MIN( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1673!                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1674!                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
     1675!                        p_fld_crs(ii,ij) = zflcrs 
     1676!                        !  
     1677!                     ENDDO       
     1678!                  ENDDO 
     1679                  CALL ctl_stop('MIN operator and U case not available') 
    16361680 
    16371681              END SELECT 
     
    17501794                   &        + zsurf(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) 
    17511795 
    1752                 p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1796                !cbr 
     1797                !p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1798                IF( p_sfc_crs(ii,ij,jk) == 0.d0 )WRITE(narea+200,*)"crs_dom_e30 ",ii,ij,jk,p_sfc_crs(ii,ij,jk) ; call flush(narea+200) 
     1799                IF( p_sfc_crs(ii,ij,jk) .NE. 0.d0 )THEN ;  p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1800                ELSE                                    ;  p_e3_crs(ii,ij,jk) =0.d0 
     1801                ENDIF 
    17531802                ! 
    17541803                ze3crs = MAX( p_e3(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk),  & 
     
    18671916               ii = ( ji - mis_crs(2) ) * rfactx_r + 2   
    18681917               ij = ( jj - njstr ) * rfacty_r + 3 
     1918               IF( jk==1 .AND. ii==2 .AND. ij==18 )THEN 
     1919               WRITE(narea+200,*)"crs_dom_sfc ",zsurf(ji,jj  ,jk) , zsurf(ji+1,jj  ,jk) , zsurf(ji+2,jj  ,jk)  & 
     1920                    &                    , zsurf(ji,jj+1,jk) , zsurf(ji+1,jj+1,jk) , zsurf(ji+2,jj+1,jk)  & 
     1921                    &                    , zsurf(ji,jj+2,jk) , zsurf(ji+1,jj+2,jk) , zsurf(ji+2,jj+2,jk)  
     1922               call flush(narea+200) 
     1923               ENDIF 
    18691924               ! 
    18701925               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk)  & 
    18711926                    &                    + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk)  & 
    18721927                    &                    + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)   
    1873  
     1928               IF( jk==1 .AND. ii==2 .AND. ij==18 )WRITE(narea+200,*)"crs_dom_sfc ",p_surf_crs    (ii,ij,jk) ; call flush(narea+200) 
    18741929               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj  ,jk) + zsurfmsk(ji+1,jj  ,jk) + zsurfmsk(ji+2,jj  ,jk)  & 
    18751930                    &                    + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk)  & 
     
    18781933         ENDDO 
    18791934      ENDDO    
    1880  
     1935      WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs    (2,18,1) 
    18811936      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 ) 
    18821937      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
     1938      WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs    (2,18,1) 
    18831939 
    18841940      CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     
    18991955      INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices 
    19001956      INTEGER  :: ierr                                ! allocation error status 
     1957      INTEGER :: ii,ij,iproc,iprocno,iprocso 
    19011958  
    19021959   
     
    19111968      jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci 
    19121969      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj    
    1913                
    1914       IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors   
     1970      WRITE(narea+200,*)"jpj_crs noso = ", jpj_crs , noso         
     1971      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors   ! celle qui est faite de zeros 
     1972      WRITE(narea+200,*)"jpj_crs = ", jpj_crs 
    19151973        
    19161974      jpi_crsm1   = jpi_crs - 1 
     
    19411999         nlei_crs   = jpi_crs 
    19422000         nlej_crs   = jpj_crs 
    1943           
    1944         ! Calculs suivant une découpage en j 
    1945         DO jn = 1, jpnij, jpni 
    1946            IF( jn < ( jpnij - jpni + 1 ) ) THEN 
    1947               nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) & 
    1948                        &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) ) 
    1949            ELSE                                              
    1950               nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1             
     2001 
     2002        !============================================================================================== 
     2003        ! mpp_ini2 
     2004        !============================================================================================== 
     2005 
     2006        !cbr 
     2007        DO jn = 1, jpnij 
     2008           WRITE(narea+200,*)"=====> jn",jn  ; call flush(narea+200) 
     2009 
     2010           !proc jn 
     2011           DO ji = 1 , jpni 
     2012              DO jj = 1 ,jpnj 
     2013                 IF( nfipproc(ji,jj)  == jn-1 )THEN 
     2014                    ii=ji 
     2015                    ij=jj 
     2016                 ENDIF 
     2017              ENDDO  
     2018           ENDDO  
     2019           iproc =  ii + jpni * ( ij-1 ) - 1 
     2020           ! mppini :   
     2021           !iprocso =  ii + jpni * ( ij-2 ) - 1  
     2022           ! mppini2:           
     2023           IF( ij .GT. 1 )THEN ; iprocso =  nfipproc(ii,ij-1) 
     2024           ELSE                ; iprocso =  -1 
    19512025           ENDIF 
    1952            IF( noso < 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1              
     2026  
     2027           WRITE(narea+200,*)ii,ij  ; call flush(narea+200) 
     2028           WRITE(narea+200,*)"iproc iprocso ",iproc,iprocso 
     2029           WRITE(narea+200,*)"jpiglo jpjglo ",jpiglo,jpjglo 
     2030           WRITE(narea+200,*)"ibonit(jn) ibonjt(jn) ",ibonit(jn),ibonjt(jn) ; call flush(narea+200) 
     2031           WRITE(narea+200,*)"nimppt(jn) njmppt(jn) ",nimppt(jn),njmppt(jn) ; call flush(narea+200) 
     2032           WRITE(narea+200,*)"loc jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn),nlejt(jn),nlcjt(jn) ; call flush(narea+200) 
     2033           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) 
     2034 
     2035           !dimension selon j 
     2036           !------------------- 
     2037           IF( ibonjt(jn) .NE. 1 )THEN !on a besoin de savoir si jn est au nord 
     2038              !iprocno=nfipproc(ii,ij+1)  
     2039                 !iprocno=iprocno+1 
     2040                 WRITE(narea+200,*)"ii,ij+1 ",ii,ij+1; call flush(narea+200) 
     2041                 WRITE(narea+200,*)"njmppt  jn njmpptno(jn) ",njmppt(jn),njmpptno(jn); call flush(narea+200) 
     2042                 WRITE(narea+200,*)"jpjglo",jpjglo ; call flush(narea+200) 
     2043 
     2044                 WRITE(narea+200,*)REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ),REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ); call flush(narea+200) 
     2045                 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) 
     2046 
     2047                 nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ) & 
     2048                      &        - AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ) 
     2049           ELSE ! ibonjt=1 : au nord 
     2050              nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1 
     2051           ENDIF 
     2052           !==> nbondj = -1 au sud, 0 au milieu, 1 au nord, 2 si jpnj=1 
     2053           WRITE(narea+200,*)"nlejt_crs(jn) ",nlejt_crs(jn) ; call flush(narea+200) 
     2054           !!!noso== nbre de proc sud du proc sur lequel on tourne !!!! ; dangeureux car on est ds une boucle sur jn 
     2055           IF( iprocso < 0 .AND. ibonjt(jn) == -1 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 
    19532056           SELECT CASE( ibonjt(jn) ) 
    19542057              CASE ( -1 ) 
    1955                 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
     2058                WRITE(narea+200,*)"MOD( jpjglo - njmppt(jn), nn_facty)",MOD( jpjglo - njmppt(jn), nn_facty) ; call flush(narea+200) 
     2059                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1  ! au cas où il reste des lignes en bas 
     2060                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    19562061                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
    19572062                nldjt_crs(jn) = nldjt(jn) 
    1958                
     2063                !???nlejt_crs(jn) = nlejt_crs(jn) + 1 ! 2 !cbr   
    19592064              CASE ( 0 ) 
    1960                
     2065 
    19612066                nldjt_crs(jn) = nldjt(jn) 
    19622067                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    19632068                nlejt_crs(jn) = nlejt_crs(jn) + jprecj 
    19642069                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
    1965                  
     2070 
    19662071              CASE ( 1, 2 ) 
    1967                
     2072    
    19682073                nlejt_crs(jn) = nlejt_crs(jn) + jprecj 
    19692074                nlcjt_crs(jn) = nlejt_crs(jn) 
    19702075                nldjt_crs(jn) = nldjt(jn) 
    1971                  
    19722076              CASE DEFAULT 
    19732077                 STOP 
    19742078           END SELECT 
    1975            IF( nlcjt_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1 
    1976  
     2079           WRITE(narea+200,*)"jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) " ; call flush(narea+200) 
     2080           WRITE(narea+200,*) jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
     2081           IF( nlcjt_crs(jn) > jpj_crs )THEN 
     2082              jpj_crs = jpj_crs + 1 
     2083              nlejt_crs(jn) = nlejt_crs(jn) + 1 
     2084           ENDIF 
     2085           !cbr pas bon !!!! 
     2086           !on augmente la taille des domaines alors que les tblx st deja alloués 
     2087           !du coup on alloue les tblx apres: 
    19772088           IF(nldjt_crs(jn) == 1 ) THEN 
    19782089              njmppt_crs(jn) = 1 
    19792090           ELSE 
    19802091              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) ) 
    1981            ENDIF            
    1982             
    1983            DO jj = jn + 1, jn + jpni - 1 
    1984               nlejt_crs(jj) = nlejt_crs(jn)  
    1985               nlcjt_crs(jj) = nlcjt_crs(jn) 
    1986               nldjt_crs(jj) = nldjt_crs(jn) 
    1987               njmppt_crs(jj)= njmppt_crs(jn) 
    1988            ENDDO 
    1989         ENDDO  
    1990         nlej_crs  = nlejt_crs(nproc + 1)  
    1991         nlcj_crs  = nlcjt_crs(nproc + 1) 
    1992         nldj_crs  = nldjt_crs(nproc + 1) 
    1993         njmpp_crs = njmppt_crs(nproc + 1) 
    1994  
    1995         ! Calcul suivant un decoupage en i 
    1996         DO jn = 1, jpni 
    1997            IF( jn == 1 ) THEN           
     2092           ENDIF 
     2093           WRITE(narea+200,*)"tutu loc ",jn,jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
     2094           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) 
     2095 
     2096 
     2097           !dimensions selon i 
     2098           !------------------- 
     2099           !IF( jn == 1 ) THEN 
     2100           !IF( ibonit(jn)==-1 )THEN !on a besoin de savoir si jn est un proc west 
     2101           IF( ii==1 )THEN !on a besoin de savoir si jn est un proc west 
    19982102              nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) 
    19992103           ELSE 
    2000               nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) & 
    2001                  &          - AINT( REAL( ( nimppt(jn-1) - 1 + nlcit(jn-1) )  / nn_factx, wp) ) 
     2104              WRITE(narea+200,*)"njmppt  jn njmpptea(jn) ",nimppt(jn),nimpptea(jn); call flush(narea+200) 
     2105              WRITE(narea+200,*)"nlcit  (jn) nlcitea(jn) ) ",nlcit  (jn),nlcitea(jn); call flush(narea+200) 
     2106              nleit_crs(jn) = AINT( REAL( ( nimppt  (jn) - 1 + nlcit  (jn) )  / nn_factx, wp) ) & 
     2107                 &          - AINT( REAL( ( nimpptea(jn) - 1 + nlcitea(jn) )  / nn_factx, wp) ) 
    20022108           ENDIF 
     2109           WRITE(narea+200,*)"nleji_crs(jn),noso ",nleit_crs(jn); call flush(narea+200) 
     2110 
    20032111 
    20042112           SELECT CASE( ibonit(jn) ) 
    20052113              CASE ( -1 ) 
    2006                  nleit_crs(jn) = nleit_crs(jn) + jpreci            
     2114                 nleit_crs(jn) = nleit_crs(jn) + jpreci 
    20072115                 nlcit_crs(jn) = nleit_crs(jn) + jpreci 
    2008                  nldit_crs(jn) = nldit(jn)  
    2009                
     2116                 nldit_crs(jn) = nldit(jn) 
     2117 
    20102118              CASE ( 0 ) 
    20112119                 nleit_crs(jn) = nleit_crs(jn) + jpreci 
    20122120                 nlcit_crs(jn) = nleit_crs(jn) + jpreci 
    2013                  nldit_crs(jn) = nldit(jn)  
    2014                  
     2121                 nldit_crs(jn) = nldit(jn) 
     2122 
    20152123              CASE ( 1, 2 ) 
    20162124                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1 
    20172125                 nleit_crs(jn) = nleit_crs(jn) + jpreci 
    20182126                 nlcit_crs(jn) = nleit_crs(jn) 
    2019                  nldit_crs(jn) = nldit(jn)  
     2127                 nldit_crs(jn) = nldit(jn) 
    20202128 
    20212129              CASE DEFAULT 
    20222130                 STOP 
    20232131           END SELECT 
    2024  
     2132           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) 
    20252133           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 
    2026            DO jj = jn + jpni , jpnij, jpni 
    2027               nleit_crs(jj) = nleit_crs(jn)  
    2028               nlcit_crs(jj) = nlcit_crs(jn) 
    2029               nldit_crs(jj) = nldit_crs(jn) 
    2030               nimppt_crs(jj)= nimppt_crs(jn) 
    2031            ENDDO 
    2032          ENDDO  
    2033          
    2034          nlei_crs  = nleit_crs(nproc + 1)  
    2035          nlci_crs  = nlcit_crs(nproc + 1) 
    2036          nldi_crs  = nldit_crs(nproc + 1) 
    2037          nimpp_crs = nimppt_crs(nproc + 1) 
     2134 
     2135           WRITE(narea+200,*)"tutu loc ",jn,jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 
     2136           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) 
     2137 
     2138 
     2139        ENDDO 
     2140 
     2141        nlej_crs  = nlejt_crs(nproc + 1) 
     2142        nlcj_crs  = nlcjt_crs(nproc + 1) 
     2143        nldj_crs  = nldjt_crs(nproc + 1) 
     2144        njmpp_crs = njmppt_crs(nproc + 1) 
     2145 
     2146        nlei_crs  = nleit_crs(nproc + 1) 
     2147        nlci_crs  = nlcit_crs(nproc + 1) 
     2148        nldi_crs  = nldit_crs(nproc + 1) 
     2149        nimpp_crs = nimppt_crs(nproc + 1) 
     2150 
     2151        !============================================================================================== 
     2152         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) 
     2153         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) 
     2154         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) 
     2155         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) 
    20382156 
    20392157         ! No coarsening with zoom 
    20402158         IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP  
    20412159 
     2160         !cbr 
     2161         ierr = crs_dom_alloc1()  
     2162 
    20422163         DO ji = 1, jpi_crs 
    20432164            mig_crs(ji) = ji + nimpp_crs - 1 
     2165            WRITE(narea+200,*)"fifi ",ji,mig_crs(ji)  ; call flush(narea+200) 
    20442166         ENDDO 
    20452167         DO jj = 1, jpj_crs 
    20462168            mjg_crs(jj) = jj + njmpp_crs - 1! 
     2169            WRITE(narea+200,*)"fufu ",jj,mjg_crs(jj)  ; call flush(narea+200) 
    20472170         ENDDO 
    20482171        
     
    20502173            mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 
    20512174            mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) ) 
     2175            WRITE(narea+200,*)"mi ",ji,mi0_crs(ji),mi1_crs(ji)  ; call flush(narea+200) 
    20522176         ENDDO 
    20532177          
     
    20552179            mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 
    20562180            mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) ) 
     2181            WRITE(narea+200,*)"mj ",jj, mj0_crs(jj),mj1_crs(jj) ; call flush(narea+200) 
    20572182         ENDDO 
    20582183 
     
    21712296                mjs2_crs(jpjglo_crs-jj+2) = ijjs 
    21722297                mje2_crs(jpjglo_crs-jj+2) = ijje 
     2298               WRITE(narea+200,*)"jpjglo_crs-jj+2,ijje,ijjs ",jpjglo_crs-jj+2,ijjs,ijje ; call flush(narea+200) 
    21732299            ENDDO 
    21742300 
     
    22002326                ijjs = ijje - nn_facty + 1                   
    22012327                IF ( ijjs <= nn_facty )  ijjs = 2 
     2328                WRITE(narea+200,*)"fufu",jj,ijjs,ijje ; call flush(narea+200) 
    22022329                mjs2_crs(jpj_crs-jj+1)   = ijjs 
    22032330                mje2_crs(jpj_crs-jj+1)   = ijje 
     
    22302357        mje_crs(:) = mje2_crs(:)  
    22312358      ELSE 
     2359       write(narea+200,*)"njmpp ",njmpp 
    22322360        DO jj = 1, nlej_crs 
     2361           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) 
    22332362           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
    22342363           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
     2364           write(narea+200,*)"mjs_crs mje_crs ",mjs_crs(jj),mje_crs(jj) ; call flush(narea+200) 
    22352365        ENDDO 
     2366        write(narea+200,*)"nimpp ",nimpp 
    22362367        DO ji = 1, nlei_crs 
     2368           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) 
    22372369           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
    22382370           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
     2371           write(narea+200,*)"mis_crs mie_crs ",mis_crs(jj),mie_crs(jj) ; call flush(narea+200) 
    22392372        ENDDO 
    22402373      ENDIF 
    22412374      ! 
     2375      IF( nlcj_crs -1 .GT. nlej_crs )WRITE(narea+200,*)"tutututu",nlcj_crs,nlej_crs ; call flush(narea+200) 
    22422376      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1) 
    22432377      njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r4149 r5007  
    179179                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) ) 
    180180                   ! 
    181                    hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)  
     181                   IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
    182182               ENDIF 
    183183            ENDDO 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r4624 r5007  
    191191     !    3.d.2   Surfaces  
    192192     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    ) 
     193     WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1) 
    193194     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u ) 
    194195     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 
    195196    
    196      facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:) 
    197      facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:) 
     197     !cbr facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:) 
     198     !cbr facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:) 
     199     WRITE(narea+200,*)'umask_crs ',SHAPE(umask_crs) 
     200     WRITE(narea+200,*)jpi,jpj,jpk 
     201     WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1) 
     202     CALL flush(narea+200) 
     203 
     204     DO jk=1,jpk 
     205        DO ji=1,jpi_crs 
     206           DO jj=1,jpj_crs 
     207 
     208              facsurfu(ji,jj,jk) = umask_crs(ji,jj,jk) * e2e3u_msk(ji,jj,jk)   
     209              IF( e2e3u_crs(ji,jj,jk) .NE. 0._wp ) facsurfu(ji,jj,jk) = facsurfu(ji,jj,jk) / e2e3u_crs(ji,jj,jk) 
     210 
     211              facsurfv(ji,jj,jk) = vmask_crs(ji,jj,jk) * e1e3v_msk(ji,jj,jk)   
     212              IF( e1e3v_crs(ji,jj,jk) .NE. 0._wp ) facsurfv(ji,jj,jk) = facsurfv(ji,jj,jk) / e1e3v_crs(ji,jj,jk) 
     213 
     214           ENDDO 
     215        ENDDO 
     216     ENDDO 
    198217 
    199218     !    3.d.3   Vertical scale factors 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r4679 r5007  
    274274         nfipproc(ii,ij) = jn - 1 
    275275         nimppt(jn) = iimppt(ii,ij) 
     276         IF( ii==1 )THEN  ; nimpptea(jn) = -1 
     277         ELSE             ; nimpptea(jn) = iimppt(ii-1,ij) 
     278         ENDIF 
    276279         njmppt(jn) = ijmppt(ii,ij) 
     280         IF( ij==jpnj )THEN  ; njmpptno(jn) = -1 
     281         ELSE                ; njmpptno(jn) = ijmppt(ii,ij+1) 
     282         ENDIF 
    277283         nlcit (jn) = ilcit (ii,ij)      
     284         IF( ii .GT. 1 )THEN ; nlcitea(jn) = ilcit(ii-1,ij) 
     285         ELSE                ; nlcitea(jn) = -1 
     286         ENDIF 
    278287         nlci       = nlcit (jn)      
    279288         nlcjt (jn) = ilcjt (ii,ij)      
     
    290299         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction 
    291300         ibonit(jn) = nbondi 
    292           
     301   
    293302         nldi =  1   + jpreci 
    294303         nlei = nlci - jpreci 
     
    356365      nimpp  = nimppt(narea)   
    357366      njmpp  = njmppt(narea)   
     367      WRITE(narea+200,*)"jpi,jpj,nlci,nlcj,nldi,nldj,nlei,nlej" 
     368      WRITE(narea+200,*)jpi,jpj,nlci,nlcj,nldi,nldj,nlei,nlej ; call flush(narea+200) !cbr  
     369      WRITE(narea+200,*)"nldi+nimpp-1,nldj+njmpp-1,nlei+nimpp-1,nlej+njmpp-1" ; call flush(narea+200) !cbr 
     370      WRITE(narea+200,*)nldi+nimpp-1,nldj+njmpp-1,nlei+nimpp-1,nlej+njmpp-1 ; call flush(narea+200) !cbr 
    358371 
    359372     ! Save processor layout in layout.dat file  
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r4990 r5007  
    6767         imask                                ! temporary global workspace 
    6868      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   & 
    69          zdta, zdtaisf                     ! temporary data workspace 
     69         zdta                   ! temporary data workspace 
    7070      REAL(wp) ::   zidom , zjdom          ! temporary scalars 
    7171 
    7272      ! read namelist for ln_zco 
    73       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
     73      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 
    7474 
    7575      !!---------------------------------------------------------------------- 
     
    109109      ENDIF 
    110110      CALL iom_close (inum) 
    111        
    112       ! used to compute the land processor in case of not masked bathy file. 
    113       zdtaisf(:,:) = 0.0_wp 
    114       IF ( ln_isfcav ) THEN 
    115          CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
    116          CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 
    117       END IF 
    118       CALL iom_close (inum) 
    119111 
    120112      ! land/sea mask over the global/zoom domain 
    121113 
    122114      imask(:,:)=1 
    123       WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0 
     115      WHERE ( zdta(:,:) <= 0. ) imask = 0 
    124116 
    125117      !  1. Dimension arrays for subdomains 
     
    204196         ii = 1 + MOD(jarea-1,jpni) 
    205197         ij = 1 +    (jarea-1)/jpni 
     198         write(narea+200,*)"mppini_2  ====== > ",jarea,ii,ij 
    206199         ili = ilci(ii,ij) 
    207200         ilj = ilcj(ii,ij) 
     
    214207         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1 
    215208         IF( jpni            == 1 )   ibondi(ii,ij) =  2 
    216  
     209         write(narea+200,*)"titi",jarea,ii,ij,MOD(jarea,jpni),ibondi(ii,ij) ; call flush(narea+200) 
    217210         ! 2.4 Subdomain neighbors 
    218211 
    219212         iproc = jarea - 1 
    220213         ioso(ii,ij) = iproc - jpni 
     214         write(narea+200,*)"mppini_2 0: ",ii,ij,iproc,jpni,ioso(ii,ij) ; call flush(narea+200) 
    221215         iowe(ii,ij) = iproc - 1 
    222216         ioea(ii,ij) = iproc + 1 
     
    287281            ENDIF 
    288282         ENDIF 
     283         write(narea+200,*)"titi",jarea,ibondi(ii,ij) ; call flush(narea+200) 
    289284         ipolj(ii,ij) = 0 
    290285         IF( jperio == 3 .OR. jperio == 4 ) THEN 
     
    314309            iin(icont+1) = ii 
    315310            ijn(icont+1) = ij 
     311            ibonit(icont+1) = ibondi(ii,ij) 
     312            ibonjt(icont+1) = ibondj(ii,ij) 
     313            write(narea+200,*)"titi 1 ",icont+1,ibonit(icont+1) ; call flush(narea+200) 
    316314         ENDIF 
    317315      END DO 
     
    426424      ii = iin(narea) 
    427425      ij = ijn(narea) 
     426      write(narea+200,*)"mppini_2 a ",noso,ii,ij,ioso(ii,ij),jpni*jpnj-1 ; call flush(narea+200) 
    428427      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN  
    429428         iiso = 1 + MOD(ioso(ii,ij),jpni) 
    430429         ijso = 1 +    (ioso(ii,ij))/jpni 
    431430         noso = ipproc(iiso,ijso) 
     431         write(narea+200,*)"mppini_2 b ",iiso,ijso,noso  ; call flush(narea+200) 
     432      ELSE 
     433         noso = -1 
    432434      ENDIF 
    433435      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN  
     
    440442         ijea = 1 +    (ioea(ii,ij))/jpni 
    441443         noea = ipproc(iiea,ijea) 
     444      ELSE 
     445         noea = -1 
    442446      ENDIF 
    443447      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN  
     
    484488         ij = ijn(jproc) 
    485489         nimppt(jproc) = iimppt(ii,ij)   
     490         IF( ii==1 )THEN  ; nimpptea(jproc) = -1 
     491         ELSE             ; nimpptea(jproc) = iimppt(ii-1,ij) 
     492         ENDIF 
    486493         njmppt(jproc) = ijmppt(ii,ij)   
     494         IF( ij==jpnj )THEN  ; njmpptno(jproc) = -1 
     495         ELSE                ; njmpptno(jproc) = ijmppt(ii,ij+1) 
     496         ENDIF 
    487497         nlcjt(jproc) = ilcj(ii,ij) 
    488498         nlcit(jproc) = ilci(ii,ij) 
     499         IF( ii .GT. 1 )THEN ; nlcitea(jproc) = ilci(ii-1,ij) 
     500         ELSE                ; nlcitea(jproc) = -1 
     501         ENDIF 
    489502         nldit(jproc) = ildi(ii,ij) 
    490503         nleit(jproc) = ilei(ii,ij) 
Note: See TracChangeset for help on using the changeset viewer.