Changeset 5105


Ignore:
Timestamp:
2015-02-24T15:46:25+01:00 (6 years ago)
Author:
cbricaud
Message:

bug correction

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
Files:
14 added
18 edited

Legend:

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

    r5010 r5105  
    9494  
    9595      ! Masks 
    96       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs 
    97       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs 
     96      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: tmask_crs, umask_crs, vmask_crs, fmask_crs 
     97      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE,SAVE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs 
    9898       
    9999  !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol       
     
    112112                                                                  ! vertical scale factors  
    113113      ! Coordinates 
    114       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs  
    115       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs  
    116       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: ff_crs 
    117       INTEGER,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs 
    118       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs 
     114      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs  
     115      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs  
     116      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: ff_crs 
     117      INTEGER,  DIMENSION(:,:),   ALLOCATABLE,SAVE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs 
     118      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs 
    119119 
    120120      ! Weights 
     
    136136      INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)  
    137137      LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence  
     138      LOGICAL, PUBLIC   :: ln_crs_top = .FALSE.          !:coarsening online for the bio 
    138139      ! 
    139140      INTEGER           :: nrestx, nresty       !: for determining odd or even reduction factor 
     
    146147 
    147148      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields 
    148       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs 
     149      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs 
    149150      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs 
    150       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs     
    151       REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs     
     151      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: ub_crs, vb_crs 
     152      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivb_crs , hdivn_crs     
     153      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshb_crs, sshn_crs , ssha_crs 
     154      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: rhop_crs,rhd_crs,rb2_crs 
     155      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: gru_crs, grv_crs 
     156      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: gtsu_crs, gtsv_crs 
    152157      !  
    153158      ! Surface fluxes to pass to TOP 
    154159      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs 
    155160      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs 
     161      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fmmflx_crs 
    156162      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs 
    157163      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs 
     
    164170 
    165171      ! Mixing and Mixed Layer Depth 
    166       INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                        
     172      INTEGER,  PUBLIC, DIMENSION(:,:) , ALLOCATABLE ::  nmln_crs 
     173      REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: hmlp_crs , hmlpt_crs , hmld_crs 
    167174 
    168175      ! Direction of lateral diffusion 
     
    235242 
    236243 
    237       ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , & 
    238          &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),& 
    239          &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11)) 
    240  
    241      ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 
     244      ALLOCATE( ub_crs(jpi_crs,jpj_crs,jpk) , vb_crs(jpi_crs,jpj_crs,jpk) , & 
     245         &      un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk)    ,  wn_crs(jpi_crs,jpj_crs,jpk) , & 
     246         &      hdivb_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , & 
     247         &      rke_crs(jpi_crs,jpj_crs,jpk), rhop_crs(jpi_crs,jpj_crs,jpk)  , & 
     248         &      rb2_crs(jpi_crs,jpj_crs,jpk) ,rhd_crs(jpi_crs,jpj_crs,jpk)   , & 
     249         &      gtsu_crs(jpi_crs,jpj_crs,jpk) ,gtsv_crs(jpi_crs,jpj_crs,jpk) , & 
     250                gru_crs(jpi_crs,jpj_crs) ,grv_crs(jpi_crs,jpj_crs) , STAT=ierr(11)) 
     251 
     252     ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs),  ssha_crs(jpi_crs,jpj_crs), & 
     253         &     emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 
    242254         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 
    243255         &     vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), & 
    244          &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), STAT=ierr(12)  ) 
    245  
    246      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    & 
     256         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs), STAT=ierr(12)  ) 
     257 
     258     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    & 
    247259# if defined key_zdfddm 
    248260         &      avs_crs(jpi_crs,jpj_crs,jpk),    & 
     
    302314      !! ** Purpose : +Return back to parent grid domain  
    303315      !!--------------------------------------------------------------------- 
    304       write(narea+200,*)"dom_grid_glo";call flush(narea+200) 
    305316 
    306317      !                         Return to parent grid domain 
     
    346357      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain 
    347358      !!--------------------------------------------------------------------- 
    348       write(narea+200,*)"dom_grid_crs";call flush(narea+200) 
    349359      ! 
    350360      !                        Switch to coarse grid domain 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r5010 r5105  
    5252   END INTERFACE 
    5353 
    54    REAL(wp) :: r_inf = 1e+36 
     54   REAL(wp),PUBLIC :: r_inf = 1e+7 !cbr 1e+36 
    5555 
    5656   !! Substitutions 
     
    6464      INTEGER  ::  ji, jj, jk                   ! dummy loop indices 
    6565      INTEGER  ::  ijie,ijis,ijje,ijjs,ij,je_2 
     66      INTEGER  ::  iji, ijj 
    6667      REAL(wp) ::  zmask 
    6768       
     
    122123               ijjs = mjs_crs(jj) 
    123124 
    124                IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 
     125               !iji=117 ; ijj=211 
     126               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     127               !IF( ji ==iji .AND. jj==ijj .AND. jk==74 )THEN 
     128               !write(narea+5000,*)"mask ",ji,jj 
     129               !write(narea+5000,*)"mask ",ijie,ijis,ijjs,ijje 
     130               !ENDIF 
     131 
     132               !IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 
    125133               zmask = 0.0 
    126134               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
     
    140148         ENDDO 
    141149      ENDDO 
     150      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 
     151      !cbr 
     152      !DO ji=1,jpi_crs-1 
     153      !DO jj=1,jpj_crs-1 
     154      !DO jk=1,jpk 
     155      !   umask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji+1,jj  ,jk) 
     156      !   vmask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji  ,jj+1,jk) 
     157      !   fmask_crs(ji,jj,jk) = tmask_crs(ji  ,jj  ,jk) * tmask_crs(ji  ,jj+1,jk) *  tmask_crs(ji+1,jj  ,jk) *   tmask_crs(ji+1,jj+1,jk)  
     158      !ENDDO 
     159      !ENDDO 
     160      !ENDDO 
    142161      ! 
    143       CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 
    144162      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 ) 
    145163      CALL crs_lbc_lnk( umask_crs, 'U', 1.0 ) 
    146164      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 ) 
     165      ! 
     166      !cbr 
     167      !DO ji=2,jpi_crs-1 
     168      !DO jj=2,jpj_crs-1 
     169      !DO jk=1,jpk 
     170      !   IF( tmask(ji-1,jj  ,jk)==1. .AND. tmask(ji  ,jj  ,jk)==1. .AND. umask(ji-1,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK1",ji,jj,jk 
     171      !   IF( tmask(ji  ,jj  ,jk)==1. .AND. tmask(ji+1,jj  ,jk)==1. .AND. umask(ji  ,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK2",ji,jj,jk 
     172      !   IF( tmask(ji  ,jj-1,jk)==1. .AND. tmask(ji  ,jj  ,jk)==1. .AND. vmask(ji  ,jj-1,jk)==0. )WRITE(narea+5000,*)"MASK3",ji,jj,jk 
     173      !   IF( tmask(ji  ,jj  ,jk)==1. .AND. tmask(ji  ,jj+1,jk)==1. .AND. vmask(ji  ,jj  ,jk)==0. )WRITE(narea+5000,*)"MASK4",ji,jj,jk 
     174      !   IF( umask(ji-1,jj  ,jk)==1. .AND. ( tmask(ji-1,jj  ,jk)==0. .OR. tmask(ji  ,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK5",ji,jj,jk 
     175      !   IF( umask(ji  ,jj  ,jk)==1. .AND. ( tmask(ji  ,jj  ,jk)==0. .OR. tmask(ji+1,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK6",ji,jj,jk 
     176      !   IF( vmask(ji  ,jj-1,jk)==1. .AND. ( tmask(ji  ,jj-1,jk)==0. .OR. tmask(ji  ,jj  ,jk)==0. ) )WRITE(narea+5000,*)"MASK7",ji,jj,jk 
     177      !   IF( vmask(ji  ,jj  ,jk)==1. .AND. ( tmask(ji  ,jj  ,jk)==0. .OR. tmask(ji  ,jj+1,jk)==0. ) )WRITE(narea+5000,*)"MASK8",ji,jj,jk 
     178      !ENDDO 
     179      !ENDDO 
     180      !ENDDO 
    147181      ! 
    148182   END SUBROUTINE crs_dom_msk 
     
    385419 
    386420      zmask(:,:,:) = 0.0 
    387       IF( cd_type == 'W' ) THEN 
    388          zmask(:,:,1) = p_mask(:,:,1)  
    389          DO jk = 2, jpk 
    390             zmask(:,:,jk) = p_mask(:,:,jk-1)  
    391          ENDDO 
    392       ELSE 
     421      !IF( cd_type == 'W' ) THEN 
     422      !   zmask(:,:,1) = p_mask(:,:,1)  
     423      !   DO jk = 2, jpk 
     424      !      zmask(:,:,jk) = p_mask(:,:,jk-1)  
     425      !   ENDDO 
     426      !ELSE 
    393427         DO jk = 1, jpk 
    394428             zmask(:,:,jk) = p_mask(:,:,jk)  
    395429         ENDDO 
    396       ENDIF 
     430      !ENDIF 
    397431 
    398432      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     
    513547      REAL(wp) :: zflcrs, zsfcrs    
    514548      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask   
     549      INTEGER  :: iji, ijj 
    515550      !!----------------------------------------------------------------   
    516551    
     
    526561             
    527562               CASE( 'T', 'W' ) 
    528                   IF( cd_type == 'T' ) THEN 
     563                  !IF( cd_type == 'T' ) THEN 
    529564                     DO jk = 1, jpk 
    530565                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)  
    531566                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk)  
    532567                    ENDDO 
    533                   ELSE 
    534                      zsurf   (:,:,1) =  p_e12(:,:) * p_e3(:,:,1) 
    535                      zsurfmsk(:,:,1) =  zsurf(:,:,1) *  p_mask(:,:,1)  
    536                      DO jk = 2, jpk 
    537                         zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) 
    538                         zsurfmsk(:,:,jk) =  zsurf(:,:,jk) * p_mask(:,:,jk-1)  
    539                      ENDDO 
    540                   ENDIF 
     568                  !ELSE 
     569                  !  !cbr ???????????????????????????????? 
     570                  !   zsurf   (:,:,1) =  p_e12(:,:) * p_e3(:,:,1) 
     571                  !   zsurfmsk(:,:,1) =  zsurf(:,:,1) *  p_mask(:,:,1)  
     572                  !   DO jk = 2, jpk 
     573                  !      zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) 
     574                  !      zsurfmsk(:,:,jk) =  zsurf(:,:,jk) * p_mask(:,:,jk-1)  
     575                  !   ENDDO 
     576                  !ENDIF 
    541577          
    542578                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     
    619655              CASE( 'W' ) 
    620656                  IF( PRESENT( p_e3 ) ) THEN 
    621                     zsurfmsk(:,:,1) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)  
    622                     DO jk = 2, jpk 
    623                       zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1)  
     657                    !cbr ????????????? 
     658                    !zsurfmsk(:,:,1) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)  
     659                    !DO jk = 2, jpk 
     660                    !  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1)  
     661                    !ENDDO 
     662                    DO jk = 1, jpk 
     663                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk)  
    624664                    ENDDO 
    625665                 ELSE 
    626                     zsurfmsk(:,:,1) =  p_e12(:,:) * p_mask(:,:,1)  
    627                     DO jk = 2, jpk 
    628                       zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk-1)  
     666                    !zsurfmsk(:,:,1) =  p_e12(:,:) * p_mask(:,:,1)  
     667                    !DO jk = 2, jpk 
     668                    !  zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk-1)  
     669                    !ENDDO 
     670                    DO jk = 1, jpk 
     671                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk)  
    629672                    ENDDO 
    630673                 ENDIF 
     
    712755                               &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) 
    713756 
    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 
     757                              !zsfcrs = zsurfmsk(ji  ,jj  ,jk) & 
     758                              ! &     + zsurfmsk(ji+1,jj  ,jk) & 
     759                              ! &     + zsurfmsk(ji+2,jj  ,jk) 
     760 
     761                              !IF( zsfcrs == 0 ) THEN  ; p_fld_crs(ii,2,jk) = zflcrs 
     762                              !ELSE                    ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     763                              !ENDIF 
    721764                           ENDIF 
    722765                        ELSE 
     
    726769                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 
    727770                           ! 
    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 
     771                           !zsfcrs =  zsurfmsk(ji  ,ijje,jk) & 
     772                           !  &     + zsurfmsk(ji+1,ijje,jk) & 
     773                           !  &     + zsurfmsk(ji+2,ijje,jk) 
     774 
     775                           p_fld_crs(ii,2,jk) = zflcrs 
     776                           !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 
     777                           !ELSE                   ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     778                           !ENDIF 
    735779 
    736780                        ENDIF 
     
    746790                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk)  
    747791                           ! 
    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 
     792                           !zsfcrs =  zsurfmsk(ji  ,ijje,jk)  & 
     793                           !  &     + zsurfmsk(ji+1,ijje,jk)  & 
     794                           !  &     + zsurfmsk(ji+2,ijje,jk)  
     795 
     796                           p_fld_crs(ii,ij,jk) = zflcrs 
     797                           !cbr1 
     798               !iji=117 ; ijj=210 
     799               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     800               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
     801               !WRITE(narea+5000,*)"OPE V =======> " 
     802               !WRITE(narea+5000,*)ii,ij,jk 
     803               !WRITE(narea+5000,*)ji,jj,ijje 
     804               !WRITE(narea+5000,*)p_fld(ji  ,ijje,jk) 
     805               !WRITE(narea+5000,*)p_fld(ji+1,ijje,jk) 
     806               !WRITE(narea+5000,*)p_fld(ji+2,ijje,jk) 
     807               !WRITE(narea+5000,*)zflcrs 
     808               !ENDIF 
     809 
     810                           !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs 
     811                           !ELSE                   ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
     812                           !ENDIF 
    755813                           ! 
     814               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )WRITE(narea+5000,*)" p_fld_crs(ii,ij,jk) = ", p_fld_crs(ii,ij,jk) 
    756815                        ENDDO 
    757816                     ENDDO 
     
    809868              ENDIF 
    810869 
     870         !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) end SUM = ",p_fld(17,5,74) 
    811871              CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk ) 
    812872 
     
    9871047            CALL wrk_alloc( jpi, jpj, jpk, zmask ) 
    9881048 
    989             SELECT CASE ( cd_type ) 
    990               CASE( 'W' ) 
    991                   zmask(:,:,1) = p_mask(:,:,1)  
    992                   DO jk = 2, jpk 
    993                      zmask(:,:,jk) = p_mask(:,:,jk-1)  
    994                   ENDDO 
    995               CASE ( 'T' ) 
     1049            !SELECT CASE ( cd_type ) 
     1050            !  CASE( 'W' ) 
     1051            !      !cbr ????????????????????????????? 
     1052            !      zmask(:,:,1) = p_mask(:,:,1)  
     1053            !      DO jk = 2, jpk 
     1054            !         zmask(:,:,jk) = p_mask(:,:,jk-1)  
     1055            !      ENDDO 
     1056            !  CASE ( 'T' ) 
    9961057                  DO jk = 1, jpk 
    9971058                     zmask(:,:,jk) = p_mask(:,:,jk)  
    9981059                  ENDDO 
    999             END SELECT 
     1060            !END SELECT 
    10001061 
    10011062            SELECT CASE ( cd_type ) 
     
    11571218         END SELECT 
    11581219         ! 
     1220         !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) avt lbc = ",p_fld(17,5,74) 
    11591221         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn ) 
     1222         !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) apr lbc = ",p_fld(17,5,74) 
    11601223         ! 
    11611224    END SUBROUTINE crs_dom_ope_3d 
     
    12051268 
    12061269      !!----------------------------------------------------------------   
    1207     
     1270  
    12081271      p_fld_crs(:,:) = 0.0 
    12091272 
     
    17021765      INTEGER ::  ijie, ijje, ii, ij, je_2 
    17031766      REAL(wp) :: ze3crs   
    1704       REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf    
     1767      !REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf    
    17051768 
    17061769      !!----------------------------------------------------------------   
     
    17101773    
    17111774 
    1712        CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf ) 
     1775       !CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf ) 
    17131776 
    17141777       SELECT CASE ( cd_type ) 
    1715           CASE( 'W' ) 
    1716               zmask(:,:,1) = p_mask(:,:,1)  
    1717               DO jk = 2, jpk 
    1718                  zmask(:,:,jk) = p_mask(:,:,jk-1)  
    1719               ENDDO 
    1720            CASE DEFAULT 
    1721               DO jk = 1, jpk 
    1722                  zmask(:,:,jk) = p_mask(:,:,jk)  
    1723               ENDDO 
     1778 
     1779         CASE ('T') 
     1780 
     1781            DO jk = 1 , jpk 
     1782               DO ji = nistr, niend, nn_factx 
     1783 
     1784                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     1785                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
     1786 
     1787                  IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1788 
     1789                    jj = mje_crs(2) 
     1790 
     1791 
     1792                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
     1793                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
     1794                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)) 
     1795 
     1796                    p_e3_max_crs(ii,2,jk) = ze3crs 
     1797 
     1798                    ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
     1799                        &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
     1800                        &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
     1801 
     1802 
     1803                    p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     1804                  ENDIF 
     1805                  ELSE 
     1806                     jj = mjs_crs(2) 
     1807 
     1808                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
     1809                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
     1810                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
     1811                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  & 
     1812                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  & 
     1813                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
     1814                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
     1815                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
     1816                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
     1817 
     1818                     p_e3_max_crs(ii,2,jk) = ze3crs 
     1819 
     1820                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
     1821                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
     1822                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
     1823                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  & 
     1824                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  & 
     1825                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
     1826                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
     1827                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
     1828                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
     1829 
     1830                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     1831                  ENDIF 
     1832 
     1833                  DO jj = njstr, njend, nn_facty 
     1834                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     1835                     ij   = ( jj - njstr ) * rfacty_r + 3 
     1836                     ijje = mje_crs(ij) 
     1837                     ijie = mie_crs(ii) 
     1838                     !   
     1839                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
     1840                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
     1841                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
     1842                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  & 
     1843                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  & 
     1844                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
     1845                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
     1846                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
     1847                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
     1848 
     1849                     p_e3_max_crs(ii,ij,jk) = ze3crs 
     1850                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
     1851                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
     1852                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
     1853                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  & 
     1854                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  & 
     1855                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
     1856                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
     1857                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
     1858                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
     1859 
     1860                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1861 
     1862                  ENDDO 
     1863               ENDDO 
     1864            ENDDO 
     1865 
     1866         CASE ('U') 
     1867 
     1868         DO jk = 1 , jpk 
     1869               DO ji = nistr, niend, nn_factx 
     1870                 ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     1871                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
     1872 
     1873                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1874 
     1875                    jj = mje_crs(2) 
     1876 
     1877 
     1878                    ze3crs = p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) 
     1879 
     1880                    p_e3_max_crs(ii,2,jk) = ze3crs 
     1881 
     1882                    ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
     1883 
     1884 
     1885                     p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     1886                     ENDIF 
     1887                  ELSE 
     1888                     jj = mjs_crs(2) 
     1889 
     1890                     ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
     1891                                   p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
     1892                                   p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
     1893 
     1894                     p_e3_max_crs(ii,2,jk) = ze3crs 
     1895 
     1896                     ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
     1897                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
     1898                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
     1899 
     1900                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     1901                  ENDIF 
     1902                  DO jj = njstr, njend, nn_facty 
     1903                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     1904                     ij   = ( jj - njstr ) * rfacty_r + 3 
     1905                     ijje = mje_crs(ij) 
     1906                     ijie = mie_crs(ii) 
     1907                     !   
     1908                     ze3crs = MAX( p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
     1909                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
     1910                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
     1911 
     1912                     p_e3_max_crs(ii,ij,jk) = ze3crs 
     1913 
     1914                     ze3crs =  p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
     1915                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
     1916                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
     1917 
     1918                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1919 
     1920                  ENDDO 
     1921               ENDDO 
     1922            ENDDO 
     1923 
     1924         CASE ('V') 
     1925         DO jk = 1 , jpk 
     1926               DO ji = nistr, niend, nn_factx 
     1927 
     1928                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     1929                  IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
     1930 
     1931                     IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1932 
     1933                    jj = mje_crs(2) 
     1934 
     1935 
     1936                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
     1937                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
     1938                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)) 
     1939 
     1940                    p_e3_max_crs(ii,2,jk) = ze3crs 
     1941 
     1942                    ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
     1943                        &     p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
     1944                        &     p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) 
     1945 
     1946 
     1947                     p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     1948                     ENDIF 
     1949                  ELSE 
     1950                     jj = mjs_crs(2) 
     1951 
     1952                     ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
     1953                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
     1954                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
     1955 
     1956                     p_e3_max_crs(ii,2,jk) = ze3crs 
     1957 
     1958                     ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
     1959                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
     1960                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
     1961 
     1962                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     1963                  ENDIF 
     1964 
     1965                  DO jj = njstr, njend, nn_facty 
     1966                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     1967                     ij   = ( jj - njstr ) * rfacty_r + 3 
     1968                     ijje = mje_crs(ij) 
     1969                     ijie = mie_crs(ii) 
     1970                     !   
     1971                     ze3crs = MAX( p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
     1972                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
     1973                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
     1974 
     1975                     p_e3_max_crs(ii,ij,jk) = ze3crs 
     1976 
     1977                     ze3crs =  p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
     1978                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
     1979                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
     1980 
     1981                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1982 
     1983                  ENDDO 
     1984               ENDDO 
     1985            ENDDO 
     1986         CASE ('W') 
     1987 
     1988            DO jk = 2 , jpk 
     1989               DO ji = nistr, niend, nn_factx 
     1990               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     1991               IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
     1992 
     1993                 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1994 
     1995                    jj = mje_crs(2) 
     1996 
     1997 
     1998                    ze3crs = MAX(  p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
     1999                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
     2000                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)) 
     2001 
     2002                     p_e3_max_crs(ii,2,jk) = ze3crs 
     2003 
     2004                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  & 
     2005                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  & 
     2006                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) 
     2007 
     2008 
     2009                       p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     2010                  ENDIF 
     2011               ELSE 
     2012                  jj = mjs_crs(2) 
     2013 
     2014                  ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
     2015                     &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
     2016                     &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  & 
     2017                     &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  & 
     2018                     &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  & 
     2019                     &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  & 
     2020                     &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  & 
     2021                     &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  & 
     2022                     &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 
     2023 
     2024                  p_e3_max_crs(ii,2,jk) = ze3crs 
     2025                  ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  & 
     2026                     &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  & 
     2027                     &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  & 
     2028                     &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  & 
     2029                     &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  & 
     2030                     &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  & 
     2031                     &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  & 
     2032                     &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  & 
     2033                     &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 
     2034 
     2035                  p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     2036               ENDIF 
     2037 
     2038 
     2039                  DO jj = njstr, njend, nn_facty 
     2040                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     2041                     ij   = ( jj - njstr ) * rfacty_r + 3 
     2042                     ijje = mje_crs(ij) 
     2043                     ijie = mie_crs(ii) 
     2044                     !   
     2045                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
     2046                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
     2047                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  & 
     2048                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  & 
     2049                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  & 
     2050                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  & 
     2051                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  & 
     2052                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  & 
     2053                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 
     2054 
     2055                     p_e3_max_crs(ii,ij,jk) = ze3crs 
     2056 
     2057                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  & 
     2058                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  & 
     2059                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  & 
     2060                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  & 
     2061                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  & 
     2062                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  & 
     2063                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  & 
     2064                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  & 
     2065                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 
     2066 
     2067                       p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     2068 
     2069                  ENDDO 
     2070               ENDDO 
     2071            ENDDO 
     2072            DO ji = nistr, niend, nn_factx 
     2073               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     2074               IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN     !!cc bande du sud style ORCA2 
     2075 
     2076                 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     2077 
     2078                    jj = mje_crs(2) 
     2079 
     2080                    ze3crs = MAX(  p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
     2081                        &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
     2082                        &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)) 
     2083 
     2084                    p_e3_max_crs(ii,2,1) = ze3crs 
     2085 
     2086                    ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  & 
     2087                        &      p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  & 
     2088                        &      p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) 
     2089 
     2090                    p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1) 
     2091                  ENDIF 
     2092               ELSE 
     2093                  jj = mjs_crs(2) 
     2094 
     2095                  ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
     2096                     &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
     2097                     &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  & 
     2098                     &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  & 
     2099                     &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  & 
     2100                     &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  & 
     2101                     &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  & 
     2102                     &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  & 
     2103                     &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) ) 
     2104 
     2105                  p_e3_max_crs(ii,2,1) = ze3crs 
     2106                  ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  & 
     2107                        &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  & 
     2108                        &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  & 
     2109                        &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  & 
     2110                        &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  & 
     2111                        &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  & 
     2112                        &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  & 
     2113                        &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  & 
     2114                        &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 
     2115 
     2116                   p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1) 
     2117 
     2118               ENDIF 
     2119               DO jj = njstr, njend, nn_facty 
     2120                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     2121                  ij   = ( jj - njstr ) * rfacty_r + 3 
     2122                  ijje = mje_crs(ij) 
     2123                  ijie = mie_crs(ii) 
     2124                  !   
     2125                  ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
     2126                     &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
     2127                     &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  & 
     2128                     &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  & 
     2129                     &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  & 
     2130                     &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  & 
     2131                     &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  & 
     2132                     &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  & 
     2133                     &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) ) 
     2134 
     2135                  p_e3_max_crs(ii,ij,1) = ze3crs 
     2136 
     2137                   ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  & 
     2138                        &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  & 
     2139                        &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  & 
     2140                        &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  & 
     2141                        &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  & 
     2142                        &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  & 
     2143                        &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  & 
     2144                        &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  & 
     2145                        &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 
     2146 
     2147                       p_e3_crs(ii,ij,1) = ze3crs / p_sfc_crs(ii,ij,1) 
     2148 
     2149               ENDDO 
     2150            ENDDO 
     2151        !               
    17242152       END SELECT 
    17252153 
    1726        DO jk = 1, jpk 
    1727           zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk)  
    1728        ENDDO 
    1729  
    1730        IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    1731           IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    1732              je_2 = mje_crs(2) 
    1733              DO jk = 1 , jpk 
    1734                 DO ji = nistr, niend, nn_factx 
    1735                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1736                    ze3crs =   zsurf(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)   & 
    1737                         &   + zsurf(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)   & 
    1738                         &   + zsurf(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  
    1739  
    1740                    p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
    1741                    ! 
    1742                    ze3crs = MAX( p_e3(ji  ,je_2,jk) * zmask(ji  ,je_2,jk),  & 
    1743                       &          p_e3(ji+1,je_2,jk) * zmask(ji+1,je_2,jk),  & 
    1744                       &          p_e3(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  ) 
    1745                    ! 
    1746                    p_e3_max_crs(ii,2,jk) = ze3crs 
    1747                 ENDDO 
    1748              ENDDO 
    1749           ENDIF 
    1750        ELSE 
    1751           je_2 = mjs_crs(2) 
    1752           DO jk = 1 , jpk 
    1753              DO ji = nistr, niend, nn_factx 
    1754                 ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1755                 ze3crs =  zsurf(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)   & 
    1756                    &    + zsurf(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)   & 
    1757                    &    + zsurf(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)   & 
    1758                    &    + zsurf(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)   & 
    1759                    &    + zsurf(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)   & 
    1760                    &    + zsurf(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)   & 
    1761                    &    + zsurf(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)   & 
    1762                    &    + zsurf(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)   & 
    1763                    &    + zsurf(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) 
    1764  
    1765                 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
    1766                 ! 
    1767                 ze3crs = MAX( p_e3(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk),  & 
    1768                    &          p_e3(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk),  & 
    1769                    &          p_e3(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk),  & 
    1770                    &          p_e3(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk),  & 
    1771                    &          p_e3(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk),  & 
    1772                    &          p_e3(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk),  & 
    1773                    &          p_e3(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk),  & 
    1774                    &          p_e3(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk),  & 
    1775                    &          p_e3(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) ) 
    1776                 
    1777                 p_e3_max_crs(ii,2,jk) = ze3crs 
    1778                 ENDDO 
    1779              ENDDO 
    1780           ENDIF 
    1781           DO jk = 1 , jpk 
    1782              DO jj = njstr, njend, nn_facty 
    1783                 DO ji = nistr, niend, nn_factx 
    1784                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2           
    1785                    ij   = ( jj - njstr ) * rfacty_r + 3 
    1786                    ze3crs =   zsurf(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)   & 
    1787                    &        + zsurf(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)   & 
    1788                    &        + zsurf(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)   & 
    1789                    &        + zsurf(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)   & 
    1790                    &        + zsurf(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)   & 
    1791                    &        + zsurf(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)   & 
    1792                    &        + zsurf(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)   & 
    1793                    &        + zsurf(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)   & 
    1794                    &        + zsurf(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) 
    1795  
    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 
    1802                 ! 
    1803                 ze3crs = MAX( p_e3(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk),  & 
    1804                    &          p_e3(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk),  & 
    1805                    &          p_e3(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk),  & 
    1806                    &          p_e3(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk),  & 
    1807                    &          p_e3(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk),  & 
    1808                    &          p_e3(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk),  & 
    1809                    &          p_e3(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk),  & 
    1810                    &          p_e3(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk),  & 
    1811                    &          p_e3(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) ) 
    1812                 
    1813                 p_e3_max_crs(ii,ij,jk) = ze3crs 
    1814              ENDDO 
    1815           ENDDO 
    1816        ENDDO 
    1817                    
    1818        CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )   
    1819        CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )   
     2154         CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 
     2155         CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 ) 
    18202156       !               
    1821        CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask ) 
     2157       !CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask ) 
    18222158       ! 
    18232159   END SUBROUTINE crs_dom_e3 
     
    18362172      INTEGER  :: ji, jj, jk                   ! dummy loop indices 
    18372173      INTEGER  :: ii, ij, je_2 
     2174      INTEGER  :: iji,ijj 
    18382175      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk    
    18392176      !!----------------------------------------------------------------   
    18402177      ! Initialize 
    1841  
     2178      p_surf_crs(:,:,:)=0._wp 
     2179      p_surf_crs_msk(:,:,:)=0._wp 
    18422180 
    18432181      CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     
    18492187               zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:)  
    18502188            ENDDO 
    1851             zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1)  
    1852             DO jk = 2, jpk 
    1853                zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1)  
     2189            !zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1)  
     2190            !cbr DO jk = 2, jpk 
     2191            DO jk = 1, jpk 
     2192               !cbr zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1)  
     2193               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
    18542194            ENDDO 
    18552195 
     
    18782218            ENDDO 
    18792219      END SELECT 
     2220 
     2221      WRITE(narea+200,*)"TOTO",nldj_crs,mjs_crs(1), mje_crs(1),mjs_crs(2), mje_crs(2),mjs_crs(3), mje_crs(3),mjs_crs(4), mje_crs(4) ; CALL FLUSH(narea+200) 
     2222 
     2223      SELECT CASE ( cd_type ) 
     2224 
     2225      CASE ('W') 
    18802226 
    18812227      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     
    19162262               ii = ( ji - mis_crs(2) ) * rfactx_r + 2   
    19172263               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 
    19242264               ! 
    19252265               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk)  & 
    19262266                    &                    + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk)  & 
    19272267                    &                    + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)   
    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) 
    19292268               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj  ,jk) + zsurfmsk(ji+1,jj  ,jk) + zsurfmsk(ji+2,jj  ,jk)  & 
    19302269                    &                    + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk)  & 
    19312270                    &                    + zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk)   
     2271 
     2272               !cbr 
     2273               iji=117 ; ijj=211 
     2274               iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     2275               IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
     2276               WRITE(narea+5000,*)"SFC W =======> " 
     2277               WRITE(narea+5000,*)ii,ij,jk 
     2278               WRITE(narea+5000,*)ji,jj 
     2279               WRITE(narea+5000,*)zsurfmsk(ji,jj  ,jk) , zsurfmsk(ji+1,jj  ,jk) , zsurfmsk(ji+2,jj  ,jk) 
     2280               WRITE(narea+5000,*)zsurfmsk(ji,jj+1,jk) , zsurfmsk(ji+1,jj+1,jk) , zsurfmsk(ji+2,jj+1,jk) 
     2281               WRITE(narea+5000,*)zsurfmsk(ji,jj+2,jk) , zsurfmsk(ji+1,jj+2,jk) , zsurfmsk(ji+2,jj+2,jk) 
     2282               WRITE(narea+5000,*) p_surf_crs    (ii,ij,jk), p_surf_crs_msk(ii,ij,jk)  
     2283               ENDIF 
     2284 
     2285 
    19322286            ENDDO       
    19332287         ENDDO 
    19342288      ENDDO    
    1935       WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs    (2,18,1) 
     2289 
     2290      CASE ('U') 
     2291 
     2292     IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     2293         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     2294            je_2 = mje_crs(2) 
     2295            DO jk = 1, jpk 
     2296               DO ji = nistr, niend, nn_factx 
     2297                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     2298                  !     
     2299                  p_surf_crs    (ii,2,jk) =  zsurf(ji+2,je_2  ,jk) 
     2300                  ! 
     2301                  p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji+2,je_2,jk) 
     2302                  ! 
     2303               ENDDO 
     2304            ENDDO 
     2305         ENDIF 
     2306      ELSE 
     2307         je_2 = mjs_crs(2) 
     2308         DO jk = 1, jpk 
     2309            DO ji = nistr, niend, nn_factx 
     2310               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     2311               !   
     2312               p_surf_crs    (ii,2,jk) =  zsurf(ji+2,je_2  ,jk)  & 
     2313                    &                   + zsurf(ji+2,je_2+1,jk)  & 
     2314                    &                   + zsurf(ji+2,je_2+2,jk) 
     2315 
     2316               p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji+2,je_2  ,jk)  & 
     2317                    &                   + zsurfmsk(ji+2,je_2+1,jk)  & 
     2318                    &                   + zsurfmsk(ji+2,je_2+2,jk) 
     2319                ENDDO 
     2320            ENDDO 
     2321      ENDIF 
     2322 
     2323      DO jk = 1, jpk 
     2324         DO jj = njstr, njend, nn_facty 
     2325            DO ji = nistr, niend, nn_factx 
     2326               ii = ( ji - mis_crs(2) ) * rfactx_r + 2 
     2327               ij = ( jj - njstr ) * rfacty_r + 3 
     2328               ! 
     2329               p_surf_crs    (ii,ij,jk) =  zsurf(ji+2,jj  ,jk)  & 
     2330                    &                    + zsurf(ji+2,jj+1,jk)  & 
     2331                    &                    + zsurf(ji+2,jj+2,jk) 
     2332               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji+2,jj  ,jk)  & 
     2333                    &                    + zsurfmsk(ji+2,jj+1,jk)  & 
     2334                    &                    + zsurfmsk(ji+2,jj+2,jk) 
     2335               !cbr 
     2336               !iji=117 ; ijj=211 
     2337               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     2338               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
     2339               !WRITE(narea+5000,*)"SFC U =======> " 
     2340               !WRITE(narea+5000,*)ii,ij,jk 
     2341               !WRITE(narea+5000,*)ji,jj 
     2342               !WRITE(narea+5000,*)mis_crs(2),rfactx_r , ( ji - 1 - mis_crs(2) ) * rfactx_r  
     2343               !WRITE(narea+5000,*)zsurf(ji+2,jj  ,jk),zsurf(ji+2,jj+1,jk),zsurf(ji+2,jj+2,jk) 
     2344               !WRITE(narea+5000,*)zsurfmsk(ji+2,jj  ,jk),zsurfmsk(ji+2,jj+1,jk),zsurfmsk(ji+2,jj+2,jk) 
     2345               !WRITE(narea+5000,*)p_surf_crs    (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 
     2346               !ENDIF 
     2347               !iji=116 ; ijj=211 
     2348               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     2349               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
     2350               !WRITE(narea+5000,*)"SFC U =======> " 
     2351               !WRITE(narea+5000,*)ii,ij,jk 
     2352               !WRITE(narea+5000,*)ji,jj 
     2353               !WRITE(narea+5000,*)zsurf(ji+2,jj  ,jk),zsurf(ji+2,jj+1,jk),zsurf(ji+2,jj+2,jk) 
     2354               !WRITE(narea+5000,*)zsurfmsk(ji+2,jj  ,jk),zsurfmsk(ji+2,jj+1,jk),zsurfmsk(ji+2,jj+2,jk) 
     2355               !WRITE(narea+5000,*)p_surf_crs    (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 
     2356               !ENDIF 
     2357            ENDDO 
     2358         ENDDO 
     2359      ENDDO 
     2360 
     2361      CASE ('V') 
     2362 
     2363      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     2364         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     2365            je_2 = mje_crs(2) 
     2366            DO jk = 1, jpk 
     2367               DO ji = nistr, niend, nn_factx 
     2368                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     2369                  !     
     2370                  p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) 
     2371                  ! 
     2372                  p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk) 
     2373                  ! 
     2374               ENDDO 
     2375            ENDDO 
     2376         ENDIF 
     2377      ELSE 
     2378         je_2 = mjs_crs(2) 
     2379         DO jk = 1, jpk 
     2380            DO ji = nistr, niend, nn_factx 
     2381               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     2382               !   
     2383               p_surf_crs    (ii,2,jk) = zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk) 
     2384               p_surf_crs_msk(ii,2,jk) = zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk) 
     2385            ENDDO 
     2386         ENDDO 
     2387      ENDIF 
     2388 
     2389      DO jk = 1, jpk 
     2390         DO jj = njstr, njend, nn_facty 
     2391            DO ji = nistr, niend, nn_factx 
     2392               ii = ( ji - mis_crs(2) ) * rfactx_r + 2 
     2393               ij = ( jj - njstr ) * rfacty_r + 3 
     2394               ! 
     2395               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 
     2396               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk) 
     2397               iji=117 ; ijj=210 
     2398               iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     2399               IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
     2400               WRITE(narea+5000,*)"SFC V =======> " 
     2401               WRITE(narea+5000,*)ii,ij,jk 
     2402               WRITE(narea+5000,*)ji,jj 
     2403               WRITE(narea+5000,*)zsurfmsk(ji,jj+2,jk),zsurfmsk(ji+1,jj+2,jk),zsurfmsk(ji+2,jj+2,jk) 
     2404               WRITE(narea+5000,*)p_surf_crs    (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 
     2405               ENDIF 
     2406            ENDDO 
     2407         ENDDO 
     2408      ENDDO 
     2409 
     2410     END SELECT 
     2411      DO jk=1,jpk 
     2412      DO ji=1,jpi_crs 
     2413      DO jj=1,jpj_crs 
     2414         IF( p_surf_crs_msk(ji,jj,jk) .NE. p_surf_crs_msk(ji,jj,jk) )WRITE(narea+200,*)"SFC 4 ",ji,jj,jk,p_surf_crs_msk(ji,jj,jk)  ; call flush(narea+200) 
     2415      ENDDO 
     2416      ENDDO 
     2417      ENDDO 
    19362418      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 ) 
    19372419      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) 
    19392420 
    19402421      CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r5010 r5105  
    6666      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 
    6767      REAL(wp)       :: z2dcrsu, z2dcrsv 
     68      REAL(wp)       :: zmin,zmax 
     69      INTEGER :: i,j,ijis,ijie,ijjs,ijje 
     70      REAL(wp)       :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z 
     71      INTEGER ::  iji,ijj 
    6872      !! 
    6973       !!---------------------------------------------------------------------- 
    7074      !  
     75      !IF(narea==267)WRITE(narea+5000,*)"========================================> crsfldt ",kt 
    7176 
    7277      IF( nn_timing == 1 )   CALL timing_start('crs_fld') 
     
    9196         wn_crs   (:,:,:  ) = 0._wp    ! w 
    9297         avt_crs  (:,:,:  ) = 0._wp    ! avt 
     98         hdivb_crs(:,:,:  ) = 0._wp    ! hdiv 
    9399         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv 
    94100         rke_crs  (:,:,:  ) = 0._wp    ! rke 
     
    110116 
    111117      !  Temperature 
     118      zt(:,:,:) = tsb(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp 
     119      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     120      tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    112121      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp 
    113122      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     
    119128       
    120129      !  Salinity 
     130      zs(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
     131      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     132      tsb_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    121133      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
    122134      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     
    127139 
    128140      !  U-velocity 
     141      CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    129142      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     143      !cbr 
     144      ub_crs(:,:,:) = ub_crs(:,:,:)*umask_crs(:,:,:) 
     145      un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:) 
    130146      ! 
    131147      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
     
    146162 
    147163      !  V-velocity 
     164      !IF(narea==267)WRITE(narea+5000,*)"deg vb_crs" 
     165      CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     166      !IF(narea==267)WRITE(narea+5000,*)"deg vn_crs" 
    148167      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     168      !IF(narea==267)WRITE(narea+5000,*)"1 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74) 
     169      vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:) 
     170      vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) 
     171      !IF(narea==267)WRITE(narea+5000,*)"2 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74) 
    149172      !                                                                                  
    150173      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
     
    174197            DO jj = 2, jpj_crsm1 
    175198               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN 
     199                  !z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) & 
     200                  !   &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) ) 
     201                  !z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) & 
     202                  !   &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) ) 
     203                  ! 
     204                  !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
    176205                  z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) & 
    177206                     &     - ( un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) ) 
     
    179208                     &     - ( vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) ) 
    180209                  ! 
    181                   IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / ocean_volume_crs_t(ji,jj,jk) 
     210                  !cbr 
     211                  ! 
     212                  !bug1: il manquait le facvol_t(ji,jj,jk) ds la division ; ca creait des grosses erreurs de Wcrs ( vu en recalculant la divergence 3D ) 
     213                  !bug2: mm test que bug1: on n'obtient tjs pas zero 
     214                  !on a la div calculée via ocean_volume_crs_t puis w via  e3t_crs ; or ,e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) NE ocean_volume_crs_t*crs_volt_wgt(ji,jj,jk) 
     215                  !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810 
     216                  !                   e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6)   
     217                  !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk)) 
     218                  !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk)) 
     219                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) 
     220 
     221               !iji=117 ; ijj=211 
     222               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     223               !IF( ji==iji .AND. jj==ijj )THEN 
     224               !WRITE(narea+5000,*)"hdivn_crs =======> " 
     225               !WRITE(narea+5000,*) "u"  ,jk,un_crs(ji  ,jj  ,jk) ,e2e3u_msk(ji  ,jj  ,jk),un_crs(ji  ,jj  ,jk)*e2e3u_msk(ji  ,jj  ,jk) 
     226               !WRITE(narea+5000,*) "um1",jk,un_crs(ji-1,jj  ,jk) , e2e3u_msk(ji-1,jj  ,jk),un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) 
     227               !WRITE(narea+5000,*) "v",jk,vn_crs(ji  ,jj  ,jk) , e1e3v_msk(ji  ,jj  ,jk),vn_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) 
     228               !WRITE(narea+5000,*) "vm1",jk,vn_crs(ji  ,jj-1,jk) , e1e3v_msk(ji  ,jj-1,jk),vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) 
     229               !WRITE(narea+5000,*) "t1 ",jk,z2dcrsu,z2dcrsv, z2dcrsu + z2dcrsv,hdivn_crs(ji,jj,jk) 
     230               !WRITE(narea+5000,*) "t2 ",jk,e1t_crs(ji,jj),e2t_crs(ji,jj),e3t_crs(ji,jj,jk),e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) 
     231               !WRITE(narea+5000,*) "t3 ",jk,ocean_volume_crs_t(ji,jj,jk),facvol_t(ji,jj,jk),facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) 
     232               !WRITE(narea+5000,*) "t4 ",jk, ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk)) 
     233               !WRITE(narea+5000,*) "t5 ",jk, ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk)) 
     234               !ENDIF 
     235 
     236 
     237                  !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
     238                  z2dcrsu =  ( ub_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) & 
     239                     &     - ( ub_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) ) 
     240                  z2dcrsv =  ( vb_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) & 
     241                     &     - ( vb_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) ) 
     242                  ! 
     243                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivb_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) ) 
    182244               ENDIF 
    183245            ENDDO 
     
    189251 
    190252 
     253      ! DO jk = 1, jpkm1          ! Interior value 
     254      !      DO jj = 1, jpj_crs 
     255      !         DO ji = 1, jpi_crs 
     256      !            IF( e3t_crs(ji,jj,jk) .NE. e3t_crs(ji,jj,jk) )WRITE(narea+200,*)"e3t_crs",e3t_crs(ji,jj,jk) ; call flush(narea+200) 
     257      !            IF( hdivn_crs(ji,jj,jk) .NE. hdivn_crs(ji,jj,jk) )WRITE(narea+200,*)"hdivn_crs",hdivn_crs(ji,jj,jk) ; call flush(narea+200) 
     258      !         END DO 
     259      !      END DO 
     260      !   END DO 
     261 
    191262      !  W-velocity 
    192263      IF( ln_crs_wn ) THEN 
    193264         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 
    194        !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w ) 
    195265      ELSE 
    196266        wn_crs(:,:,jpk) = 0._wp 
    197267        DO jk = jpkm1, 1, -1 
    198            wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk) 
     268           !cbr wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk) 
     269           wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk) 
     270           WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)  
    199271        ENDDO 
    200272      ENDIF 
     273 
    201274      CALL iom_put( "woce", wn_crs  )   ! vertical velocity 
    202275      !  free memory 
     
    216289      !  sbc fields   
    217290 
     291      CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )   
    218292      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )   
     293      CALL crs_dom_ope( ssha , 'VOL', 'T', tmask, ssha_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )   
    219294      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 ) 
    220295      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 ) 
     
    224299      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    225300      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     301      CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    226302      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    227303      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     
    237313      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output  
    238314 
     315      !cbr 
     316      !IF(narea==267)WRITE(narea+5000,*)"vn_crs(17,5,74) = ",vn_crs(17,5,74) 
     317      !ji=117 ; jj=211 ; jk=74 
     318      !ji=ji-nimpp_crs+1 ; jj=jj-njmpp_crs+1 
     319      !IF( ji .GE. 2 .AND. ji .LE. jpi_crs-1 .AND. jj .GE. 2 .AND. jj .LE. jpj_crs-1 )THEN 
     320      !WRITE(narea+5000,*)"=======> kt ",kt 
     321      !WRITE(narea+5000,*)ji,jj,glamt(ji,jj),gphit(ji,jj) 
     322      !WRITE(narea+5000,*)"um1  crs ",umask_crs(ji-1,jj,jk),e2e3u_msk(ji-1,jj,jk),un_crs(ji-1,jj,jk),umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk) 
     323      !WRITE(narea+5000,*)"u    crs ",umask_crs(ji,jj,jk),e2e3u_msk(ji,jj,jk),un_crs(ji,jj,jk),umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk) 
     324      !WRITE(narea+5000,*)"vm1  crs ",vmask_crs(ji,jj-1,jk),e1e3v_msk(ji,jj-1,jk),vn_crs(ji,jj-1,jk),vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk) 
     325      !WRITE(narea+5000,*)"v    crs ",vmask_crs(ji,jj,jk),e1e3v_msk(ji,jj,jk),vn_crs(ji,jj,jk),vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk) 
     326      !WRITE(narea+5000,*)"wp1  crs ",tmask_crs(ji,jj,jk+1),e1e2w_msk(ji,jj,jk+1),wn_crs(ji,jj,jk+1),tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1) 
     327      !WRITE(narea+5000,*)"w    crs ",tmask_crs(ji,jj,jk),e1e2w_msk(ji,jj,jk),wn_crs(ji,jj,jk),tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk) 
     328      !z = umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk) - umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk) + & 
     329      !    vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk) - vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk) + & 
     330      !    tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk) - tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1) 
     331      !WRITE(narea+5000,*)"sum ",z 
     332      !ijie = mie_crs(ji) 
     333      !ijis = mis_crs(ji) 
     334      !ijje = mje_crs(jj) 
     335      !ijjs = mjs_crs(jj) 
     336      !DO i=ijis,ijie 
     337      !   DO j=ijjs,ijje 
     338      !       WRITE(narea+5000,*)"tmask",i,j,tmask(i,j,jk) 
     339      !   ENDDO            
     340      !ENDDO            
     341 
     342      !z=0._wp 
     343      !zsm=0._wp 
     344      !DO i=ijis,ijie 
     345      !   DO j=ijjs,ijje 
     346      !       WRITE(narea+5000,*)"w",i,j,tmask(i,j,jk),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk) 
     347      !       z=z+tmask(i,j,jk)*e1t(i,j)*e2t(i,j)*wn(i,j,jk) 
     348      !       zsm=zsm+tmask(i,j,jk)*e1t(i,j)*e2t(i,j) 
     349      !   ENDDO            
     350      !ENDDO    
     351         
     352      !zw=z 
     353      !WRITE(narea+5000,*)"w sum ",zsm,zw            
     354      !z=0._wp 
     355      !zsm=0._wp 
     356      !DO i=ijis,ijie 
     357      !   DO j=ijjs,ijje 
     358      !       WRITE(narea+5000,*)"wp1 ",i,j,tmask(i,j,jk+1),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk+1) 
     359      !       z=z+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j)*wn(i,j,jk+1) 
     360      !       zsm=zsm+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j) 
     361      !   ENDDO 
     362      !ENDDO 
     363      !zwp1=z 
     364      !WRITE(narea+5000,*)"wp1 sum ",zsm,zwp1   
     365      !z=0._wp 
     366      !zsm=0._wp 
     367      !i=ijis-1 
     368      !DO j=ijjs,ijje 
     369      !    WRITE(narea+5000,*)"um1",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk) 
     370      !    z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk) 
     371      !    zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) 
     372      !ENDDO 
     373      !zum1=z 
     374      !WRITE(narea+5000,*)"um1 sum ",zsm,zum1           
     375      !z=0._wp 
     376      !zsm=0._wp 
     377      !i=ijie 
     378      !DO j=ijjs,ijje 
     379      !    WRITE(narea+5000,*)"u",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk) 
     380      !    z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk) 
     381      !    zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) 
     382      !ENDDO            
     383      !zu=z 
     384      !WRITE(narea+5000,*)"u   sum ",zsm,zu           
     385      !z=0._wp 
     386      !zsm=0._wp 
     387      !j=ijjs-1 
     388      !DO i=ijis,ijie 
     389      !    WRITE(narea+5000,*)"vm1",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk) 
     390      !    z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk) 
     391      !    zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) 
     392      !ENDDO            
     393      !zvm1=z 
     394      !WRITE(narea+5000,*)"vm1 sum ",zsm,zvm1            
     395      !z=0._wp 
     396      !zsm=0._wp 
     397      !j=ijje 
     398      !DO i=ijis,ijie 
     399      !    WRITE(narea+5000,*)"v",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk) 
     400      !    z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk) 
     401      !    zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) 
     402      !ENDDO            
     403      !zv=z 
     404      !WRITE(narea+5000,*)"v   sum ",zv            
     405      !WRITE(narea+5000,*)"sum ",zw+zwp1+zum1+zu+zvm1+zv 
     406      !DO i=ijis,ijie 
     407      !   DO j=ijjs,ijje 
     408      !       WRITE(narea+5000,*)"msk",i,j,tmask(i,j,jk),umask(i,j,jk),vmask(i,j,jk) 
     409      !       WRITE(narea+5000,*)"vel",i,j,un(i,j,jk),vn(i,j,jk),wn(i,j,jk) 
     410      !   ENDDO 
     411      !ENDDO 
     412 
     413      !DO i=ijis,ijie 
     414      !   DO j=ijjs,ijje 
     415      !      z = un(i,j,jk)*e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) - un(i-1,j,jk)*e2u(i-1,j)*e3u_0(i-1,j,jk)*umask(i-1,j,jk) + & 
     416      !          vn(i,j,jk)*e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) - vn(i,j-1,jk)*e1v(i,j-1)*e3v_0(i,j-1,jk)*vmask(i,j-1,jk) + & 
     417      !          wn(i,j,jk)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk)     - wn(i,j,jk+1)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk+1) 
     418      !       WRITE(narea+5000,*)"div ",i,j,jk,z 
     419      !   ENDDO 
     420      !ENDDO 
     421 
     422      !ENDIF 
     423       
     424   
     425 
    239426      !  free memory 
    240427      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5007 r5105  
    6868      INTEGER  :: ierr                                ! allocation error status 
    6969      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     70      REAL(wp) :: zmin,zmax 
    7071      REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w 
    7172 
    72       NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn 
     73      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn, ln_crs_top 
    7374      !!---------------------------------------------------------------------- 
    7475      ! 
     
    160161     CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs ) 
    161162 
     163     WHERE(e1t_crs == 0._wp) e1t_crs=r_inf 
     164     WHERE(e1u_crs == 0._wp) e1u_crs=r_inf 
     165     WHERE(e1v_crs == 0._wp) e1v_crs=r_inf 
     166     WHERE(e1f_crs == 0._wp) e1f_crs=r_inf 
     167     WHERE(e2t_crs == 0._wp) e2t_crs=r_inf 
     168     WHERE(e2u_crs == 0._wp) e2u_crs=r_inf 
     169     WHERE(e2v_crs == 0._wp) e2v_crs=r_inf 
     170     WHERE(e2f_crs == 0._wp) e2f_crs=r_inf 
     171 
    162172     e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:) 
    163173      
     
    169179      CASE ( 0, 1, 4 )           ! mesh on the sphere 
    170180 
     181         zmin=MINVAL(ABS(gphif_crs(:,:)));zmax=MAXVAL(ABS(gphif_crs(:,:)));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"gphif_crs",zmin,zmax 
    171182         ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) ) 
    172183 
     
    190201 
    191202     !    3.d.2   Surfaces  
     203     e2e3u_crs(:,:,:)=0._wp 
     204     e2e3u_msk(:,:,:)=0._wp 
     205     e1e3v_crs(:,:,:)=0._wp 
     206     e1e3v_msk(:,:,:)=0._wp 
    192207     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    ) 
    193208     WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1) 
     
    207222 
    208223              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) 
     224 
     225              IF( facsurfu(ji,jj,jk) .NE. facsurfu(ji,jj,jk) )WRITE(narea+200,*)'BUG1',facsurfu(ji,jj,jk);call flush(narea+200) 
     226              IF( e2e3u_crs(ji,jj,jk) .NE. e2e3u_crs(ji,jj,jk) ) WRITE(narea+200,*)'BUG2',e2e3u_crs(ji,jj,jk);call flush(narea+200) 
     227              IF( e2e3u_msk(ji,jj,jk) .NE. e2e3u_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG3',e2e3u_msk(ji,jj,jk) ;call flush(narea+200) 
     228              IF( e1e2w_msk(ji,jj,jk) .NE. e1e2w_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',ji,jj,jk,e1e2w_msk(ji,jj,jk) ;call flush(narea+200) 
     229              IF( tmask(ji,jj,jk) .NE. tmask(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',tmask(ji,jj,jk) ;call flush(narea+200) 
     230              IF( e1t(ji,jj) .NE. e1t(ji,jj) ) WRITE(narea+200,*)'BUG5',e1t(ji,jj) ;call flush(narea+200) 
     231              IF( e1t(ji,jj) .NE. e2t(ji,jj) ) WRITE(narea+200,*)'BUG6',e2t(ji,jj) ;call flush(narea+200) 
    210232 
    211233              facsurfv(ji,jj,jk) = vmask_crs(ji,jj,jk) * e1e3v_msk(ji,jj,jk)   
     
    224246     CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 
    225247     CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
     248     WHERE(e3t_max_crs == 0._wp) e3t_max_crs=r_inf 
     249     WHERE(e3u_max_crs == 0._wp) e3u_max_crs=r_inf 
     250     WHERE(e3v_max_crs == 0._wp) e3v_max_crs=r_inf 
     251     WHERE(e3w_max_crs == 0._wp) e3w_max_crs=r_inf 
    226252 
    227253     ! Reset 0 to e3t_0 or e3w_0 
     
    264290        CALL dom_grid_glo   ! Return to parent grid domain 
    265291     ENDIF 
    266       
     292     
     293 
     294      rhop_crs(:,:,:)=0._wp ; rhd_crs(:,:,:)=0._wp ; rb2_crs(:,:,:)=0._wp 
     295 
     296  
    267297     !--------------------------------------------------------- 
    268298     ! 7. Finish and clean-up 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r4990 r5105  
    149149   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain) 
    150150   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor 
     151   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimpptea, njmpptno !: i-, j-indexes for each processor's northern and eastern neighbour 
    151152   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
    152153   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain 
     154   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcitea          !: dimensions of every subdomain eastern neighbour 
    153155   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
    154156   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
     
    337339      ! 
    338340      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  & 
    339          &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 
     341         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), & 
     342         &      njmpptno(jpnij), nimpptea(jpnij), nlcitea(jpnij), STAT=ierr(1) ) 
    340343         ! 
    341344      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5003 r5105  
    1818   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    1919   !!-------------------------------------------------------------------- 
    20    USE dom_oce         ! ocean space and time domain 
     20   USE dom_oce, ONLY : nimpp, njmpp, nlci, nlcj, nldi, nldj, nlei, nlej, &  
     21                       mig, mjg, narea, & 
     22                       gphiv, gphif, & 
     23                       agrif_root, agrif_cfixed, lk_agrif, & 
     24                       rdt,rdttra, gdept_0, ln_crs, gdepw_0,  adatrj, fjulday 
     25 
    2126   USE c1d             ! 1D vertical configuration 
    2227   USE flo_oce         ! floats module declarations 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4990 r5105  
    409409                            CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    410410      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing 
    411  
     411      ! 
     412      IF( ln_crs .AND. lk_ldfslp ) THEN 
     413                            CALL dom_grid_crs 
     414                            CALL ldf_slp_init_crs 
     415                            CALL dom_grid_glo 
     416      ENDIF 
    412417      !                                     ! Active tracers 
    413418                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    414419                            CALL tra_bbc_init   ! bottom heat flux 
    415420      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
     421      ! 
     422      IF( ln_crs .AND. lk_trabbl     )  THEN 
     423                            CALL dom_grid_crs  
     424                            CALL tra_bbl_init_crs   ! advective (and/or diffusive) bottom boundary layer scheme 
     425                            CALL dom_grid_glo 
     426      ENDIF 
     427      ! 
    416428                            CALL tra_dmp_init   ! internal damping trends- tracers 
    417429                            CALL tra_adv_init   ! horizontal & vertical advection 
     
    434446#if defined key_top 
    435447      !                                     ! Passive tracers 
     448      IF( ln_crs_top )      CALL dom_grid_crs 
    436449                            CALL     trc_init 
     450      IF( ln_crs_top )      CALL dom_grid_glo 
    437451#endif 
    438452      !                                     ! Diagnostics 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4990 r5105  
    3333   USE step_oce         ! time stepping definition modules 
    3434   USE iom 
     35   USE crs 
    3536 
    3637   IMPLICIT NONE 
     
    138139                         CALL zdf_mxl( kstp )         ! mixed layer depth 
    139140 
     141      IF(ln_crs)         CALL zdf_mxl_crs(kstp) 
    140142                                                      ! write TKE or GLS information in the restart file 
    141143      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
     
    224226      ! Passive Tracer Model 
    225227      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     228      IF( ln_crs )   THEN 
     229                         CALL dom_grid_crs 
     230                         CALL eos_crs(tsb_crs , rhd_crs, rhop_crs) 
     231                         CALL bn2_crs(tsb_crs , rb2_crs) 
     232         IF( ln_zps )    CALL zps_hde_crs( kstp, 2, tsb_crs, gtsu_crs, gtsv_crs, rhd_crs, gru_crs, grv_crs ) 
     233                         CALL zdf_mxl_crs(kstp) 
     234         IF( lk_ldfslp .AND.  .NOT. ln_traldf_grif )  & 
     235                         CALL ldf_slp_crs( kstp, rhd_crs, rb2_crs ) 
     236                         CALL dom_grid_glo 
     237      ENDIF 
     238 
     239      IF( ln_crs_top )   CALL dom_grid_crs 
     240 
    226241                         CALL trc_stp( kstp )         ! time-stepping 
     242 
     243      IF( ln_crs_top )   CALL dom_grid_glo 
    227244#endif 
    228245 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4990 r5105  
    9595 
    9696   USE crsfld           ! Standard output on coarse grid   (crs_fld routine) 
     97   USE zdfmxl_crs 
     98   USE eosbn2_crs 
     99   USE zpshde_crs 
     100   USE ldfslp_crs 
    97101 
    98102   USE asminc           ! assimilation increments      (tra_asm_inc routine) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r4996 r5105  
    1313   !!---------------------------------------------------------------------- 
    1414   USE trc         ! passive tracers common variables  
    15    USE iom         ! I/O manager 
     15   USE oce_trc 
     16   USE crs, ONLY : ln_crs 
    1617 
    1718   IMPLICIT NONE 
     
    3233      INTEGER              :: jn 
    3334      !!--------------------------------------------------------------------- 
     35      IF( ln_crs ) CALL iom_swap( "nemo_crs" ) 
    3436  
    3537      ! write the tracer concentrations in the file 
     
    3739      DO jn = jp_myt0, jp_myt1 
    3840         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    39          CALL iom_put( cltra, trn(:,:,:,jn) ) 
     41         IF( lk_vvl ) THEN 
     42            CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) ) 
     43         ELSE 
     44            CALL iom_put( TRIM(cltra), trn(:,:,:,jn) ) 
     45         ENDIF 
    4046      END DO 
     47      ! 
     48      IF( ln_crs ) CALL iom_swap( "nemo" ) 
    4149      ! 
    4250   END SUBROUTINE trc_wri_my_trc 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r4990 r5105  
    1717   USE trcnam_trp      ! passive tracers transport namelist variables 
    1818   USE trabbl          ! bottom boundary layer               (trc_bbl routine) 
     19   USE trabbl_crs      ! bottom boundary layer               (trc_bbl routine) 
    1920   USE trcbbl          ! bottom boundary layer               (trc_bbl routine) 
     21   USE trcbbl_crs      ! bottom boundary layer               (trc_bbl routine) 
    2022   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine) 
    2123   USE trcdmp          ! internal damping                    (trc_dmp routine) 
    2224   USE trcldf          ! lateral mixing                      (trc_ldf routine) 
     25   USE trcldf_crs      ! lateral mixing                      (trc_ldf routine) 
    2326   USE trcadv          ! advection                           (trc_adv routine) 
     27   USE trcadv_crs      ! advection                           (trc_adv routine) 
    2428   USE trczdf          ! vertical diffusion                  (trc_zdf routine) 
     29   USE trczdf_crs      ! vertical diffusion                  (trc_zdf routine 
    2530   USE trcnxt          ! time-stepping                       (trc_nxt routine) 
    2631   USE trcrad          ! positivity                          (trc_rad routine) 
    2732   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
     33   USE trcsbc_crs      ! surface boundary condition          (trc_sbc routine) 
    2834   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     35   USE zpshde_crs      ! partial step: hor. derivative       (zps_hde routine) 
     36   USE dom_oce , ONLY : ln_crs 
     37   USe crs, ONLY : jpi_crs,jpj_crs,wn_crs !cbr 
    2938 
    3039#if defined key_agrif 
     
    5867      !!---------------------------------------------------------------------- 
    5968      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index 
     69      REAL(wp) :: zmin,zmax 
     70      INTEGER :: ji,jj,jk 
    6071      !! --------------------------------------------------------------------- 
    6172      ! 
     
    6475      IF( .NOT. lk_c1d ) THEN 
    6576         ! 
    66                                 CALL trc_sbc( kstp )            ! surface boundary condition 
    67          IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
     77!         CALL test(kstp,1) 
     78!         IF( ln_crs ) THEN ;    CALL trc_sbc_crs( kstp ) 
     79!         ELSE              ;    CALL trc_sbc( kstp ) 
     80!         ENDIF 
     81!         CALL test(kstp,2) 
     82         IF( ln_crs ) THEN ;    CALL trc_bbl_crs( kstp ) 
     83         ELSE              ;    CALL trc_bbl( kstp ) 
     84         ENDIF 
    6885         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
     86!         CALL test(kstp,3) 
     87 
     88         IF( ln_crs ) THEN ;    CALL trc_adv_crs( kstp ) 
     89         ELSE              ;    CALL trc_adv( kstp ) 
     90         ENDIF 
     91!         CALL test(kstp,4) 
     92 
    6993         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    70                                 CALL trc_adv( kstp )            ! horizontal & vertical advection  
    71                                 CALL trc_ldf( kstp )            ! lateral mixing 
     94         IF( ln_crs ) THEN ;    CALL trc_ldf_crs( kstp ) 
     95         ELSE              ;    CALL trc_ldf( kstp ) 
     96         ENDIF 
     97!         CALL test(kstp,5) 
    7298         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    7399            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
     
    75101         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge 
    76102#endif 
    77                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
     103         IF( ln_crs ) THEN ;    CALL trc_zdf_crs( kstp ) 
     104         ELSE              ;    CALL trc_zdf( kstp ) 
     105         ENDIF 
     106!         CALL test(kstp,6) 
    78107                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
     108!         CALL test(kstp,7) 
    79109         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
    80110 
     
    82112      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only 
    83113#endif 
    84          IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )  ! Partial steps: now horizontal gradient of passive 
     114         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive 
     115         IF( ln_zps    )THEN 
     116         IF( ln_crs ) THEN ;    CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv ) 
     117         ELSE              ;    CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) 
     118         ENDIF 
     119         ENDIF 
    85120                                                                ! tracers at the bottom ocean level 
    86121         ! 
     
    98133      ! 
    99134   END SUBROUTINE trc_trp 
     135   SUBROUTINE test(kt,i) 
     136   INTEGER,INTENT(IN) :: kt,i 
     137   REAL(wp)::zmin,zmax 
     138   INTEGER :: ji,jj,jk 
     139   zmin=MINVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 
     140   zmax=MAXVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
     141   IF(lwp)WRITE(numout,*)"trctrp b ",kt,i,zmin,zmax    
     142   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 
     143   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
     144   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax    
     145   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 
     146   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
     147   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax    
     148   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin) 
     149   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax) 
     150   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax    
     151   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin) 
     152   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax) 
     153   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax    
    100154 
     155   IF(narea==267)WRITE(narea+5000,*)"tra(17,5,74,1) = ",kt,i,tra(17,5,74,1) 
     156 
     157   DO ji=1,jpi 
     158   DO jj=1,jpj 
     159   DO jk=1,jpk 
     160      IF( tra(ji,jj,jk,1) .NE.  tra(ji,jj,jk,1) )WRITE(narea+200,*)"BUG7 ",ji,jj,jk, tra(ji,jj,jk,1); CALL FLUSH(narea+200) 
     161   ENDDO 
     162   ENDDO 
     163   ENDDO 
     164    
     165   END SUBROUTINE test 
    101166#else 
    102167   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r4990 r5105  
    88   !!---------------------------------------------------------------------- 
    99#if defined key_top 
     10 
     11#if defined key_crs 
     12 
     13  !* Domain size * 
     14   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i  
     15   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j   
     16   USE par_oce , ONLY :   jpk      =>   jpk        !: number of levels   
     17   USE par_oce , ONLY :   jpim1    =>   jpim1      !: jpi - 1 
     18   USE par_oce , ONLY :   jpjm1    =>   jpjm1      !: jpj - 1  
     19   USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1   
     20   USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj 
     21   USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option 
     22   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature 
     23   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
     24 
     25   !* IO manager * 
     26   USE in_out_manager 
     27 
     28   !* Memory Allocation * 
     29   USE wrk_nemo 
     30 
     31   !* Timing * 
     32   USE timing, ONLY : timing_start , timing_stop 
     33 
     34   !* MPP library                          
     35   USE lib_mpp 
     36 
     37   !* Fortran utilities                          
     38   USE lib_fortran 
     39 
     40   !* Lateral boundary conditions                          
     41   USE lbclnk 
     42 
     43   !* physical constants * 
     44   USE phycst 
     45 
     46   !* 1D configuration 
     47   USE c1d 
     48 
     49   !* model domain * 
     50   USE dom_oce , ONLY : narea => narea 
     51   USE dom_oce , ONLY : nproc => nproc 
     52   USE dom_oce , ONLY : nimpp => nimpp 
     53   USE dom_oce , ONLY : njmpp => njmpp 
     54   USE dom_oce , ONLY : nreci => nreci 
     55   USE dom_oce , ONLY : nrecj => nrecj 
     56   USE dom_oce , ONLY : nlci  => nlci 
     57   USE dom_oce , ONLY : nldi  => nldi 
     58   USE dom_oce , ONLY : nlei  => nlei 
     59   USE dom_oce , ONLY : nlcj  => nlcj 
     60   USE dom_oce , ONLY : nldj  => nldj 
     61   USE dom_oce , ONLY : nlej  => nlej 
     62   USE dom_oce , ONLY : nlcit  => nlcit 
     63   USE dom_oce , ONLY : nldit  => nldit 
     64   USE dom_oce , ONLY : nleit  => nleit 
     65   USE dom_oce , ONLY : nlcjt  => nlcjt 
     66   USE dom_oce , ONLY : nldjt  => nldjt 
     67   USE dom_oce , ONLY : nlejt  => nlejt 
     68   USE dom_oce , ONLY : nimppt => nimppt 
     69   USE dom_oce , ONLY : njmppt => njmppt 
     70   USE dom_oce , ONLY : ibonit => ibonit 
     71   USE dom_oce , ONLY : ibonjt => ibonjt 
     72   USE dom_oce , ONLY : lk_vvl => lk_vvl 
     73   USE dom_oce , ONLY : rdt => rdt 
     74   USE dom_oce , ONLY : ln_zco => ln_zco 
     75   USE dom_oce , ONLY : ln_zps => ln_zps 
     76   USE dom_oce , ONLY : ln_sco => ln_sco 
     77   USE dom_oce , ONLY : neuler => neuler 
     78 
     79   USE crs,  ONLY : mi0 => mi0  
     80   USE crs,  ONLY : mi1 => mi1  
     81   USE crs,  ONLY : mj0 => mj0  
     82   USE crs,  ONLY : mj1 => mj1  
     83 
     84   USE dom_oce , ONLY :  lzoom => lzoom  
     85   !USE dom_oce , ONLY :  =>  
     86 
     87   !* horizontal mesh * 
     88   USE crs , ONLY :   glamt      =>   glamt_crs      !: longitude of t-point (degre)   
     89   USE crs , ONLY :   glamu      =>   glamu_crs      !: longitude of t-point (degre)   
     90   USE crs , ONLY :   glamv      =>   glamv_crs      !: longitude of t-point (degre)   
     91   USE crs , ONLY :   glamf      =>   glamf_crs      !: longitude of t-point (degre)   
     92   USE crs , ONLY :   gphit      =>   gphit_crs      !: latitude  of t-point (degre)    
     93   USE crs , ONLY :   gphiu      =>   gphiu_crs      !: latitude  of t-point (degre)    
     94   USE crs , ONLY :   gphiv      =>   gphiv_crs      !: latitude  of t-point (degre)    
     95   USE crs , ONLY :   gphif      =>   gphif_crs      !: latitude  of t-point (degre)    
     96   USE crs , ONLY :   e1t        =>   e1t_crs        !: horizontal scale factors at t-point (m)   
     97   USE crs , ONLY :   e2t        =>   e2t_crs        !: horizontal scale factors at t-point (m)    
     98   USE crs , ONLY :   e1e2t      =>   e1e2t_crs      !: cell surface at t-point (m2) 
     99   USE crs , ONLY :   e1u        =>   e1u_crs        !: horizontal scale factors at u-point (m) 
     100   USE crs , ONLY :   e2u        =>   e2u_crs        !: horizontal scale factors at u-point (m) 
     101   USE crs , ONLY :   e1v        =>   e1v_crs        !: horizontal scale factors at v-point (m) 
     102   USE crs , ONLY :   e2v        =>   e2v_crs        !: horizontal scale factors at v-point (m)   
     103   USE crs , ONLY :   e3t        =>  e3t_crs         !: vertical scale factors at t- 
     104   USE crs , ONLY :   e3t_0      =>  e3t_crs         !: vertical scale factors at t- 
     105   USE crs , ONLY :   fse3t      =>  e3t_crs 
     106   USE crs , ONLY :   fse3t_b      =>  e3t_crs 
     107   USE crs , ONLY :   fse3t_a      =>  e3t_crs 
     108   USE crs , ONLY :   fse3w      =>  e3w_crs 
     109   USE crs , ONLY :   e3u        =>  e3u_crs         !: vertical scale factors at u- 
     110   USE crs , ONLY :   e3u_0      =>  e3u_crs         !: vertical scale factors at u- 
     111   USE crs , ONLY :   e3v        =>  e3v_crs         !: vertical scale factors v- 
     112   USE crs , ONLY :   e3v_0      =>  e3v_crs         !: vertical scale factors v- 
     113   USE crs , ONLY :   e3w        =>  e3w_crs         !: w-points (m) 
     114   USE crs , ONLY :   e3w_0      =>  e3w_crs         !: w-points (m) 
     115   USE crs , ONLY :   e3f        =>  e3f_crs         !: f-points (m) 
     116   USE crs , ONLY :   ff         =>  ff_crs         !: f-points (m) 
     117 
     118   USE crs , ONLY :   gdept_0    =>  gdept_crs       !: depth of t-points (m) 
     119   USE dom_oce , ONLY :   gdept_1d   =>  gdept_1d      !: depth of t-points (m) 
     120#if defined key_zco 
     121   USE crs , ONLY :   gdept      =>  gdept_crs       !: depth of t-points (m) 
     122   USE crs , ONLY :   gdepw      =>  gdepw_crs       !: depth of t-points (m) 
     123#endif 
     124  !* masks, bathymetry * 
     125   USE crs , ONLY :   mbkt       =>   mbkt_crs       !: vertical index of the bottom last T- ocean level 
     126   USE crs , ONLY :   mbku       =>   mbku_crs       !: vertical index of the bottom last U- ocean level 
     127   USE crs , ONLY :   mbkv       =>   mbkv_crs       !: vertical index of the bottom last V- ocean level 
     128   USE crs , ONLY :   tmask_i    =>   tmask_i_crs    !: Interior mask at t-points 
     129   USE crs , ONLY :   tmask      =>   tmask_crs      !: land/ocean mask at t-points 
     130   USE crs , ONLY :   umask      =>   umask_crs      !: land/ocean mask at u-points    
     131   USE crs , ONLY :   vmask      =>   vmask_crs      !: land/ocean mask at v-points  
     132   USE crs , ONLY :   fmask      =>   fmask_crs      !: land/ocean mask at f-points  
     133 
     134 !* ocean fields: here now and after fields * 
     135!cbr?   USE crs , ONLY :   ua      =>    ua_crs      !: i-horizontal velocity (m s-1)  
     136!cbr?   USE crs , ONLY :   va      =>    va_crs      !: j-horizontal velocity (m s-1) 
     137   USE crs , ONLY :   un      =>    un_crs      !: i-horizontal velocity (m s-1)  
     138   USE crs , ONLY :   vn      =>    vn_crs      !: j-horizontal velocity (m s-1) 
     139   USE crs , ONLY :   wn      =>    wn_crs      !: vertical velocity (m s-1)   
     140   USE crs , ONLY :   tsn     =>    tsn_crs     !: 4D array contaning ( tn, sn ) 
     141   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb ) 
     142   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa ) 
     143   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
     144   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     145   USE crs , ONLY :   hdivn   =>    hdivn_crs   !: horizontal divergence (1/s) 
     146   USE crs , ONLY :   hdivb   =>    hdivb_crs   !: horizontal divergence (1/s) 
     147   USE crs , ONLY :   sshb    =>    sshb_crs    !: sea surface height at t-point [m]    
     148   USE crs , ONLY :   sshn    =>    sshn_crs    !: sea surface height at t-point [m]    
     149   USE crs , ONLY :   ssha    =>    ssha_crs    !: sea surface height at t-point [m]    
     150 
     151   !* surface fluxes * 
     152   USE crs , ONLY :   utau       =>    utau_crs       !: i-surface stress component 
     153   USE crs , ONLY :   vtau       =>    vtau_crs       !: j-surface stress component 
     154   USE crs , ONLY :   wndm       =>    wndm_crs       !: 10m wind speed  
     155   USE crs , ONLY :   qsr        =>    qsr_crs        !: penetrative solar radiation (w m-2)   
     156   USE crs , ONLY :   emp        =>    emp_crs        !: freshwater budget: volume flux               [Kg/m2/s] 
     157   USE crs , ONLY :   emp_b      =>    emp_b_crs      !: freshwater budget: volume flux               [Kg/m2/s] 
     158   USE crs , ONLY :   sfx        =>    sfx_crs        !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     159   USE crs , ONLY :   fmmflx     =>    fmmflx_crs     !: freshwater budget: volume flux               [Kg/m2/s] 
     160   USE crs , ONLY :   rnf        =>    rnf_crs        !: river runoff   [Kg/m2/s] 
     161   USE crs , ONLY :   fr_i       =>    fr_i_crs       !: ice fraction (between 0 to 1) 
     162 
     163   USE crs , ONLY :   avt        =>   avt_crs         !: vert. diffusivity coef. at w-point for temp   
     164#if defined key_zdfddm 
     165   USE crs , ONLY :   avs        =>   avs_crs         !: salinity vertical diffusivity coeff. at w-point 
     166#endif 
     167 
     168!cbr   USE trc_oce 
     169   USE trc_oce, ONLY : lk_offline 
     170   USE trc_oce, ONLY : nn_dttrc 
     171 
     172   USE crs , ONLY :   nmln        =>   nmln_crs        !: number of level in the mixed layer 
     173   USE crs , ONLY :   hmld        =>   hmld_crs        !: mixing layer depth (turbocline) 
     174   USE crs , ONLY :   hmlp        =>   hmlp_crs        !: mixed layer depth  (rho=rho0+zdcrit) (m) 
     175   USE crs , ONLY :   hmlpt       =>   hmlpt_crs       !: mixed layer depth at t-points (m) 
     176 
     177  !* direction of lateral diffusion * 
     178#if   defined key_ldfslp 
     179   USE ldfslp_crs , ONLY :   uslp       =>   uslp_crs         !: i-direction slope at u-, w-points 
     180   USE ldfslp_crs , ONLY :   vslp       =>   vslp_crs         !: j-direction slope at v-, w-points 
     181   USE ldfslp_crs , ONLY :   wslpi      =>   wslpi_crs        !: i-direction slope at u-, w-points 
     182   USE ldfslp_crs , ONLY :   wslpj      =>   wslpj_crs        !: j-direction slope at v-, w-points 
     183#endif 
     184 
     185#else 
     186 
    10187   !!---------------------------------------------------------------------- 
    11188   !!   'key_top'                                                TOP models 
     
    24201   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
    25202 
     203  !* model domain * 
     204   USE dom_oce , ONLY : narea => narea 
     205   USE dom_oce , ONLY : nproc => nproc 
     206   USE dom_oce , ONLY : nimpp => nimpp 
     207   USE dom_oce , ONLY : njmpp => njmpp 
     208   USE dom_oce , ONLY : nreci => nreci 
     209   USE dom_oce , ONLY : nrecj => nrecj 
     210   USE dom_oce , ONLY : nlci  => nlci 
     211   USE dom_oce , ONLY : nldi  => nldi 
     212   USE dom_oce , ONLY : nlei  => nlei 
     213   USE dom_oce , ONLY : nlcj  => nlcj 
     214   USE dom_oce , ONLY : nldj  => nldj 
     215   USE dom_oce , ONLY : nlej  => nlej 
     216   USE dom_oce , ONLY : nlcit  => nlcit 
     217   USE dom_oce , ONLY : nldit  => nldit 
     218   USE dom_oce , ONLY : nleit  => nleit 
     219   USE dom_oce , ONLY : nlcjt  => nlcjt 
     220   USE dom_oce , ONLY : nldjt  => nldjt 
     221   USE dom_oce , ONLY : nlejt  => nlejt 
     222   USE dom_oce , ONLY : nimppt => nimppt 
     223   USE dom_oce , ONLY : njmppt => njmppt 
     224   USE dom_oce , ONLY : ibonit => ibonit 
     225   USE dom_oce , ONLY : ibonjt => ibonjt 
     226   USE dom_oce , ONLY : lk_vvl => lk_vvl 
     227   USE dom_oce , ONLY : rdt => rdt 
     228   USE dom_oce , ONLY : ln_zco => ln_zco 
     229   USE dom_oce , ONLY : ln_zps => ln_zps 
     230   USE dom_oce , ONLY : ln_sco => ln_sco 
     231   USE dom_oce , ONLY : neuler => neuler 
     232 
     233   USE dom_oce,  ONLY : mi0 => mi0 
     234   USE dom_oce,  ONLY : mi1 => mi1 
     235   USE dom_oce,  ONLY : mj0 => mj0 
     236   USE dom_oce,  ONLY : mj1 => mj1 
     237 
     238   USE dom_oce , ONLY :   glamt      =>   glamt      !: longitude of t-point (degre)   
     239   USE dom_oce , ONLY :   glamu      =>   glamu      !: longitude of t-point (degre)   
     240   USE dom_oce , ONLY :   glamv      =>   glamv      !: longitude of t-point (degre)   
     241   USE dom_oce , ONLY :   glamf      =>   glamf      !: longitude of t-point (degre)   
     242   USE dom_oce , ONLY :   gphit      =>   gphit      !: latitude  of t-point (degre)    
     243   USE dom_oce , ONLY :   gphiu      =>   gphiu      !: latitude  of t-point (degre)    
     244   USE dom_oce , ONLY :   gphiv      =>   gphiv      !: latitude  of t-point (degre)    
     245   USE dom_oce , ONLY :   gphif      =>   gphif     !: latitude  of t-point (degre)    
     246   USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)   
     247   USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)    
     248   USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2) 
     249   USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m) 
     250   USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m) 
     251   USE dom_oce , ONLY :   e1v        =>   e1v        !: horizontal scale factors at v-point (m) 
     252   USE dom_oce , ONLY :   e2v        =>   e2v        !: horizontal scale factors at v-point (m)   
     253   USE dom_oce , ONLY :   e3t        =>  e3t_0         !: vertical scale factors at t- 
     254   USE dom_oce , ONLY :   e3t_0      =>  e3t_0         !: vertical scale factors at t- 
     255   USE dom_oce , ONLY :   fse3t      =>  e3t_0 
     256   USE dom_oce , ONLY :   fse3t_b      =>  e3t_0 
     257   USE dom_oce , ONLY :   fse3t_a      =>  e3t_0 
     258   USE dom_oce , ONLY :   fse3w      =>  e3w_0 
     259   USE dom_oce , ONLY :   e3u        =>  e3u_0         !: vertical scale factors at u- 
     260   USE dom_oce , ONLY :   e3u_0      =>  e3u_0         !: vertical scale factors at u- 
     261   USE dom_oce , ONLY :   e3v        =>  e3v_0         !: vertical scale factors v- 
     262   USE dom_oce , ONLY :   e3v_0      =>  e3v_0         !: vertical scale factors v- 
     263   USE dom_oce , ONLY :   e3w        =>  e3w_0         !: w-points (m) 
     264   USE dom_oce , ONLY :   e3w_0      =>  e3w_0         !: w-points (m) 
     265   USE dom_oce , ONLY :   e3f        =>  e3f_0         !: f-points (m) 
     266   USE dom_oce , ONLY :   ff         =>  ff         !: f-points (m) 
     267   USE dom_oce , ONLY :   gdept_0    =>  gdept_0         !: f-points (m) 
     268   USE dom_oce , ONLY :   gdept_1d   => gdept_1d          !: f-points (m) 
     269   USE dom_oce , ONLY :   tmask      => tmask          !: f-points (m) 
     270   USE dom_oce , ONLY :   umask      => umask          !: f-points (m) 
     271   USE dom_oce , ONLY :   vmask      => vmask          !: f-points (m) 
     272   USE dom_oce , ONLY :   tmask_i      => tmask_i          !: f-points (m) 
     273   USE dom_oce , ONLY :   mbkt      => mbkt          !: f-points (m) 
     274   USE dom_oce , ONLY :   mbku      => mbku          !: f-points (m) 
     275   USE dom_oce , ONLY :   mbkv      => mbkv          !: f-points (m) 
     276 
    26277   !* IO manager * 
    27278   USE in_out_manager     
     
    49300 
    50301   !* model domain * 
    51    USE dom_oce  
     302   !cbr USE dom_oce , ONLY : e3w_0 
     303   USE dom_oce , ONLY :  lzoom => lzoom  
    52304 
    53305   USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport 
     
    66318   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    67319   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    68 #if defined key_offline 
    69    USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
    70 #endif 
    71320   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    72321   USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1] 
     
    135384# endif 
    136385 
     386#endif 
    137387#else 
    138388   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r4292 r5105  
    2020   !! trcdib_wr   : outputs of biological fields 
    2121   !!---------------------------------------------------------------------- 
    22    USE dom_oce         ! ocean space and time domain variables  
    23    USE oce_trc 
     22   USE trc_oce, ONLY : lk_offline ! offline flag 
    2423   USE trc 
    2524   USE par_trc 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r4624 r5105  
    1919   USE oce_trc       !  shared variables between ocean and passive tracers 
    2020   USE trc           !  passive tracers common variables 
    21    USE iom           !  I/O manager 
    2221   USE lib_mpp       !  MPP library 
    2322   USE fldread       !  read input fields 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r4990 r5105  
    2525   USE trcini_my_trc   ! MY_TRC   initialisation 
    2626   USE trcdta          ! initialisation from files 
    27    USE daymod          ! calendar manager 
    28    USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
     27   USE zpshde,ONLY: zps_hde    ! partial step: hor. derivative   (zps_hde routine) 
     28   USE zpshde_crs      ! partial step: hor. derivative   (zps_hde routine) 
    2929   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    3030   USE trcsub          ! variables to substep passive tracers 
    3131   USE lib_mpp         ! distribued memory computing library 
    32    USE sbc_oce 
     32   USE sbc_oce, ONLY : ltrcdm2dc 
     33   USE crs    , ONLY : ln_crs 
     34   USE dom_oce, ONLY : nn_cla 
    3335  
    3436   IMPLICIT NONE 
     
    143145  
    144146      tra(:,:,:,:) = 0._wp 
    145       IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    146         &    CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )       ! tracers at the bottom ocean level 
    147  
     147      IF( ln_zps .AND. .NOT. lk_c1d )THEN              ! Partial steps: before horizontal gradient of passive 
     148         IF( ln_crs )  THEN 
     149            CALL zps_hde_crs( nit000, jptra, trn, gtru, gtrv ) 
     150         ELSE 
     151            CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )! tracers at the bottom ocean level 
     152         ENDIF 
     153      ENDIF 
    148154      ! 
    149155      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
     
    188194      !!---------------------------------------------------------------------- 
    189195      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines... 
     196      USE trcadv_crs    , ONLY:   trc_adv_alloc_crs      ! TOP-related alloc routines.. 
    190197      USE trc           , ONLY:   trc_alloc 
    191198      USE trcnxt        , ONLY:   trc_nxt_alloc 
    192199      USE trczdf        , ONLY:   trc_zdf_alloc 
     200      USE trczdf_crs    , ONLY:   trc_zdf_alloc_crs 
    193201      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc 
    194202#if defined key_trdmxl_trc  
     
    200208      ! 
    201209      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines... 
     210      ierr = ierr + trc_adv_alloc_crs() 
    202211      ierr = ierr + trc_alloc    () 
    203212      ierr = ierr + trc_nxt_alloc() 
    204213      ierr = ierr + trc_zdf_alloc() 
     214      ierr = ierr + trc_zdf_alloc_crs() 
    205215      ierr = ierr + trd_trc_oce_alloc() 
    206216#if defined key_trdmxl_trc  
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r4990 r5105  
    2323   !!   trc_rst_wri    : write restart file 
    2424   !!---------------------------------------------------------------------- 
    25    USE oce_trc 
     25   USE oce_trc ! ,ONLY: jprstlib 
    2626   USE trc 
    2727   USE trcnam_trp 
    28    USE iom 
    29    USE daymod 
     28   USE iom_def , ONLY : jprstlib , jprstdimg , jpnf90 , jpdom_autoglo  
     29   USE iom , ONLY : iom_open , iom_get , iom_varid , iom_rstput , iom_close 
     30   USE dom_oce, ONLY: ndastp ,adatrj  , rdttra 
     31   USE daymod , ONLY : day_init 
     32 
    3033   IMPLICIT NONE 
    3134   PRIVATE 
     
    137140          CALL trc_rst_stat            ! statistics 
    138141          CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
    139 #if ! defined key_trdmxl_trc 
     142#if ! defined key_trdmld_trc 
    140143          lrst_trc = .FALSE. 
    141144#endif 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r4990 r5105  
    1111   !!---------------------------------------------------------------------- 
    1212   USE oce_trc          ! ocean dynamics and active tracers variables 
    13    USE sbc_oce 
     13   USE sbc_oce , ONLY : ltrcdm2dc,qsr_mean 
    1414   USE trc 
    1515   USE trctrp           ! passive tracers transport 
     
    1717   USE prtctl_trc       ! Print control for debbuging 
    1818   USE trcdia 
    19    USE trcwri 
     19   USE trcwri , ONLY : trc_wri 
    2020   USE trcrst 
    2121   USE trdtrc_oce 
    2222   USE trdmxl_trc 
    23    USE iom 
     23   USE iom, ONLY : lk_iomput , iom_close 
    2424   USE in_out_manager 
    2525   USE trcsub 
     26   USE dom_oce, ONLY : nday, nmonth, nyear 
    2627 
    2728   IMPLICIT NONE 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r4611 r5105  
    1313   USE trc 
    1414   USE prtctl_trc       ! Print control for debbuging 
    15    USE iom 
    16    USE in_out_manager 
     15   USE iom, ONLY : jpnf90 
     16   USE in_out_manager, ONLY : jprstlib 
    1717   USE lbclnk 
    18 #if defined key_zdftke 
    19    USE zdftke          ! twice TKE (en) 
    20 #endif 
     18!#if defined key_zdftke 
     19!   USE zdftke          ! twice TKE (en) 
     20!#endif 
    2121#if defined key_zdfgls 
    2222   USE zdfgls, ONLY: en 
    2323#endif 
    24    USE trabbl 
    25    USE zdf_oce 
    26    USE domvvl 
    27    USE divcur          ! hor. divergence and curl      (div & cur routines) 
     24!   USE trabbl 
     25!   USE zdf_oce 
     26!   USE domvvl 
     27   USE divcur, ONLY : div_cur           ! hor. divergence and curl      (div & cur routines) 
    2828   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff  
    2929   USE bdy_oce 
     
    160160         wndm_temp  (:,:)        = wndm  (:,:) 
    161161         !                                    !  Variables reset in trc_sub_ssh 
     162#if ! defined key_crs 
    162163         rotn_temp  (:,:,:)      = rotn  (:,:,:) 
     164# endif 
    163165         hdivn_temp (:,:,:)      = hdivn (:,:,:) 
     166#if ! defined key_crs 
    164167         rotb_temp  (:,:,:)      = rotb  (:,:,:) 
     168# endif 
    165169         hdivb_temp (:,:,:)      = hdivb (:,:,:) 
    166170         ! 
     
    396400      ! 
    397401      hdivn (:,:,:)   =  hdivn_temp (:,:,:) 
     402      hdivb (:,:,:)   =  hdivb_temp (:,:,:) 
     403#if ! defined key_crs 
    398404      rotn  (:,:,:)   =  rotn_temp  (:,:,:) 
    399       hdivb (:,:,:)   =  hdivb_temp (:,:,:) 
    400405      rotb  (:,:,:)   =  rotb_temp  (:,:,:) 
     406#endif 
    401407      !                                       
    402408 
Note: See TracChangeset for help on using the changeset viewer.