Changeset 5601


Ignore:
Timestamp:
2015-07-16T11:04:29+02:00 (5 years ago)
Author:
cbricaud
Message:

commit changes/bugfix/… for crs ; ok with time-splitting/fixed volume

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
Files:
38 edited

Legend:

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

    r5105 r5601  
    147147 
    148148      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields 
    149       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs 
     149      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs,rab_crs_n 
    150150      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs 
    151151      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: ub_crs, vb_crs 
     
    163163      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs 
    164164 
     165      REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE ::   uslp_crs, wslpi_crs          !: i_slope at U- and W-points 
     166      REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE ::   vslp_crs, wslpj_crs          !: j-slope at V- and W-points 
     167 
     168      ! Horizontal diffusion 
     169#if defined key_traldf_c3d 
     170   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 3D coefficients ** at T-,U-,V-,W-points 
     171#elif defined key_traldf_c2d 
     172   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 2D coefficients ** at T-,U-,V-,W-points 
     173#elif defined key_traldf_c1d 
     174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 1D coefficients ** at T-,U-,V-,W-points 
     175#else 
     176   REAL(wp), PUBLIC                                      ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 0D coefficients ** at T-,U-,V-,W-points 
     177#endif 
     178 
    165179      ! Vertical diffusion 
    166180      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp   
     
    184198      !!------------------------------------------------------------------- 
    185199      !! Local variables 
    186       INTEGER, DIMENSION(14) :: ierr 
     200      INTEGER, DIMENSION(15) :: ierr 
    187201 
    188202      ierr(:) = 0 
     
    246260         &      hdivb_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , & 
    247261         &      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) , & 
     262         &      rb2_crs(jpi_crs,jpj_crs,jpk) ,rhd_crs(jpi_crs,jpj_crs,jpk)   , rab_crs_n(jpi_crs,jpj_crs,jpk,jpts) , & 
     263         &      gtsu_crs(jpi_crs,jpj_crs,jpts) ,gtsv_crs(jpi_crs,jpj_crs,jpts) , & 
    250264                gru_crs(jpi_crs,jpj_crs) ,grv_crs(jpi_crs,jpj_crs) , STAT=ierr(11)) 
    251265 
     
    256270         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  ) 
    257271 
     272#if defined key_traldf_c3d 
     273      ALLOCATE( ahtt_crs(jpi_crs,jpj_crs,jpk) , ahtu_crs(jpi_crs,jpj_crs,jpk) , ahtv_crs(jpi_crs,jpj_crs,jpk) , ahtw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(13) ) 
     274#elif defined key_traldf_c2d 
     275      ALLOCATE( ahtt_crs(jpi_crs,jpj_crs    ) , ahtu_crs(jpi_crs,jpj_crs    ) , ahtv_crs(jpi_crs,jpj_crs    ) , ahtw_crs(jpi_crs,jpj_crs    ) , STAT=ierr(13) ) 
     276#elif defined key_traldf_c1d 
     277      ALLOCATE( ahtt_crs(        jpk) , ahtu_crs(        jpk) , ahtv_crs(        jpk) , ahtw_crs(        jpk) , STAT=ierr(13) ) 
     278#endif 
     279 
    258280     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    & 
    259281# if defined key_zdfddm 
    260282         &      avs_crs(jpi_crs,jpj_crs,jpk),    & 
    261283# endif 
    262          &      STAT=ierr(13) ) 
     284         &      STAT=ierr(14) ) 
    263285 
    264286      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , & 
    265          &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 
     287         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(15) ) 
    266288 
    267289      crs_dom_alloc1 = MAXVAL(ierr) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r5105 r5601  
    16331633                      ENDIF 
    16341634                   ELSE 
     1635                      DO ji = nistr, niend, nn_factx 
     1636                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    16351637                      je_2 = mjs_crs(2)  
    16361638                      zflcrs =  & 
     
    16461648                      ! 
    16471649                      p_fld_crs(ii,2) = zflcrs 
     1650                      ENDDO 
    16481651                   ENDIF 
    16491652 
     
    20702073               ENDDO 
    20712074            ENDDO 
     2075 
     2076 
     2077            !first level 
    20722078            DO ji = nistr, niend, nn_factx 
    20732079               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     
    22192225      END SELECT 
    22202226 
    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) 
     2227      !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) 
    22222228 
    22232229      SELECT CASE ( cd_type ) 
     
    22702276                    &                    + zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk)   
    22712277 
    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  
    22862278            ENDDO       
    22872279         ENDDO 
     
    23332325                    &                    + zsurfmsk(ji+2,jj+1,jk)  & 
    23342326                    &                    + 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 
    23572327            ENDDO 
    23582328         ENDDO 
     
    23952365               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 
    23962366               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 
     2367               !iji=117 ; ijj=210 
     2368               !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 
     2369               !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 
     2370               !WRITE(narea+5000,*)"SFC V =======> " 
     2371               !WRITE(narea+5000,*)ii,ij,jk 
     2372               !WRITE(narea+5000,*)ji,jj 
     2373               !WRITE(narea+5000,*)zsurfmsk(ji,jj+2,jk),zsurfmsk(ji+1,jj+2,jk),zsurfmsk(ji+2,jj+2,jk) 
     2374               !WRITE(narea+5000,*)p_surf_crs    (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 
     2375               !ENDIF 
    24062376            ENDDO 
    24072377         ENDDO 
     
    24092379 
    24102380     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 
     2381      !DO jk=1,jpk 
     2382      !DO ji=1,jpi_crs 
     2383      !DO jj=1,jpj_crs 
     2384      !   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) 
     2385      !ENDDO 
     2386      !ENDDO 
     2387      !ENDDO 
    24182388      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 ) 
    24192389      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
     
    24492419      jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci 
    24502420      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj    
    2451       WRITE(narea+200,*)"jpj_crs noso = ", jpj_crs , noso         
     2421      !WRITE(narea+200,*)"jpj_crs noso = ", jpj_crs , noso         
    24522422      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors   ! celle qui est faite de zeros 
    2453       WRITE(narea+200,*)"jpj_crs = ", jpj_crs 
     2423      !WRITE(narea+200,*)"jpj_crs = ", jpj_crs 
    24542424        
    24552425      jpi_crsm1   = jpi_crs - 1 
     
    24872457        !cbr 
    24882458        DO jn = 1, jpnij 
    2489            WRITE(narea+200,*)"=====> jn",jn  ; call flush(narea+200) 
     2459           !WRITE(narea+200,*)"=====> jn",jn  ; call flush(narea+200) 
    24902460 
    24912461           !proc jn 
     
    25062476           ENDIF 
    25072477  
    2508            WRITE(narea+200,*)ii,ij  ; call flush(narea+200) 
    2509            WRITE(narea+200,*)"iproc iprocso ",iproc,iprocso 
    2510            WRITE(narea+200,*)"jpiglo jpjglo ",jpiglo,jpjglo 
    2511            WRITE(narea+200,*)"ibonit(jn) ibonjt(jn) ",ibonit(jn),ibonjt(jn) ; call flush(narea+200) 
    2512            WRITE(narea+200,*)"nimppt(jn) njmppt(jn) ",nimppt(jn),njmppt(jn) ; call flush(narea+200) 
    2513            WRITE(narea+200,*)"loc jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn),nlejt(jn),nlcjt(jn) ; call flush(narea+200) 
    2514            WRITE(narea+200,*)"glo jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn)+njmppt(jn)-1,nlejt(jn)+njmppt(jn)-1,nlcjt(jn) ; call flush(narea+200) 
     2478           !WRITE(narea+200,*)ii,ij  ; call flush(narea+200) 
     2479           !WRITE(narea+200,*)"iproc iprocso ",iproc,iprocso 
     2480           !WRITE(narea+200,*)"jpiglo jpjglo ",jpiglo,jpjglo 
     2481           !WRITE(narea+200,*)"ibonit(jn) ibonjt(jn) ",ibonit(jn),ibonjt(jn) ; call flush(narea+200) 
     2482           !WRITE(narea+200,*)"nimppt(jn) njmppt(jn) ",nimppt(jn),njmppt(jn) ; call flush(narea+200) 
     2483           !WRITE(narea+200,*)"loc jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn),nlejt(jn),nlcjt(jn) ; call flush(narea+200) 
     2484           !WRITE(narea+200,*)"glo jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn)+njmppt(jn)-1,nlejt(jn)+njmppt(jn)-1,nlcjt(jn) ; call flush(narea+200) 
    25152485 
    25162486           !dimension selon j 
     
    25192489              !iprocno=nfipproc(ii,ij+1)  
    25202490                 !iprocno=iprocno+1 
    2521                  WRITE(narea+200,*)"ii,ij+1 ",ii,ij+1; call flush(narea+200) 
    2522                  WRITE(narea+200,*)"njmppt  jn njmpptno(jn) ",njmppt(jn),njmpptno(jn); call flush(narea+200) 
    2523                  WRITE(narea+200,*)"jpjglo",jpjglo ; call flush(narea+200) 
    2524  
    2525                  WRITE(narea+200,*)REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ),REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ); call flush(narea+200) 
    2526                  WRITE(narea+200,*)AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ),AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ); call flush(narea+200) 
     2491                 !WRITE(narea+200,*)"ii,ij+1 ",ii,ij+1; call flush(narea+200) 
     2492                 !WRITE(narea+200,*)"njmppt  jn njmpptno(jn) ",njmppt(jn),njmpptno(jn); call flush(narea+200) 
     2493                 !WRITE(narea+200,*)"jpjglo",jpjglo ; call flush(narea+200) 
     2494 
     2495                 !WRITE(narea+200,*)REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ),REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ); call flush(narea+200) 
     2496                 !WRITE(narea+200,*)AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ),AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ); call flush(narea+200) 
    25272497 
    25282498                 nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt  (jn) - 1) ) / nn_facty, wp ) ) & 
     
    25322502           ENDIF 
    25332503           !==> nbondj = -1 au sud, 0 au milieu, 1 au nord, 2 si jpnj=1 
    2534            WRITE(narea+200,*)"nlejt_crs(jn) ",nlejt_crs(jn) ; call flush(narea+200) 
     2504           !WRITE(narea+200,*)"nlejt_crs(jn) ",nlejt_crs(jn) ; call flush(narea+200) 
    25352505           !!!noso== nbre de proc sud du proc sur lequel on tourne !!!! ; dangeureux car on est ds une boucle sur jn 
    25362506           IF( iprocso < 0 .AND. ibonjt(jn) == -1 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 
    25372507           SELECT CASE( ibonjt(jn) ) 
    25382508              CASE ( -1 ) 
    2539                 WRITE(narea+200,*)"MOD( jpjglo - njmppt(jn), nn_facty)",MOD( jpjglo - njmppt(jn), nn_facty) ; call flush(narea+200) 
     2509                !WRITE(narea+200,*)"MOD( jpjglo - njmppt(jn), nn_facty)",MOD( jpjglo - njmppt(jn), nn_facty) ; call flush(narea+200) 
    25402510                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1  ! au cas où il reste des lignes en bas 
    25412511                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
     
    25582528                 STOP 
    25592529           END SELECT 
    2560            WRITE(narea+200,*)"jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) " ; call flush(narea+200) 
    2561            WRITE(narea+200,*) jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
     2530           !WRITE(narea+200,*)"jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) " ; call flush(narea+200) 
     2531           !WRITE(narea+200,*) jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
    25622532           IF( nlcjt_crs(jn) > jpj_crs )THEN 
    25632533              jpj_crs = jpj_crs + 1 
     
    25722542              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) ) 
    25732543           ENDIF 
    2574            WRITE(narea+200,*)"tutu loc ",jn,jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
    2575            WRITE(narea+200,*)"tutu glo ",jn,jpj_crs, nldjt_crs(jn)+njmppt_crs(jn)-1,nlejt_crs(jn)+njmppt_crs(jn)-1,nlcjt_crs(jn)+njmppt_crs(jn)-1 ; call flush(narea+200) 
     2544           !WRITE(narea+200,*)"tutu loc ",jn,jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 
     2545           !WRITE(narea+200,*)"tutu glo ",jn,jpj_crs, nldjt_crs(jn)+njmppt_crs(jn)-1,nlejt_crs(jn)+njmppt_crs(jn)-1,nlcjt_crs(jn)+njmppt_crs(jn)-1 ; call flush(narea+200) 
    25762546 
    25772547 
     
    25832553              nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) 
    25842554           ELSE 
    2585               WRITE(narea+200,*)"njmppt  jn njmpptea(jn) ",nimppt(jn),nimpptea(jn); call flush(narea+200) 
    2586               WRITE(narea+200,*)"nlcit  (jn) nlcitea(jn) ) ",nlcit  (jn),nlcitea(jn); call flush(narea+200) 
     2555              !WRITE(narea+200,*)"njmppt  jn njmpptea(jn) ",nimppt(jn),nimpptea(jn); call flush(narea+200) 
     2556              !WRITE(narea+200,*)"nlcit  (jn) nlcitea(jn) ) ",nlcit  (jn),nlcitea(jn); call flush(narea+200) 
    25872557              nleit_crs(jn) = AINT( REAL( ( nimppt  (jn) - 1 + nlcit  (jn) )  / nn_factx, wp) ) & 
    25882558                 &          - AINT( REAL( ( nimpptea(jn) - 1 + nlcitea(jn) )  / nn_factx, wp) ) 
    25892559           ENDIF 
    2590            WRITE(narea+200,*)"nleji_crs(jn),noso ",nleit_crs(jn); call flush(narea+200) 
     2560           !WRITE(narea+200,*)"nleji_crs(jn),noso ",nleit_crs(jn); call flush(narea+200) 
    25912561 
    25922562 
     
    26112581                 STOP 
    26122582           END SELECT 
    2613            WRITE(narea+200,*)"jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ",jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 
     2583           !WRITE(narea+200,*)"jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ",jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 
    26142584           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 
    26152585 
    2616            WRITE(narea+200,*)"tutu loc ",jn,jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 
    2617            WRITE(narea+200,*)"tutu glo ",jn,jpi_crs, nldit_crs(jn)+nimppt_crs(jn)-1,nleit_crs(jn)+nimppt_crs(jn)-1,nlcit_crs(jn)+nimppt_crs(jn)-1 ; call flush(narea+200) 
     2586           !WRITE(narea+200,*)"tutu loc ",jn,jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 
     2587           !WRITE(narea+200,*)"tutu glo ",jn,jpi_crs, nldit_crs(jn)+nimppt_crs(jn)-1,nleit_crs(jn)+nimppt_crs(jn)-1,nlcit_crs(jn)+nimppt_crs(jn)-1 ; call flush(narea+200) 
    26182588 
    26192589           nfiimpp_crs(ii,ij) = nimppt_crs(jn) 
    2620            WRITE(narea+200,*)"tutu nimppt_crs(jn) ",ii,ij,nimppt_crs(jn) ; call flush(narea+200) 
     2590           !WRITE(narea+200,*)"tutu nimppt_crs(jn) ",ii,ij,nimppt_crs(jn) ; call flush(narea+200) 
    26212591           
    26222592        ENDDO 
     
    26282598              nfiimpp_crs(ji,jj) = iimppt_crs 
    26292599              IF( jn .GE. 1 )nimppt_crs(jn) = iimppt_crs 
    2630               PRINT*," nfiimpp_crs(ji,jj) ",ji,jj,jn,nfiimpp(ji,jj),nfiimpp_crs(ji,jj) 
     2600              !PRINT*," nfiimpp_crs(ji,jj) ",ji,jj,jn,nfiimpp(ji,jj),nfiimpp_crs(ji,jj) 
    26312601           ENDDO 
    26322602        ENDDO 
     
    26572627 
    26582628        !============================================================================================== 
    2659          write(narea+200,*)"jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1" ; call flush(narea+200) 
    2660          write(narea+200,*)jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 ; call flush(narea+200) 
    2661          write(narea+200,*)"jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1" ; call flush(narea+200) 
    2662          write(narea+200,*)jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 ; call flush(narea+200) 
    2663          write(narea+200,*)"nfsloop_crs nfeloop_crs ",nfsloop_crs,nfeloop_crs ; call flush(narea+200) 
     2629         !write(narea+200,*)"jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1" ; call flush(narea+200) 
     2630         !write(narea+200,*)jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 ; call flush(narea+200) 
     2631         !write(narea+200,*)"jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1" ; call flush(narea+200) 
     2632         !write(narea+200,*)jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 ; call flush(narea+200) 
     2633         !write(narea+200,*)"nfsloop_crs nfeloop_crs ",nfsloop_crs,nfeloop_crs ; call flush(narea+200) 
    26642634 
    26652635         ! No coarsening with zoom 
     
    26712641         DO ji = 1, jpi_crs 
    26722642            mig_crs(ji) = ji + nimpp_crs - 1 
    2673             WRITE(narea+200,*)"fifi ",ji,mig_crs(ji)  ; call flush(narea+200) 
     2643            !WRITE(narea+200,*)"fifi ",ji,mig_crs(ji)  ; call flush(narea+200) 
    26742644         ENDDO 
    26752645         DO jj = 1, jpj_crs 
    26762646            mjg_crs(jj) = jj + njmpp_crs - 1! 
    2677             WRITE(narea+200,*)"fufu ",jj,mjg_crs(jj)  ; call flush(narea+200) 
     2647            !WRITE(narea+200,*)"fufu ",jj,mjg_crs(jj)  ; call flush(narea+200) 
    26782648         ENDDO 
    26792649        
     
    26812651            mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 
    26822652            mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) ) 
    2683             WRITE(narea+200,*)"mi ",ji,mi0_crs(ji),mi1_crs(ji)  ; call flush(narea+200) 
     2653            !WRITE(narea+200,*)"mi ",ji,mi0_crs(ji),mi1_crs(ji)  ; call flush(narea+200) 
    26842654         ENDDO 
    26852655          
     
    26872657            mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 
    26882658            mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) ) 
    2689             WRITE(narea+200,*)"mj ",jj, mj0_crs(jj),mj1_crs(jj) ; call flush(narea+200) 
     2659            !WRITE(narea+200,*)"mj ",jj, mj0_crs(jj),mj1_crs(jj) ; call flush(narea+200) 
    26902660         ENDDO 
    26912661 
     
    28102780                mjs2_crs(jpjglo_crs-jj+2) = ijjs 
    28112781                mje2_crs(jpjglo_crs-jj+2) = ijje 
    2812                WRITE(narea+200,*)"jpjglo_crs-jj+2,ijje,ijjs ",jpjglo_crs-jj+2,ijjs,ijje ; call flush(narea+200) 
     2782               !WRITE(narea+200,*)"jpjglo_crs-jj+2,ijje,ijjs ",jpjglo_crs-jj+2,ijjs,ijje ; call flush(narea+200) 
    28132783            ENDDO 
    28142784 
     
    28712841        mje_crs(:) = mje2_crs(:)  
    28722842      ELSE 
    2873        write(narea+200,*)"njmpp ",njmpp 
     2843       !write(narea+200,*)"njmpp ",njmpp 
    28742844        DO jj = 1, nlej_crs 
    2875            write(narea+200,*)jj,"mjs2_crs mje2_crs ",mjg_crs(jj),mjs2_crs(mjg_crs(jj)),mje2_crs(mjg_crs(jj)) ; call flush(narea+200) 
     2845           !write(narea+200,*)jj,"mjs2_crs mje2_crs ",mjg_crs(jj),mjs2_crs(mjg_crs(jj)),mje2_crs(mjg_crs(jj)) ; call flush(narea+200) 
    28762846           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
    28772847           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
    2878            write(narea+200,*)"mjs_crs mje_crs ",mjs_crs(jj),mje_crs(jj) ; call flush(narea+200) 
     2848           !write(narea+200,*)"mjs_crs mje_crs ",mjs_crs(jj),mje_crs(jj) ; call flush(narea+200) 
    28792849        ENDDO 
    2880         write(narea+200,*)"nimpp ",nimpp 
     2850        !write(narea+200,*)"nimpp ",nimpp 
    28812851        DO ji = 1, nlei_crs 
    2882            write(narea+200,*)ji,"mis2_crs mie2_crs ",mig_crs(ji),mis2_crs(mig_crs(ji)),mie2_crs(mig_crs(ji)) ; call flush(narea+200) 
     2852           !write(narea+200,*)ji,"mis2_crs mie2_crs ",mig_crs(ji),mis2_crs(mig_crs(ji)),mie2_crs(mig_crs(ji)) ; call flush(narea+200) 
    28832853           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
    28842854           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
    2885            write(narea+200,*)"mis_crs mie_crs ",mis_crs(jj),mie_crs(jj) ; call flush(narea+200) 
     2855           !write(narea+200,*)"mis_crs mie_crs ",mis_crs(jj),mie_crs(jj) ; call flush(narea+200) 
    28862856        ENDDO 
    28872857      ENDIF 
    28882858      ! 
    2889       IF( nlcj_crs -1 .GT. nlej_crs )WRITE(narea+200,*)"tutututu",nlcj_crs,nlej_crs ; call flush(narea+200) 
     2859      !IF( nlcj_crs -1 .GT. nlej_crs )WRITE(narea+200,*)"tutututu",nlcj_crs,nlej_crs ; call flush(narea+200) 
    28902860      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1) 
    28912861      njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r4294 r5601  
    205205            CALL iom_rstput( 0, 0, inum4, 'e3u', e3u_crs )       
    206206            CALL iom_rstput( 0, 0, inum4, 'e3v', e3v_crs )       
     207            CALL iom_rstput( 0, 0, inum4, 'e3t_max_crs', e3t_max_crs )       
     208            CALL iom_rstput( 0, 0, inum4, 'e3w_max_crs', e3w_max_crs )       
    207209         ELSE 
    208210            DO jj = 1,jpj_crs    
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r5105 r5601  
    1717   USE zdf_oce         ! vertical  physics: ocean fields 
    1818   USE zdfddm          ! vertical  physics: double diffusion 
     19   USe zdfmxl 
    1920   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2021   USE in_out_manager  ! I/O manager 
     
    2526   USE crslbclnk 
    2627   USE iom 
     28   USE zdfmxl_crs 
    2729 
    2830   IMPLICIT NONE 
     
    6466      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 
    6567      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs  
     68      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d,z2d_crs 
    6669      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 
    6770      REAL(wp)       :: z2dcrsu, z2dcrsv 
     
    7174      INTEGER ::  iji,ijj 
    7275      !! 
    73        !!---------------------------------------------------------------------- 
    74       !  
    75       !IF(narea==267)WRITE(narea+5000,*)"========================================> crsfldt ",kt 
     76      !!---------------------------------------------------------------------- 
    7677 
    7778      IF( nn_timing == 1 )   CALL timing_start('crs_fld') 
     
    8081      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    8182      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    82       CALL wrk_alloc( jpi, jpj, jpk, zt, zs       ) 
     83      CALL wrk_alloc( jpi, jpj, jpk, zt, zs         ) 
     84      CALL wrk_alloc( jpi, jpj,      z2d            ) 
    8385      ! 
    8486      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     87      CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs     ) 
    8588 
    8689      ! Depth work arrrays 
     
    130133      zs(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
    131134      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(:,:,:) 
     135      tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:) 
    133136      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
    134137      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
    135       tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
     138      tsn_crs(:,:,:,jp_sal) = zs_crs(:,:,:) 
    136139 
    137140      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal 
     
    162165 
    163166      !  V-velocity 
    164       !IF(narea==267)WRITE(narea+5000,*)"deg vb_crs" 
    165167      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" 
    167168      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) 
    169169      vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:) 
    170170      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) 
    172171      !                                                                                  
    173172      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
     
    209208                  ! 
    210209                  !cbr 
    211                   ! 
    212210                  !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 ) 
    213211                  !bug2: mm test que bug1: on n'obtient tjs pas zero 
     
    215213                  !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810 
    216214                  !                   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)) 
    219215                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) 
    220216 
    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) 
    238217                  z2dcrsu =  ( ub_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) & 
    239218                     &     - ( ub_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) ) 
     
    251230 
    252231 
    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  
    262232      !  W-velocity 
    263233      IF( ln_crs_wn ) THEN 
     
    266236        wn_crs(:,:,jpk) = 0._wp 
    267237        DO jk = jpkm1, 1, -1 
    268            !cbr wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk) 
    269238           wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk) 
    270239           WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)  
     
    286255      ! 
    287256      CALL iom_put( "avt", avt_crs )   !  Kz 
    288        
     257      
     258      !deja dasn step CALL zdf_mxl_crs(kt) 
     259 
     260  
    289261      !  sbc fields   
    290262 
     
    303275      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    304276 
     277      z2d=REAL(nmln,wp) 
     278      CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     279      nmln_crs=INT(z2d_crs)  
     280      nmln_crs=MAX(nlb10,nmln_crs)     
     281 
    305282      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output  
    306283      CALL iom_put( "utau"     , utau_crs )   ! i-tau output  
     
    313290      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output  
    314291 
    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  
    426292      !  free memory 
    427293      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    428294      CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    429       CALL wrk_dealloc( jpi, jpj, jpk, zt, zs       ) 
     295      CALL wrk_dealloc( jpi, jpj, jpk, zt, zs         ) 
     296      CALL wrk_dealloc( jpi, jpj, z2d                 ) 
    430297      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     298      CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs     ) 
    431299      ! 
    432300      CALL iom_swap( "nemo" )     ! return back on high-resolution grid 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5105 r5601  
    2020   USE crslbclnk 
    2121   USE lib_mpp 
     22   USE ldftra_crs 
    2223 
    2324   IMPLICIT NONE 
     
    179180      CASE ( 0, 1, 4 )           ! mesh on the sphere 
    180181 
    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 
    182182         ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) ) 
    183183 
     
    206206     e1e3v_msk(:,:,:)=0._wp 
    207207     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    ) 
    208      WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1) 
    209208     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u ) 
    210209     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 
     
    212211     !cbr facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:) 
    213212     !cbr facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:) 
    214      WRITE(narea+200,*)'umask_crs ',SHAPE(umask_crs) 
    215      WRITE(narea+200,*)jpi,jpj,jpk 
    216      WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1) 
    217      CALL flush(narea+200) 
    218  
    219213     DO jk=1,jpk 
    220214        DO ji=1,jpi_crs 
     
    222216 
    223217              facsurfu(ji,jj,jk) = umask_crs(ji,jj,jk) * e2e3u_msk(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) 
     218              IF( e2e3u_crs(ji,jj,jk) .NE. 0._wp ) facsurfu(ji,jj,jk) = facsurfu(ji,jj,jk) / e2e3u_crs(ji,jj,jk) 
    232219 
    233220              facsurfv(ji,jj,jk) = vmask_crs(ji,jj,jk) * e1e3v_msk(ji,jj,jk)   
     
    264251 
    265252     !    3.d.3   Vertical depth (meters) 
     253     !cbr: il semblerait que p_e3=... ne soit pas utile ici !!!!!!!!! 
    266254     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t, psgn=1.0 )  
    267255     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w, psgn=1.0 ) 
     
    271259     ! 4.  Coarse grid ocean volume and averaging weights 
    272260     !--------------------------------------------------------- 
    273      ! 4.a. Ocean volume or area unmasked and masked 
    274261     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t ) 
    275262     ! 
     
    280267 
    281268     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w ) 
    282      ! 
    283      !--------------------------------------------------------- 
    284      ! 5.  Write out coarse meshmask  (see OPA_SRC/DOM/domwri.F90 for ideas later) 
     269 
     270 
     271     !--------------------------------------------------------- 
     272     ! 5.  Coarse grid ocean volume and averaging weights 
     273     !--------------------------------------------------------- 
     274     !CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     275     !CALL ldf_tra_crs_init 
     276     !CALL dom_grid_glo   ! Return to parent grid domain 
     277 
     278 
     279     ! 
     280     !--------------------------------------------------------- 
     281     ! 6.  Write out coarse meshmask  (see OPA_SRC/DOM/domwri.F90 for ideas later) 
    285282     !--------------------------------------------------------- 
    286283 
     
    300297     CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 
    301298 
     299      IF( nn_timing == 1 )  CALL timing_stop('crs_init') 
    302300 
    303301   END SUBROUTINE crs_init 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r4990 r5601  
    438438      ENDIF 
    439439 
    440       IF( nn_timing == 1 )   CALL timing_start('dia_fwb') 
     440      IF( nn_timing == 1 )   CALL timing_stop('dia_fwb') 
    441441 
    442442 9005 FORMAT(1X,A,ES24.16) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4990 r5601  
    143143 
    144144      IF( lk_vvl ) THEN 
    145          z3d(:,:,:) = tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) 
     145         z3d(:,:,:) = tsn(:,:,:,jp_tem) !cbr * fse3t_n(:,:,:) 
    146146         CALL iom_put( "toce" , z3d                        )   ! heat content 
    147147         DO jj = 1, jpj 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r4990 r5601  
    525525            ! 
    526526         ENDIF 
    527          IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry 
     527         IF( ln_zps .OR. ln_sco .OR. ln_zco )   THEN              ! zps or sco : read meter bathymetry 
    528528            CALL iom_open ( 'bathy_meter.nc', inum )  
    529529            CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r4686 r5601  
    629629            SELECT CASE ( cd_type) 
    630630            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    631                pt3dl(:, 1  ,jk) = 0.e0 
    632                pt3dl(:,ijpj,jk) = 0.e0 
     631               pt3dl(:, 1  ,:) = 0.e0 
     632               pt3dl(:,ijpj,:) = 0.e0 
    633633            CASE ( 'F' )                               ! F-point 
    634                pt3dl(:,ijpj,jk) = 0.e0 
     634               pt3dl(:,ijpj,:) = 0.e0 
    635635            END SELECT 
    636636            ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r5010 r5601  
    253253            DO ji = 2, jpni 
    254254               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci 
    255                !cbr  
    256                WRITE(narea+200,*)"iimppt",ji,jj,ilcit(ji-1,jj),nreci,iimppt(ji-1,jj),iimppt(ji,jj) 
    257255            END DO 
    258256         END DO 
     
    367365      nimpp  = nimppt(narea)   
    368366      njmpp  = njmppt(narea)   
    369       WRITE(narea+200,*)"jpi,jpj,nlci,nlcj,nldi,nldj,nlei,nlej" 
    370       WRITE(narea+200,*)jpi,jpj,nlci,nlcj,nldi,nldj,nlei,nlej ; call flush(narea+200) !cbr  
    371       WRITE(narea+200,*)"nldi+nimpp-1,nldj+njmpp-1,nlei+nimpp-1,nlej+njmpp-1" ; call flush(narea+200) !cbr 
    372       WRITE(narea+200,*)nldi+nimpp-1,nldj+njmpp-1,nlei+nimpp-1,nlej+njmpp-1 ; call flush(narea+200) !cbr 
    373367 
    374368     ! Save processor layout in layout.dat file  
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r5007 r5601  
    196196         ii = 1 + MOD(jarea-1,jpni) 
    197197         ij = 1 +    (jarea-1)/jpni 
    198          write(narea+200,*)"mppini_2  ====== > ",jarea,ii,ij 
    199198         ili = ilci(ii,ij) 
    200199         ilj = ilcj(ii,ij) 
     
    207206         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1 
    208207         IF( jpni            == 1 )   ibondi(ii,ij) =  2 
    209          write(narea+200,*)"titi",jarea,ii,ij,MOD(jarea,jpni),ibondi(ii,ij) ; call flush(narea+200) 
    210208         ! 2.4 Subdomain neighbors 
    211209 
    212210         iproc = jarea - 1 
    213211         ioso(ii,ij) = iproc - jpni 
    214          write(narea+200,*)"mppini_2 0: ",ii,ij,iproc,jpni,ioso(ii,ij) ; call flush(narea+200) 
    215212         iowe(ii,ij) = iproc - 1 
    216213         ioea(ii,ij) = iproc + 1 
     
    281278            ENDIF 
    282279         ENDIF 
    283          write(narea+200,*)"titi",jarea,ibondi(ii,ij) ; call flush(narea+200) 
    284280         ipolj(ii,ij) = 0 
    285281         IF( jperio == 3 .OR. jperio == 4 ) THEN 
     
    311307            ibonit(icont+1) = ibondi(ii,ij) 
    312308            ibonjt(icont+1) = ibondj(ii,ij) 
    313             write(narea+200,*)"titi 1 ",icont+1,ibonit(icont+1) ; call flush(narea+200) 
    314309         ENDIF 
    315310      END DO 
     
    424419      ii = iin(narea) 
    425420      ij = ijn(narea) 
    426       write(narea+200,*)"mppini_2 a ",noso,ii,ij,ioso(ii,ij),jpni*jpnj-1 ; call flush(narea+200) 
    427421      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN  
    428422         iiso = 1 + MOD(ioso(ii,ij),jpni) 
    429423         ijso = 1 +    (ioso(ii,ij))/jpni 
    430424         noso = ipproc(iiso,ijso) 
    431          write(narea+200,*)"mppini_2 b ",iiso,ijso,noso  ; call flush(narea+200) 
    432425      ELSE 
    433426         noso = -1 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r4990 r5601  
    3535   USE timing         ! Timing 
    3636   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     37   USE iom 
    3738 
    3839   IMPLICIT NONE 
     
    230231         END DO 
    231232         CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions 
     233 
    232234         ! 
    233235         !                                            !* horizontal Shapiro filter 
     
    445447 
    446448      ENDIF 
     449 
     450      CALL iom_put("zgru",zgru) 
     451      CALL iom_put("zgrv",zgrv) 
     452      CALL iom_put("zdzr",zdzr) 
     453      CALL iom_put("zwz",zwz) 
     454      CALL iom_put("zww",zww) 
     455      CALL iom_put("uslp",uslp) 
     456      CALL iom_put("vslp",vslp) 
    447457       
    448458      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90

    r5105 r5601  
    2121   !!   ldf_slp_init : initialization of the slopes computation 
    2222   !!---------------------------------------------------------------------- 
    23    USE oce             ! ocean dynamics and tracers 
    24  USE dom_oce         ! ocean space and time domain 
     23   !USE oce             ! ocean dynamics and tracers 
     24   !USE dom_oce         ! ocean space and time domain 
    2525   USE ldftra_oce      ! lateral diffusion: traceur 
    2626   USE ldfdyn_oce      ! lateral diffusion: dynamics 
     
    3434   USE timing          ! Timing 
    3535   USE crs 
     36   USE iom 
    3637 
    3738   IMPLICIT NONE 
     
    4546   !                                                                             !! Madec operator 
    4647   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp_crs, wslpi_crs          !: i_slope at U- and W-points 
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp_crs, wslpj_crs          !: j-slope at V- and W-points 
    4948   !                                                                !! Griffies operator 
    5049   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells 
     
    113112      !!---------------------------------------------------------------------- 
    114113      ! 
    115       IF( nn_timing == 1 )  CALL timing_start('ldf_slp') 
     114      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_crs') 
    116115      ! 
    117116      CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zwz, zww, zdzr, zgru, zgrv ) 
     
    126125      ! 
    127126      DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    128          DO jj = 1, jpjm1 
    129             DO ji = 1, fs_jpim1   ! vector opt. 
     127         DO jj = 1, jpj_crsm1 
     128            DO ji = 1, jpi_crsm1   ! vector opt. 
    130129               zgru(ji,jj,jk) = umask_crs(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
    131130               zgrv(ji,jj,jk) = vmask_crs(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
     
    134133      END DO 
    135134      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    136 # if defined key_vectopt_loop 
    137          DO jj = 1, 1 
    138             DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    139 # else 
    140          DO jj = 1, jpjm1 
    141             DO ji = 1, jpim1 
    142 # endif 
     135         DO jj = 1, jpj_crsm1 
     136            DO ji = 1, jpi_crsm1 
    143137               zgru(ji,jj,mbku_crs(ji,jj)) = gru_crs(ji,jj) 
    144138               zgrv(ji,jj,mbkv_crs(ji,jj)) = grv_crs(ji,jj) 
     
    146140         END DO 
    147141      ENDIF 
    148 !WRITE(numout,*) ' zgrv (ji,jj,jk-1)' , zgrv (:,:,:) 
    149 !WRITE(numout,*) ' grv_crs (ji,jj,jk-1)'  ,grv_crs (:,:) 
    150142      ! 
    151143      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    152144      DO jk = 2, jpkm1 
    153145         !                               !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0 
    154          !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1 
    155          !                                    ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    156          !                             !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
    157          !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
     146         !                               !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1 
     147         !                               ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
     148         !                               !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
     149         !                               ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
    158150         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
    159151            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask_crs(:,:,jk+1) ) 
     
    163155      CALL ldf_slp_mxl_crs( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml 
    164156 
    165  
    166157      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd ) 
    167158      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
    168159      ! 
    169160      DO jk = 2, jpkm1                            !* Slopes at u and v points 
    170          DO jj = 2, jpjm1 
    171             DO ji = fs_2, fs_jpim1   ! vector opt. 
     161         DO jj = 2, jpj_crsm1 
     162            DO ji = 2, jpi_crsm1   ! vector opt. 
    172163               !                                      ! horizontal and vertical density gradient at u- and v-points 
    173164               zau = zgru(ji,jj,jk) / e1u_crs(ji,jj) 
     
    177168               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    178169               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    179      !IF( umask_crs(ji,jj,jk) .NE. 0._wp .AND. e3u_max_crs(ji,jj,jk)==0._wp )WRITE(narea+3000,*)"bug zbu ",umask_crs(ji,jj,jk),e3u_max_crs(ji,jj,jk) ; CALL flush(narea+3000) 
    180      !IF( e3u_max_crs(ji,jj,jk)==0._wp )WRITE(narea+3000,*)"bug zbu1 ",ji,jj,jk,umask_crs(ji,jj,jk),e3u_max_crs(ji,jj,jk) ; CALL flush(narea+3000) 
    181170               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,jk)* ABS( zau )  ) 
    182171               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,jk)* ABS( zav )  ) 
    183                    
    184 !cc               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_crs(ji,jj,jk)* ABS( zau )  ) 
    185 !cc               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_crs(ji,jj,jk)* ABS( zav )  ) 
    186  
    187  
     172               !cc zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_crs(ji,jj,jk)* ABS( zau )  ) 
     173               !cc zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_crs(ji,jj,jk)* ABS( zav )  ) 
    188174               !                                      ! uslp and vslp output in zwz and zww, resp. 
    189175               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
     
    210196      END DO 
    211197      CALL crs_lbc_lnk( zwz, 'U', -1. )   ;   CALL crs_lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions 
     198      CALL iom_put("zwz_crs",zwz) 
     199      CALL iom_put("zww_crs",zww) 
    212200      ! 
    213201      !                                            !* horizontal Shapiro filter 
    214202      DO jk = 2, jpkm1 
    215          DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    216             DO ji = 2, jpim1 
     203         DO jj = 2, jpj_crsm1, MAX(1, jpj_crs-3)                        ! rows jj=2 and =jpjm1 only 
     204            DO ji = 2, jpi_crsm1 
    217205               uslp_crs(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
    218206                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
     
    227215            END DO 
    228216         END DO 
    229          DO jj = 3, jpj-2                               ! other rows 
    230             DO ji = fs_2, fs_jpim1   ! vector opt. 
     217         DO jj = 3, jpj_crs-2                               ! other rows 
     218            DO ji = 2, jpi_crsm1   ! vector opt. 
    231219               uslp_crs(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
    232220                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
     
    242230         END DO 
    243231         !                                        !* decrease along coastal boundaries 
    244          DO jj = 2, jpjm1 
    245             DO ji = fs_2, fs_jpim1   ! vector opt. 
     232         DO jj = 2, jpj_crsm1 
     233            DO ji = 2, jpi_crsm1   ! vector opt. 
    246234               uslp_crs(ji,jj,jk) = uslp_crs(ji,jj,jk) * ( umask_crs(ji,jj+1,jk) + umask_crs(ji,jj-1,jk  ) ) * 0.5_wp   & 
    247235                  &                            * ( umask_crs(ji,jj  ,jk) + umask_crs(ji,jj  ,jk+1) ) * 0.5_wp 
     
    257245      ! 
    258246      DO jk = 2, jpkm1 
    259          DO jj = 2, jpjm1 
    260             DO ji = fs_2, fs_jpim1   ! vector opt. 
     247         DO jj = 2, jpj_crsm1 
     248            DO ji = 2, jpi_crsm1   ! vector opt. 
    261249               !                                  !* Local vertical density gradient evaluated from N^2 
    262250               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 
     
    281269               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk) 
    282270               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask_crs(ji,jj,jk) 
    283 !WRITE(numout,*) ' wslpiml(ji,jj)' , wslpiml(ji,jj) 
    284 !WRITE(numout,*) ' zbj' , zbj 
    285 !WRITE(numout,*) ' zeps' , zeps 
    286 !WRITE(numout,*) ' zaj' , zaj 
    287  
    288  
    289271!!gm  modif to suppress omlmask....  (as in Griffies operator) 
    290272!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0. 
     
    301283      !                                           !* horizontal Shapiro filter 
    302284      DO jk = 2, jpkm1 
    303          DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    304             DO ji = 2, jpim1 
     285         DO jj = 2, jpj_crsm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     286            DO ji = 2, jpi_crsm1 
    305287               zcofw = tmask_crs(ji,jj,jk) * z1_16 
    306288               wslpi_crs(ji,jj,jk) = (      zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
     
    317299            END DO 
    318300         END DO 
    319          DO jj = 3, jpj-2                               ! other rows 
    320             DO ji = fs_2, fs_jpim1   ! vector opt. 
     301         DO jj = 3, jpj_crs-2                               ! other rows 
     302            DO ji = 2, jpi_crsm1   ! vector opt. 
    321303               zcofw = tmask_crs(ji,jj,jk) * z1_16 
    322304               wslpi_crs(ji,jj,jk) = (      zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
     
    334316         END DO 
    335317         !                                        !* decrease along coastal boundaries 
    336          DO jj = 2, jpjm1 
    337             DO ji = fs_2, fs_jpim1   ! vector opt. 
     318         DO jj = 2, jpj_crsm1 
     319            DO ji = 2, jpi_crsm1   ! vector opt. 
    338320               zck =   ( umask_crs(ji,jj,jk) + umask_crs(ji-1,jj,jk) )   & 
    339321                  &  * ( vmask_crs(ji,jj,jk) + vmask_crs(ji,jj-1,jk) ) * 0.25 
     
    344326      END DO 
    345327 
    346       ! III.  Specific grid points 
    347       ! =========================== 
    348  !! cc     ! 
    349  !     IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area 
    350  !        !                                                    ! Gibraltar Strait 
    351  !        ij0 =  50   ;   ij1 =  53 
    352  !        ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    353  !        ij0 =  51   ;   ij1 =  53 
    354  !        ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    355  !        ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    356  !        ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    357  !        ! 
    358  !        !                                                    ! Mediterrannean Sea 
    359  !        ij0 =  49   ;   ij1 =  56 
    360  !        ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    361  !        ij0 =  50   ;   ij1 =  56 
    362  !        ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    363  !        ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    364  !        ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    365  !     ENDIF 
    366 !! cc 
    367  
    368328      ! IV. Lateral boundary conditions 
    369329      ! =============================== 
    370       CALL crs_lbc_lnk( uslp_crs , 'U', -1. )      ;      CALL crs_lbc_lnk( vslp_crs , 'V', -1. ) 
     330      CALL crs_lbc_lnk( uslp_crs , 'U', -1. )       
     331      CALL crs_lbc_lnk( vslp_crs , 'V', -1. ) 
    371332      CALL crs_lbc_lnk( wslpi_crs, 'W', -1. )      ;      CALL crs_lbc_lnk( wslpj_crs, 'W', -1. ) 
    372 !WRITE(numout,*) ' zww' , zww(:,:,:) 
    373 !WRITE(numout,*) ' wslpj_crs' , wslpj_crs(:,:,:) 
    374   !    IF(ln_ctl) THEN 
    375   !       CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
    376   !      CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
    377   !    ENDIF 
    378       ! 
    379       CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    380       ! 
    381       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp') 
     333      ! 
     334      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid 
     335      CALL iom_put("zgru_crs",zgru) 
     336      CALL iom_put("zgrv_crs",zgrv) 
     337      CALL iom_put("zdzr_crs",zdzr) 
     338      CALL iom_put("zwz_crs",zwz) 
     339      CALL iom_put("zww_crs",zww) 
     340      CALL iom_put("uslp_crs",uslp_crs) 
     341      CALL iom_put("vslp_crs",vslp_crs) 
     342      CALL iom_swap( "nemo" )    ! swap on the coarse grid 
     343      ! 
     344      CALL wrk_dealloc( jpi_crs,jpj_crs,jpk, zwz, zww, zdzr, zgru, zgrv ) 
     345      ! 
     346      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_crs') 
    382347      ! 
    383348   END SUBROUTINE ldf_slp_crs 
    384  
    385  
    386    SUBROUTINE ldf_slp_grif_crs ( kt ) 
    387       !!---------------------------------------------------------------------- 
    388       !!                 ***  ROUTINE ldf_slp_grif  *** 
    389       !! 
    390       !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope 
    391       !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T) 
    392       !!      at W-points using the Griffies quarter-cells. 
    393       !! 
    394       !! ** Method  :   calculates alpha and beta at T-points 
    395       !! 
    396       !! ** Action : - triadi_g, triadj_g   T-pts i- and j-slope triads relative to geopot. (used for eiv) 
    397       !!             - triadi , triadj    T-pts i- and j-slope triads relative to model-coordinate 
    398       !!             - wslp2              squared slope of neutral surfaces at w-points. 
    399       !!---------------------------------------------------------------------- 
    400       INTEGER, INTENT( in ) ::   kt             ! ocean time-step index 
    401       !! 
    402       INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
    403       INTEGER  ::   iku, ikv                    ! local integer 
    404       REAL(wp) ::   zfacti, zfactj              ! local scalars 
    405       REAL(wp) ::   znot_thru_surface           ! local scalars 
    406       REAL(wp) ::   zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj 
    407       REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim 
    408       REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 
    409       REAL(wp) ::   zdzrho_raw 
    410       REAL(wp) ::   zbeta0 
    411       REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw 
    412       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet 
    413       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
    414       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
    415       !!---------------------------------------------------------------------- 
    416       ! 
    417       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_grif') 
    418       ! 
    419       CALL wrk_alloc( jpi,jpj, z1_mlbw ) 
    420       CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 
    421       CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    422       CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    423       ! 
    424       !--------------------------------! 
    425       !  Some preliminary calculation  ! 
    426       !--------------------------------! 
    427       ! 
    428       CALL eos_alpbet_crs( tsb_crs, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==! 
    429       ! 
    430       DO jl = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
    431          ! 
    432          ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln) 
    433          DO jk = 1, jpkm1                     ! done each pair of triad 
    434             DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set 
    435                DO ji = 1, fs_jpim1            ! vector opt. 
    436                   zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point 
    437                   zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    438                   zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point 
    439                   zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    440                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    441                   zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
    442                   zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    443                   zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    444                END DO 
    445             END DO 
    446          END DO 
    447          ! 
    448          IF( ln_zps.and.l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    449 # if defined key_vectopt_loop 
    450             DO jj = 1, 1 
    451                DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling) 
    452 # else 
    453             DO jj = 1, jpjm1 
    454                DO ji = 1, jpim1 
    455 # endif 
    456                   iku  = mbku_crs(ji,jj)          ;   ikv  = mbkv_crs(ji,jj)             ! last ocean level (u- & v-points) 
    457                   zdit = gtsu_crs(ji,jj,jp_tem)   ;   zdjt = gtsv_crs(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
    458                   zdis = gtsu_crs(ji,jj,jp_sal)   ;   zdjs = gtsv_crs(ji,jj,jp_sal)      ! i- & j-gradient of Salinity 
    459                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    460                   zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
    461                   zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    462                   zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    463                END DO 
    464             END DO 
    465          ENDIF 
    466          ! 
    467       END DO 
    468  
    469       DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
    470          DO jk = 1, jpkm1                     ! done each pair of triad 
    471             DO jj = 1, jpj                    ! NB: not masked ==>  a minimum value is set 
    472                DO ji = 1, jpi                 ! vector opt. 
    473                   IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp 
    474                      zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) ) 
    475                      zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) ) 
    476                   ELSE 
    477                      zdkt = 0._wp                                             ! 1st level gradient set to zero 
    478                      zdks = 0._wp 
    479                   ENDIF 
    480                   zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
    481                   zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln 
    482                  END DO 
    483             END DO 
    484          END DO 
    485       END DO 
    486       ! 
    487       DO jj = 1, jpj                          !==  Reciprocal depth of the w-point below ML base  ==! 
    488          DO ji = 1, jpi 
    489             jk = MIN( nmln_crs(ji,jj), mbkt_crs(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth 
    490             z1_mlbw(ji,jj) = 1._wp / gdepw_crs(ji,jj,jk) 
    491          END DO 
    492       END DO 
    493       ! 
    494       !                                       !==  intialisations to zero  ==! 
    495       ! 
    496       wslp2  (:,:,:)     = 0._wp              ! wslp2 will be cumulated 3D field set to zero 
    497       triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero 
    498       triadj_g(:,:,1,:,:) = 0._wp   ;   triadj_g(:,:,jpk,:,:) = 0._wp 
    499       !!gm _iso set to zero missing 
    500       triadi  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero 
    501       triadj  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp 
    502  
    503       !-------------------------------------! 
    504       !  Triads just below the Mixed Layer  ! 
    505       !-------------------------------------! 
    506       ! 
    507       DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 
    508          DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED 
    509             DO jj = 1, jpjm1 
    510                DO ji = 1, fs_jpim1 
    511                   ip = jl   ;   jp = jl 
    512                   jk = MIN( nmln_crs(ji+ip,jj) , mbkt_crs(ji+ip,jj) ) + 1         ! ML level+1 (MIN in case ML depth is the ocean depth) 
    513                   ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    514                   zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    515                      &      - ( gdept_crs(ji+1,jj,jk-kp) - gdept_crs(ji,jj,jk-kp) ) / e1u_crs(ji,jj)  ) * umask_crs(ji,jj,jk) 
    516                   jk = MIN( nmln_crs(ji,jj+jp) , mbkt_crs(ji,jj+jp) ) + 1 
    517                   ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
    518                      &      - ( gdept_crs(ji,jj+1,jk-kp) - gdept_crs(ji,jj,jk-kp) ) / e2v_crs(ji,jj)  ) * vmask_crs(ji,jj,jk) 
    519                   zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
    520                   ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
    521                END DO 
    522             END DO 
    523          END DO 
    524       END DO 
    525  
    526       !-------------------------------------! 
    527       !  Triads with surface limits         ! 
    528       !-------------------------------------! 
    529       ! 
    530       DO kp = 0, 1                            ! k-index of triads 
    531          DO jl = 0, 1 
    532             ip = jl   ;   jp = jl             ! i- and j-indices of triads (i-k and j-k planes) 
    533             DO jk = 1, jpkm1 
    534                ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 
    535                znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0 
    536                DO jj = 1, jpjm1 
    537                   DO ji = 1, fs_jpim1         ! vector opt. 
    538                      ! 
    539                      ! Calculate slope relative to geopotentials used for GM skew fluxes 
    540                      ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    541                      ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point 
    542                      ! masked by umask taken at the level of dz(rho) 
    543                      ! 
    544                      ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti) 
    545                      ! 
    546                      zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked 
    547                      ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp) 
    548  
    549                      ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
    550                      zti_coord = znot_thru_surface * ( gdept_crs(ji+1,jj  ,jk) - gdept_crs(ji,jj,jk) ) / e1u_crs(ji,jj) 
    551                      ztj_coord = znot_thru_surface * ( gdept_crs(ji  ,jj+1,jk) - gdept_crs(ji,jj,jk) ) / e2v_crs(ji,jj)                  ! unmasked 
    552                      zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
    553                      ztj_g_raw = ztj_raw - ztj_coord 
    554                      zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
    555                      ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
    556                      ! 
    557                      ! Below  ML use limited zti_g as is & mask 
    558                      ! Inside ML replace by linearly reducing sx_mlb towards surface & mask 
    559                      ! 
    560                      zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln_crs(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1 
    561                      zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln_crs(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1 
    562                      !                                                          !                   otherwise  zfact=0 
    563                      zti_g_lim =          ( zfacti   * zti_g_lim                       & 
    564                         &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   & 
    565                         &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask_crs(ji,jj,jk+kp) 
    566                      ztj_g_lim =          ( zfactj   * ztj_g_lim                       & 
    567                         &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   & 
    568                         &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask_crs(ji,jj,jk+kp) 
    569                      ! 
    570                      triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim 
    571                      triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim 
    572                      ! 
    573                      ! Get coefficients of isoneutral diffusion tensor 
    574                      ! 1. Utilise gradients *relative* to s-coordinate, so add t-point slopes (*subtract* depth gradients) 
    575                      ! 2. We require that isoneutral diffusion  gives no vertical buoyancy flux 
    576                      !     i.e. 33 term = (real slope* 31, 13 terms) 
    577                      ! To do this, retain limited sx**2  in vertical flux, but divide by real slope for 13/31 terms 
    578                      ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2 
    579                      ! 
    580                      zti_lim  = ( zti_g_lim + zti_coord ) * umask_crs(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces 
    581                      ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask_crs(ji,jj,jk+kp) 
    582                      ! 
    583                      IF( ln_triad_iso ) THEN 
    584                         zti_raw = zti_lim**2 / zti_raw 
    585                         ztj_raw = ztj_lim**2 / ztj_raw 
    586                         zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw ) 
    587                         ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw ) 
    588                         zti_lim =           zfacti   * zti_lim                       & 
    589                         &      + ( 1._wp - zfacti ) * zti_raw 
    590                         ztj_lim =           zfactj   * ztj_lim                       & 
    591                         &      + ( 1._wp - zfactj ) * ztj_raw 
    592                      ENDIF 
    593                      triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim 
    594                      triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim 
    595                     ! 
    596                      zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   ) 
    597                      zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   ) 
    598                      zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 
    599                      zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 
    600                      ! 
    601                      !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked 
    602                      wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked 
    603                      wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2 
    604                   END DO 
    605                END DO 
    606             END DO 
    607          END DO 
    608       END DO 
    609       ! 
    610       wslp2(:,:,1) = 0._wp                ! force the surface wslp to zero 
    611  
    612       CALL crs_lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    613       ! 
    614       CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 
    615       CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 
    616       CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    617       CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    618       ! 
    619       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_grif') 
    620       ! 
    621    END SUBROUTINE ldf_slp_grif_crs 
    622  
    623349 
    624350   SUBROUTINE ldf_slp_mxl_crs( prd, pn2, p_gru, p_grv, p_dzr ) 
     
    657383      zm1_2g = -0.5_wp / grav 
    658384      ! 
    659       uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp 
    660       vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp 
    661       wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp 
    662       wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp 
     385      uslpml (1,:) = 0._wp      ;      uslpml (jpi_crs,:) = 0._wp 
     386      vslpml (1,:) = 0._wp      ;      vslpml (jpi_crs,:) = 0._wp 
     387      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi_crs,:) = 0._wp 
     388      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi_crs,:) = 0._wp 
    663389      ! 
    664390      !                                            !==   surface mixed layer mask   ! 
    665391      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    666 # if defined key_vectopt_loop 
    667          DO jj = 1, 1 
    668             DO ji = 1, jpij                        ! vector opt. (forced unrolling) 
    669 # else 
    670          DO jj = 1, jpj 
    671             DO ji = 1, jpi 
    672 # endif 
     392         DO jj = 1, jpj_crs 
     393            DO ji = 1, jpi_crs 
    673394               ik = nmln_crs(ji,jj) - 1 
    674395               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp 
     
    690411      !----------------------------------------------------------------------- 
    691412      ! 
    692 # if defined key_vectopt_loop 
    693       DO jj = 1, 1 
    694          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    695 # else 
    696       DO jj = 2, jpjm1 
    697          DO ji = 2, jpim1 
    698 # endif 
     413      DO jj = 2, jpj_crsm1 
     414         DO ji = 2, jpi_crsm1 
    699415            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==! 
    700416            ! 
     
    744460      ! 
    745461      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_mxl') 
    746  !     WRITE(numout,*) ' uslp_crs' , MAXVAL(uslp_crs(:,:,:)) , MINVAL(uslp_crs(:,:,:)) 
    747  !     WRITE(numout,*) ' vslp_crs' , vslp_crs 
    748  !     WRITE(numout,*) ' uslpml' , uslpml 
    749  !     WRITE(numout,*) ' vslpml' , vslpml 
    750  !     WRITE(numout,*) ' wslpiml' , wslpiml 
    751  !     WRITE(numout,*) ' wslpjml' , wslpjml 
    752   !    WRITE(numout,*) ' wslpi_crs' , wslpi_crs(:,:,2) 
    753   !    WRITE(numout,*) ' wslpj_crs_mxl' , wslpj_crs(:,:,:) 
    754        
    755462      ! 
    756463   END SUBROUTINE ldf_slp_mxl_crs 
     
    774481      IF(lwp) THEN 
    775482         WRITE(numout,*) 
    776          WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing' 
     483         WRITE(numout,*) 'ldf_slp_init_crs : direction of lateral mixing' 
    777484         WRITE(numout,*) '~~~~~~~~~~~~' 
    778485      ENDIF 
    779486 
    780487      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes 
    781          ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 
    782          ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr ) 
     488         ALLOCATE( triadi_g(jpi_crs,jpj_crs,jpk,0:1,0:1) , triadj_g(jpi_crs,jpj_crs,jpk,0:1,0:1) , wslp2(jpi_crs,jpj_crs,jpk) , STAT=ierr ) 
     489         ALLOCATE( triadi  (jpi_crs,jpj_crs,jpk,0:1,0:1) , triadj  (jpi_crs,jpj_crs,jpk,0:1,0:1)                      , STAT=ierr ) 
    783490         IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 
    784491         ! 
     
    786493         ! 
    787494      ELSE                             ! Madec operator : slopes at u-, v-, and w-points 
    788          ALLOCATE( uslp_crs(jpi,jpj,jpk) , vslp_crs(jpi,jpj,jpk) , wslpi_crs(jpi,jpj,jpk) , wslpj_crs(jpi,jpj,jpk) ,  & 
    789             &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr ) 
     495         ALLOCATE( uslp_crs(jpi_crs,jpj_crs,jpk) , vslp_crs(jpi_crs,jpj_crs,jpk) , wslpi_crs(jpi_crs,jpj_crs,jpk) , wslpj_crs(jpi_crs,jpj_crs,jpk) ,  & 
     496            &   omlmask(jpi_crs,jpj_crs,jpk) , uslpml(jpi_crs,jpj_crs)   , vslpml(jpi_crs,jpj_crs)    , wslpiml(jpi_crs,jpj_crs)   , wslpjml(jpi_crs,jpj_crs) , STAT=ierr ) 
    790497         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 
    791498 
     
    807514            ! set the slope of diffusion to the slope of s-surfaces 
    808515            !      ( c a u t i o n : minus sign as fsdep has positive value ) 
    809             !WRITE(narea+3000,*)"ldfslp ",MINVAL(gdept_crs),MAXVAL(gdept_crs)  ; call flush(narea+3000) 
    810             !WRITE(narea+3000,*)"ldfslp ",MINVAL(vmask_crs),MAXVAL(vmask_crs)  ; call flush(narea+3000) 
    811             !WRITE(narea+3000,*)"ldfslp ",MINVAL(e2v_crs),MAXVAL(e2v_crs) ; call flush(narea+3000) 
    812516            DO jk = 1, jpk 
    813                DO jj = 2, jpjm1 
    814                   DO ji = fs_2, fs_jpim1   ! vector opt. 
     517               DO jj = 2, jpj_crsm1 
     518                  DO ji = 2, jpi_crsm1   ! vector opt. 
    815519                  !cbr uslp_crs (ji,jj,jk) = -1./e1u_crs(ji,jj) * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk) 
    816520                  !vslp_crs (ji,jj,jk) = -1./e2v_crs(ji,jj) * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk) 
     
    832536         ENDIF 
    833537      ENDIF 
    834   !    WRITE(numout,*) ' wslpi_crs' , wslpi_crs 
    835538      ! 
    836539      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init') 
     
    849552      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) 
    850553   END SUBROUTINE ldf_slp_crs 
     554   SUBROUTINE ldf_slp_init_crs              ! Dummy routine 
     555   END SUBROUTINE ldf_slp_init_crs 
     556#endif 
     557 
    851558   SUBROUTINE ldf_slp_grif_crs( kt )        ! Dummy routine 
    852559      INTEGER, INTENT(in) :: kt 
    853560      WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt 
    854561   END SUBROUTINE ldf_slp_grif_crs 
    855    SUBROUTINE ldf_slp_init_crs              ! Dummy routine 
    856    END SUBROUTINE ldf_slp_init_crs 
    857 #endif 
    858562 
    859563   !!====================================================================== 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2_crs.F90

    r5105 r5601  
    1515   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d 
    1616   !!             -   ! 2003-08  (G. Madec)  F90, free form 
    17    !!            3.0  ! 2006-08  (G. Madec)  add tfreez function 
     17   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function (now eos_fzp function) 
    1818   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    19    !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp 
     19   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add alpha/beta used in ldfslp 
     20   !!            3.7  ! 2012-03  (F. Roquet, G. Madec)  add primitive of alpha and beta used in PE computation 
     21   !!             -   ! 2012-05  (F. Roquet)  add Vallis and original JM95 equation of state 
     22   !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module 
     23   !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80 
    2024   !!---------------------------------------------------------------------- 
    2125 
     
    2327   !!   eos            : generic interface of the equation of state 
    2428   !!   eos_insitu     : Compute the in situ density 
    25    !!   eos_insitu_pot : Compute the insitu and surface referenced potential 
    26    !!                    volumic mass 
     29   !!   eos_insitu_pot : Compute the insitu and surface referenced potential volumic mass 
    2730   !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
    28    !!   eos_bn2        : Compute the Brunt-Vaisala frequency 
    29    !!   eos_alpbet     : calculates the in situ thermal/haline expansion ratio 
    30    !!   tfreez         : Compute the surface freezing temperature 
     31   !!   bn2            : Compute the Brunt-Vaisala frequency 
     32   !!   eos_rab        : generic interface of in situ thermal/haline expansion ratio  
     33   !!   eos_rab_3d     : compute in situ thermal/haline expansion ratio 
     34   !!   eos_rab_2d     : compute in situ thermal/haline expansion ratio for 2d fields 
     35   !!   eos_fzp_2d     : freezing temperature for 2d fields 
     36   !!   eos_fzp_0d     : freezing temperature for scalar 
    3137   !!   eos_init       : set eos parameters (namelist) 
    3238   !!---------------------------------------------------------------------- 
    33    USE dom_oce         ! ocean space and time domain 
     39   USE crs         ! ocean space and time domain 
    3440   USE phycst          ! physical constants 
    35    USE zdfddm          ! vertical physics: double diffusion 
    36    USE in_out_manager  ! I/O manager 
    37    USE lib_mpp         ! MPP library 
     41   ! 
     42   !USE in_out_manager  ! I/O manager 
     43   !USE lib_mpp         ! MPP library 
     44   !USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3845   USE prtctl          ! Print control 
    3946   USE wrk_nemo        ! Memory Allocation 
     47   USE crslbclnk         ! ocean lateral boundary conditions 
    4048   USE timing          ! Timing 
    41    USE crs 
    4249 
    4350   IMPLICIT NONE 
     
    4653   !                   !! * Interface 
    4754   INTERFACE eos_crs 
    48       MODULE PROCEDURE eos_insitu_crs, eos_insitu_pot_crs, eos_insitu_2d_crs 
     55      MODULE PROCEDURE eos_insitu_pot , eos_insitu_2d 
    4956   END INTERFACE 
    50    INTERFACE bn2_crs 
    51       MODULE PROCEDURE eos_bn2_crs 
     57   ! 
     58   INTERFACE eos_rab_crs 
     59      MODULE PROCEDURE rab_crs_3d, rab_crs_2d, rab_crs_0d 
    5260   END INTERFACE 
    53  
     61   ! 
    5462   PUBLIC   eos_crs        ! called by step, istate, tranpc and zpsgrd modules 
     63   PUBLIC   bn2_crs        ! called by step module 
     64   PUBLIC   eos_rab_crs    ! called by ldfslp, zdfddm, trabbl 
    5565   PUBLIC   eos_init_crs   ! called by istate module 
    56    PUBLIC   bn2_crs        ! called by step module 
    57    PUBLIC   eos_alpbet_crs ! called by ldfslp module 
    58    PUBLIC   tfreez_crs     ! called by sbcice_... modules 
    5966 
    6067   !                                          !!* Namelist (nameos) * 
    6168   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    62    REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4_wp !: thermal expension coeff. (linear equation of state) 
    63    REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4_wp !: saline  expension coeff. (linear equation of state) 
    64  
    65    REAL(wp), PUBLIC ::   ralpbet_crs              !: alpha / beta ratio 
     69   LOGICAL , PUBLIC ::   ln_useCT  = .FALSE.  ! determine if eos_pt_from_ct is used to compute sst_m 
     70 
     71   !                                   !!!  simplified eos coefficients 
     72   ! default value: Vallis 2006 
     73   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff.  
     74   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff.  
     75   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2         
     76   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2         
     77   REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T   
     78   REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S   
     79   REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt   
     80    
     81   ! TEOS10/EOS80 parameters 
     82   REAL(wp) ::   r1_S0, r1_T0, r1_Z0, rdeltaS 
     83    
     84   ! EOS parameters 
     85   REAL(wp) ::   EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600 
     86   REAL(wp) ::   EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510 
     87   REAL(wp) ::   EOS020 , EOS120 , EOS220 , EOS320 , EOS420 
     88   REAL(wp) ::   EOS030 , EOS130 , EOS230 , EOS330 
     89   REAL(wp) ::   EOS040 , EOS140 , EOS240 
     90   REAL(wp) ::   EOS050 , EOS150 
     91   REAL(wp) ::   EOS060 
     92   REAL(wp) ::   EOS001 , EOS101 , EOS201 , EOS301 , EOS401 
     93   REAL(wp) ::   EOS011 , EOS111 , EOS211 , EOS311 
     94   REAL(wp) ::   EOS021 , EOS121 , EOS221 
     95   REAL(wp) ::   EOS031 , EOS131 
     96   REAL(wp) ::   EOS041 
     97   REAL(wp) ::   EOS002 , EOS102 , EOS202 
     98   REAL(wp) ::   EOS012 , EOS112 
     99   REAL(wp) ::   EOS022 
     100   REAL(wp) ::   EOS003 , EOS103 
     101   REAL(wp) ::   EOS013  
     102    
     103   ! ALPHA parameters 
     104   REAL(wp) ::   ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500 
     105   REAL(wp) ::   ALP010 , ALP110 , ALP210 , ALP310 , ALP410 
     106   REAL(wp) ::   ALP020 , ALP120 , ALP220 , ALP320 
     107   REAL(wp) ::   ALP030 , ALP130 , ALP230 
     108   REAL(wp) ::   ALP040 , ALP140 
     109   REAL(wp) ::   ALP050 
     110   REAL(wp) ::   ALP001 , ALP101 , ALP201 , ALP301 
     111   REAL(wp) ::   ALP011 , ALP111 , ALP211 
     112   REAL(wp) ::   ALP021 , ALP121 
     113   REAL(wp) ::   ALP031 
     114   REAL(wp) ::   ALP002 , ALP102 
     115   REAL(wp) ::   ALP012 
     116   REAL(wp) ::   ALP003 
     117    
     118   ! BETA parameters 
     119   REAL(wp) ::   BET000 , BET100 , BET200 , BET300 , BET400 , BET500 
     120   REAL(wp) ::   BET010 , BET110 , BET210 , BET310 , BET410 
     121   REAL(wp) ::   BET020 , BET120 , BET220 , BET320 
     122   REAL(wp) ::   BET030 , BET130 , BET230 
     123   REAL(wp) ::   BET040 , BET140 
     124   REAL(wp) ::   BET050 
     125   REAL(wp) ::   BET001 , BET101 , BET201 , BET301 
     126   REAL(wp) ::   BET011 , BET111 , BET211 
     127   REAL(wp) ::   BET021 , BET121 
     128   REAL(wp) ::   BET031 
     129   REAL(wp) ::   BET002 , BET102 
     130   REAL(wp) ::   BET012 
     131   REAL(wp) ::   BET003 
     132 
     133   ! PEN parameters 
     134   REAL(wp) ::   PEN000 , PEN100 , PEN200 , PEN300 , PEN400 
     135   REAL(wp) ::   PEN010 , PEN110 , PEN210 , PEN310 
     136   REAL(wp) ::   PEN020 , PEN120 , PEN220 
     137   REAL(wp) ::   PEN030 , PEN130 
     138   REAL(wp) ::   PEN040 
     139   REAL(wp) ::   PEN001 , PEN101 , PEN201 
     140   REAL(wp) ::   PEN011 , PEN111 
     141   REAL(wp) ::   PEN021 
     142   REAL(wp) ::   PEN002 , PEN102 
     143   REAL(wp) ::   PEN012 
     144    
     145   ! ALPHA_PEN parameters 
     146   REAL(wp) ::   APE000 , APE100 , APE200 , APE300 
     147   REAL(wp) ::   APE010 , APE110 , APE210 
     148   REAL(wp) ::   APE020 , APE120 
     149   REAL(wp) ::   APE030 
     150   REAL(wp) ::   APE001 , APE101 
     151   REAL(wp) ::   APE011 
     152   REAL(wp) ::   APE002 
     153 
     154   ! BETA_PEN parameters 
     155   REAL(wp) ::   BPE000 , BPE100 , BPE200 , BPE300 
     156   REAL(wp) ::   BPE010 , BPE110 , BPE210 
     157   REAL(wp) ::   BPE020 , BPE120 
     158   REAL(wp) ::   BPE030 
     159   REAL(wp) ::   BPE001 , BPE101 
     160   REAL(wp) ::   BPE011 
     161   REAL(wp) ::   BPE002 
    66162 
    67163   !! * Substitutions 
     
    69165#  include "vectopt_loop_substitute.h90" 
    70166   !!---------------------------------------------------------------------- 
    71    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    72    !! $Id: eosbn2.F90 3294 2012-01-28 16:44:18Z rblod $ 
     167   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     168   !! $Id: eosbn2.F90 4990 2014-12-15 16:42:49Z timgraham $ 
    73169   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    74170   !!---------------------------------------------------------------------- 
    75171CONTAINS 
    76172 
    77    SUBROUTINE eos_insitu_crs( pts, prd ) 
    78       !!---------------------------------------------------------------------- 
    79       !!                   ***  ROUTINE eos_insitu  *** 
    80       !! 
    81       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
    82       !!       potential temperature and salinity using an equation of state 
    83       !!       defined through the namelist parameter nn_eos. 
    84       !! 
    85       !! ** Method  :   3 cases: 
    86       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    87       !!         the in situ density is computed directly as a function of 
    88       !!         potential temperature relative to the surface (the opa t 
    89       !!         variable), salt and pressure (assuming no pressure variation 
    90       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    91       !!         is approximated by the depth in meters. 
    92       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    93       !!         with pressure                      p        decibars 
    94       !!              potential temperature         t        deg celsius 
    95       !!              salinity                      s        psu 
    96       !!              reference volumic mass        rau0     kg/m**3 
    97       !!              in situ volumic mass          rho      kg/m**3 
    98       !!              in situ density anomalie      prd      no units 
    99       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    100       !!          t = 40 deg celcius, s=40 psu 
    101       !!      nn_eos = 1 : linear equation of state function of temperature only 
    102       !!              prd(t) = 0.0285 - rn_alpha * t 
    103       !!      nn_eos = 2 : linear equation of state function of temperature and 
    104       !!               salinity 
    105       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    106       !!      Note that no boundary condition problem occurs in this routine 
    107       !!      as pts are defined over the whole domain. 
    108       !! 
    109       !! ** Action  :   compute prd , the in situ density (no units) 
    110       !! 
    111       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    112       !!---------------------------------------------------------------------- 
    113       !! 
    114       REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    115       !                                                      ! 2 : salinity               [psu] 
    116       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
    117       !! 
    118       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    119       REAL(wp) ::   zt , zs , zh , zsr   ! local scalars 
    120       REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      - 
    121       REAL(wp) ::   zrhop, ze, zbw, zb   !   -      - 
    122       REAL(wp) ::   zd , zc , zaw, za    !   -      - 
    123       REAL(wp) ::   zb1, za1, zkw, zk0   !   -      - 
    124       REAL(wp) ::   zrau0r               !   -      - 
    125       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    126       !!---------------------------------------------------------------------- 
    127  
    128       ! 
    129       IF( nn_timing == 1 ) CALL timing_start('eos') 
    130       ! 
    131       CALL wrk_alloc( jpi, jpj, jpk, zws ) 
    132       ! 
    133       SELECT CASE( nn_eos ) 
    134       ! 
    135       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    136          zrau0r = 1.e0 / rau0 
    137 !CDIR NOVERRCHK 
    138          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
    139          ! 
    140          DO jk = 1, jpkm1 
    141             DO jj = 1, jpj 
    142                DO ji = 1, jpi 
    143                   zt = pts   (ji,jj,jk,jp_tem) 
    144                   zs = pts   (ji,jj,jk,jp_sal) 
    145                   zh = gdept_crs(ji,jj,jk)        ! depth 
    146                   zsr= zws   (ji,jj,jk)        ! square root salinity 
    147                   ! 
    148                   ! compute volumic mass pure water at atm pressure 
    149                   zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   & 
    150                      &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp 
    151                   ! seawater volumic mass atm pressure 
    152                   zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        & 
    153                      &                      -4.0899e-3_wp ) *zt+0.824493_wp 
    154                   zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp 
    155                   zr4= 4.8314e-4_wp 
    156                   ! 
    157                   ! potential volumic mass (reference to the surface) 
    158                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    159                   ! 
    160                   ! add the compression terms 
    161                   ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    162                   zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    163                   zb = zbw + ze * zs 
    164                   ! 
    165                   zd = -2.042967e-2_wp 
    166                   zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    167                   zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 
    168                   za = ( zd*zsr + zc ) *zs + zaw 
    169                   ! 
    170                   zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp 
    171                   za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp 
    172                   zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 
    173                   zk0= ( zb1*zsr + za1 )*zs + zkw 
    174                   ! 
    175                   ! masked in situ density anomaly 
    176                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    177                      &             - rau0  ) * zrau0r * tmask_crs(ji,jj,jk) 
    178                END DO 
    179             END DO 
    180          END DO 
    181          ! 
    182       CASE( 1 )                !==  Linear formulation function of temperature only  ==! 
    183          DO jk = 1, jpkm1 
    184             prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask_crs(:,:,jk) 
    185          END DO 
    186          ! 
    187       CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==! 
    188          DO jk = 1, jpkm1 
    189             prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask_crs(:,:,jk) 
    190          END DO 
    191          ! 
    192       END SELECT 
    193       ! 
    194     !  IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk ) 
    195       ! 
    196       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    197       ! 
    198       IF( nn_timing == 1 ) CALL timing_stop('eos') 
    199       ! 
    200    END SUBROUTINE eos_insitu_crs 
    201  
    202  
    203    SUBROUTINE eos_insitu_pot_crs( pts, prd, prhop ) 
     173   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
    204174      !!---------------------------------------------------------------------- 
    205175      !!                  ***  ROUTINE eos_insitu_pot  *** 
     
    210180      !!     namelist parameter nn_eos. 
    211181      !! 
    212       !! ** Method  : 
    213       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    214       !!         the in situ density is computed directly as a function of 
    215       !!         potential temperature relative to the surface (the opa t 
    216       !!         variable), salt and pressure (assuming no pressure variation 
    217       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    218       !!         is approximated by the depth in meters. 
    219       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    220       !!              rhop(t,s)  = rho(t,s,0) 
    221       !!         with pressure                      p        decibars 
    222       !!              potential temperature         t        deg celsius 
    223       !!              salinity                      s        psu 
    224       !!              reference volumic mass        rau0     kg/m**3 
    225       !!              in situ volumic mass          rho      kg/m**3 
    226       !!              in situ density anomalie      prd      no units 
    227       !! 
    228       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    229       !!          t = 40 deg celcius, s=40 psu 
    230       !! 
    231       !!      nn_eos = 1 : linear equation of state function of temperature only 
    232       !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t 
    233       !!              rhop(t,s)  = rho(t,s) 
    234       !! 
    235       !!      nn_eos = 2 : linear equation of state function of temperature and 
    236       !!               salinity 
    237       !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0 
    238       !!                       = rn_beta * s - rn_alpha * tn - 1. 
    239       !!              rhop(t,s)  = rho(t,s) 
    240       !!      Note that no boundary condition problem occurs in this routine 
    241       !!      as (tn,sn) or (ta,sa) are defined over the whole domain. 
    242       !! 
    243182      !! ** Action  : - prd  , the in situ density (no units) 
    244183      !!              - prhop, the potential volumic mass (Kg/m3) 
    245184      !! 
    246       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    247       !!                Brown and Campana, Mon. Weather Rev., 1978 
    248       !!---------------------------------------------------------------------- 
    249       !! 
    250       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
     185      !!---------------------------------------------------------------------- 
     186      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
    251187      !                                                                ! 2 : salinity               [psu] 
    252       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    253       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    254       ! 
    255       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    256       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars 
    257       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      - 
    258       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    259       !!---------------------------------------------------------------------- 
    260       ! 
    261       IF( nn_timing == 1 ) CALL timing_start('eos-p') 
    262       ! 
    263       CALL wrk_alloc( jpi, jpj, jpk, zws ) 
     188      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
     189      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     190      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
     191      ! 
     192      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     193      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     194      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     195      !!---------------------------------------------------------------------- 
     196      ! 
     197      IF( nn_timing == 1 )   CALL timing_start('eos-pot_crs') 
    264198      ! 
    265199      SELECT CASE ( nn_eos ) 
    266200      ! 
    267       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    268          zrau0r = 1.e0 / rau0 
    269 !CDIR NOVERRCHK 
    270          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     201      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    271202         ! 
    272203         DO jk = 1, jpkm1 
    273             DO jj = 1, jpj 
    274                DO ji = 1, jpi 
    275                   zt = pts   (ji,jj,jk,jp_tem) 
    276                   zs = pts   (ji,jj,jk,jp_sal) 
    277                   zh = gdept_crs(ji,jj,jk)        ! depth 
    278                   zsr= zws   (ji,jj,jk)        ! square root salinity 
    279                   ! 
    280                   ! compute volumic mass pure water at atm pressure 
    281                   zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   & 
    282                      &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 
    283                   ! seawater volumic mass atm pressure 
    284                   zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   & 
    285                      &                                         -4.0899e-3_wp ) *zt+0.824493_wp 
    286                   zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp 
    287                   zr4= 4.8314e-4_wp 
    288                   ! 
    289                   ! potential volumic mass (reference to the surface) 
    290                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    291                   ! 
    292                   ! save potential volumic mass 
    293                   prhop(ji,jj,jk) = zrhop * tmask_crs(ji,jj,jk) 
    294                   ! 
    295                   ! add the compression terms 
    296                   ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    297                   zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    298                   zb = zbw + ze * zs 
    299                   ! 
    300                   zd = -2.042967e-2_wp 
    301                   zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    302                   zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 
    303                   za = ( zd*zsr + zc ) *zs + zaw 
    304                   ! 
    305                   zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp 
    306                   za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp 
    307                   zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 
    308                   zk0= ( zb1*zsr + za1 )*zs + zkw 
    309                   ! 
    310                   ! masked in situ density anomaly 
    311                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    312                      &             - rau0  ) * zrau0r * tmask_crs(ji,jj,jk) 
     204            DO jj = 1, jpj_crs 
     205               DO ji = 1, jpi_crs 
     206                  ! 
     207                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     208                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     209                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     210                  ztm = tmask_crs(ji,jj,jk)                                     ! tmask 
     211                  ! 
     212                  zn3 = EOS013*zt   & 
     213                     &   + EOS103*zs+EOS003 
     214                     ! 
     215                  zn2 = (EOS022*zt   & 
     216                     &   + EOS112*zs+EOS012)*zt   & 
     217                     &   + (EOS202*zs+EOS102)*zs+EOS002 
     218                     ! 
     219                  zn1 = (((EOS041*zt   & 
     220                     &   + EOS131*zs+EOS031)*zt   & 
     221                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     222                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     223                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     224                     ! 
     225                  zn0 = (((((EOS060*zt   & 
     226                     &   + EOS150*zs+EOS050)*zt   & 
     227                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     228                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     229                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     230                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     231                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     232                     ! 
     233                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     234                  ! 
     235                  prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     236                  ! 
     237                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    313238               END DO 
    314239            END DO 
    315240         END DO 
    316241         ! 
    317       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
     242      CASE( 1 )                !==  simplified EOS  ==! 
     243         ! 
    318244         DO jk = 1, jpkm1 
    319             prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask_crs(:,:,jk) 
    320             prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask_crs(:,:,jk) 
     245            DO jj = 1, jpj_crs 
     246               DO ji = 1, jpi_crs 
     247                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     248                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     249                  zh  = pdep (ji,jj,jk) 
     250                  ztm = tmask_crs(ji,jj,jk) 
     251                  !                                                     ! potential density referenced at the surface 
     252                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     253                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     254                     &  - rn_nu * zt * zs 
     255                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 
     256                  !                                                     ! density anomaly (masked) 
     257                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
     258                  prd(ji,jj,jk) = zn * r1_rau0 * ztm 
     259                  ! 
     260               END DO 
     261            END DO 
    321262         END DO 
    322263         ! 
    323       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    324          DO jk = 1, jpkm1 
    325             prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask_crs(:,:,jk) 
    326             prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask_crs(:,:,jk) 
    327          END DO 
    328          ! 
    329264      END SELECT 
    330265      ! 
    331    !   IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    332       ! 
    333       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    334       ! 
    335       IF( nn_timing == 1 ) CALL timing_stop('eos-p') 
    336       ! 
    337    END SUBROUTINE eos_insitu_pot_crs 
    338  
    339  
    340    SUBROUTINE eos_insitu_2d_crs( pts, pdep, prd ) 
     266      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     267      ! 
     268      IF( nn_timing == 1 )   CALL timing_stop('eos-pot_crs') 
     269      ! 
     270   END SUBROUTINE eos_insitu_pot 
     271 
     272   SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
    341273      !!---------------------------------------------------------------------- 
    342274      !!                  ***  ROUTINE eos_insitu_2d  *** 
     
    346278      !!      defined through the namelist parameter nn_eos. * 2D field case 
    347279      !! 
    348       !! ** Method : 
    349       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    350       !!         the in situ density is computed directly as a function of 
    351       !!         potential temperature relative to the surface (the opa t 
    352       !!         variable), salt and pressure (assuming no pressure variation 
    353       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    354       !!         is approximated by the depth in meters. 
    355       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    356       !!         with pressure                      p        decibars 
    357       !!              potential temperature         t        deg celsius 
    358       !!              salinity                      s        psu 
    359       !!              reference volumic mass        rau0     kg/m**3 
    360       !!              in situ volumic mass          rho      kg/m**3 
    361       !!              in situ density anomalie      prd      no units 
    362       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    363       !!          t = 40 deg celcius, s=40 psu 
    364       !!      nn_eos = 1 : linear equation of state function of temperature only 
    365       !!              prd(t) = 0.0285 - rn_alpha * t 
    366       !!      nn_eos = 2 : linear equation of state function of temperature and 
    367       !!               salinity 
    368       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    369       !!      Note that no boundary condition problem occurs in this routine 
    370       !!      as pts are defined over the whole domain. 
    371       !! 
    372       !! ** Action  : - prd , the in situ density (no units) 
    373       !! 
    374       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    375       !!---------------------------------------------------------------------- 
    376       !! 
    377       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     280      !! ** Action  : - prd , the in situ density (no units) (unmasked) 
     281      !! 
     282      !!---------------------------------------------------------------------- 
     283      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    378284      !                                                           ! 2 : salinity               [psu] 
    379       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m] 
    380       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
    381       !! 
    382       INTEGER  ::   ji, jj                    ! dummy loop indices 
    383       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    384       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         - 
    385       REAL(wp), POINTER, DIMENSION(:,:) :: zws 
    386       !!---------------------------------------------------------------------- 
    387       ! 
    388 !WRITE(numout,*) ' pts1 ' ,  pts(:,:,1) 
    389 !WRITE(numout,*) ' pts2 ' ,  pts(:,:,2) 
    390 !WRITE(numout,*) ' jpi ' ,  jpi 
    391 !WRITE(numout,*) ' fs_jpim1 ' ,  fs_jpim1 
    392 !WRITE(numout,*) ' dim ' ,  size(pts,1) 
    393       IF( nn_timing == 1 ) CALL timing_start('eos2d') 
    394       ! 
    395       CALL wrk_alloc( jpi, jpj, zws ) 
    396       ! 
    397  
     285      REAL(wp), DIMENSION(jpi_crs,jpj_crs)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
     286      REAL(wp), DIMENSION(jpi_crs,jpj_crs)     , INTENT(  out) ::   prd   ! in situ density 
     287      ! 
     288      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     289      REAL(wp) ::   zt , zh , zs              ! local scalars 
     290      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     291      !!---------------------------------------------------------------------- 
     292      ! 
     293      IF( nn_timing == 1 )   CALL timing_start('eos2d') 
     294      ! 
    398295      prd(:,:) = 0._wp 
    399  
     296      ! 
    400297      SELECT CASE( nn_eos ) 
    401298      ! 
    402       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    403       ! 
    404 !CDIR NOVERRCHK 
    405          DO jj = 1, jpjm1 
    406 !CDIR NOVERRCHK 
    407             DO ji = 1, fs_jpim1   ! vector opt. 
    408                zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 
     299      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     300         ! 
     301         DO jj = 1, jpj_crsm1 
     302            DO ji = 1, jpi_crsm1   ! vector opt. 
     303               ! 
     304               zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     305               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     306               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     307               ! 
     308               zn3 = EOS013*zt   & 
     309                  &   + EOS103*zs+EOS003 
     310                  ! 
     311               zn2 = (EOS022*zt   & 
     312                  &   + EOS112*zs+EOS012)*zt   & 
     313                  &   + (EOS202*zs+EOS102)*zs+EOS002 
     314                  ! 
     315               zn1 = (((EOS041*zt   & 
     316                  &   + EOS131*zs+EOS031)*zt   & 
     317                  &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     318                  &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     319                  &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     320                  ! 
     321               zn0 = (((((EOS060*zt   & 
     322                  &   + EOS150*zs+EOS050)*zt   & 
     323                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     324                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     325                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     326                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     327                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     328                  ! 
     329               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     330               ! 
     331               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly 
     332               ! 
    409333            END DO 
    410334         END DO 
    411          DO jj = 1, jpjm1 
    412             DO ji = 1, fs_jpim1   ! vector opt. 
    413                zmask = tmask_crs(ji,jj,1)          ! land/sea bottom mask = surf. mask 
    414                zt    = pts  (ji,jj,jp_tem)            ! interpolated T 
    415                zs    = pts  (ji,jj,jp_sal)            ! interpolated S 
    416                zsr   = zws  (ji,jj)            ! square root of interpolated S 
    417                zh    = pdep (ji,jj)            ! depth at the partial step level 
    418                ! 
    419                ! compute volumic mass pure water at atm pressure 
    420                zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   & 
    421                   &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 
    422                ! seawater volumic mass atm pressure 
    423                zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   & 
    424                   &                                   -4.0899e-3_wp ) *zt+0.824493_wp 
    425                zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp 
    426                zr4 = 4.8314e-4_wp 
    427                ! 
    428                ! potential volumic mass (reference to the surface) 
    429                zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    430                ! 
    431                ! add the compression terms 
    432                ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    433                zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    434                zb = zbw + ze * zs 
    435                ! 
    436                zd =    -2.042967e-2_wp 
    437                zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    438                zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp 
    439                za = ( zd*zsr + zc ) *zs + zaw 
    440                ! 
    441                zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp 
    442                za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp 
    443                zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   & 
    444                   &                             +2098.925_wp ) *zt+190925.6_wp 
    445                zk0= ( zb1*zsr + za1 )*zs + zkw 
    446                ! 
    447                ! masked in situ density anomaly 
    448                prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask 
     335         ! 
     336         CALL crs_lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions 
     337         ! 
     338      CASE( 1 )                !==  simplified EOS  ==! 
     339         ! 
     340         DO jj = 1, jpj_crsm1 
     341            DO ji = 1, jpi_crsm1   ! vector opt. 
     342               ! 
     343               zt    = pts  (ji,jj,jp_tem)  - 10._wp 
     344               zs    = pts  (ji,jj,jp_sal)  - 35._wp 
     345               zh    = pdep (ji,jj)                         ! depth at the partial step level 
     346               ! 
     347               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     348                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     349                  &  - rn_nu * zt * zs 
     350                  ! 
     351               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly 
     352               ! 
    449353            END DO 
    450354         END DO 
    451355         ! 
    452       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    453          DO jj = 1, jpjm1 
    454             DO ji = 1, fs_jpim1   ! vector opt. 
    455                prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_crs(ji,jj,1) 
    456             END DO 
    457          END DO 
    458          ! 
    459       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    460          DO jj = 1, jpjm1 
    461             DO ji = 1, fs_jpim1   ! vector opt. 
    462                prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_crs(ji,jj,1) 
    463             END DO 
    464          END DO 
     356         CALL crs_lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions 
    465357         ! 
    466358      END SELECT 
    467 !WRITE(numout,*) ' prd ' ,  prd(:,:) 
    468 !WRITE(numout,*) ' zws ' ,  zws(:,:) 
    469 !WRITE(numout,*) ' pdep ' ,  pdep(:,:) 
    470  
    471  
    472  
    473 !     IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    474       ! 
    475       CALL wrk_dealloc( jpi, jpj, zws ) 
    476       ! 
    477       IF( nn_timing == 1 ) CALL timing_stop('eos2d') 
    478       ! 
    479    END SUBROUTINE eos_insitu_2d_crs 
    480  
    481  
    482    SUBROUTINE eos_bn2_crs( pts, pn2 ) 
    483       !!---------------------------------------------------------------------- 
    484       !!                  ***  ROUTINE eos_bn2  *** 
    485       !! 
    486       !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time- 
    487       !!      step of the input arguments 
    488       !! 
    489       !! ** Method : 
    490       !!       * nn_eos = 0  : UNESCO sea water properties 
    491       !!         The brunt-vaisala frequency is computed using the polynomial 
    492       !!      polynomial expression of McDougall (1987): 
    493       !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w 
    494       !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is 
    495       !!      computed and used in zdfddm module : 
    496       !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 
    497       !!       * nn_eos = 1  : linear equation of state (temperature only) 
    498       !!            N^2 = grav * rn_alpha * dk[ t ]/e3w 
    499       !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
    500       !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 
    501       !!      The use of potential density to compute N^2 introduces e r r o r 
    502       !!      in the sign of N^2 at great depths. We recommand the use of 
    503       !!      nn_eos = 0, except for academical studies. 
    504       !!        Macro-tasked on horizontal slab (jk-loop) 
    505       !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr 
    506       !!      and is never used at this level. 
    507       !! 
    508       !! ** Action  : - pn2 : the brunt-vaisala frequency 
    509       !! 
    510       !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 
    511       !!---------------------------------------------------------------------- 
    512       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    513       !                                                               ! 2 : salinity               [psu] 
    514       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1] 
    515       !! 
    516       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    517       REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars 
    518 #if defined key_zdfddm 
    519       REAL(wp) ::   zds   ! local scalars 
    520 #endif 
    521       !!---------------------------------------------------------------------- 
    522  
    523       ! 
    524       IF( nn_timing == 1 ) CALL timing_start('bn2') 
    525       ! 
    526       ! pn2 : interior points only (2=< jk =< jpkm1 ) 
    527       ! -------------------------- 
    528       ! 
    529       SELECT CASE( nn_eos ) 
    530       ! 
    531       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    532          DO jk = 2, jpkm1 
    533             DO jj = 1, jpj 
    534                DO ji = 1, jpi 
    535                   zgde3w = grav / e3w_max_crs(ji,jj,jk) 
    536                   zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt 
    537                   zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt 
    538                   zh = gdepw_crs(ji,jj,jk)                                                ! depth in meters  at w-point 
    539                   ! 
    540                   zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta 
    541                      &                                  - 0.203814e-03_wp ) * zt   & 
    542                      &                                  + 0.170907e-01_wp ) * zt   & 
    543                      &   +         0.665157e-01_wp                                 & 
    544                      &   +     ( - 0.678662e-05_wp * zs                            & 
    545                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
    546                      &   +   ( ( - 0.302285e-13_wp * zh                            & 
    547                      &           - 0.251520e-11_wp * zs                            & 
    548                      &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
    549                      &           - 0.164759e-06_wp * zs                            & 
    550                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
    551                      &                                  + 0.380374e-04_wp ) * zh 
     359      ! 
     360      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
     361      ! 
     362      IF( nn_timing == 1 )   CALL timing_stop('eos2d') 
     363      ! 
     364   END SUBROUTINE eos_insitu_2d 
     365 
     366   SUBROUTINE rab_crs_3d( pts, pab ) 
     367      !!---------------------------------------------------------------------- 
     368      !!                 ***  ROUTINE rab_3d  *** 
     369      !! 
     370      !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points 
     371      !! 
     372      !! ** Method  :   calculates alpha / beta at T-points 
     373      !! 
     374      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     375      !!---------------------------------------------------------------------- 
     376      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     377      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     378      ! 
     379      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     380      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     381      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     382      !!---------------------------------------------------------------------- 
     383      ! 
     384      IF( nn_timing == 1 )   CALL timing_start('rab_3d') 
     385      ! 
     386      SELECT CASE ( nn_eos ) 
     387      ! 
     388      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     389         ! 
     390         DO jk = 1, jpkm1 
     391            DO jj = 1, jpj_crs 
     392               DO ji = 1, jpi_crs 
     393                  ! 
     394                  zh  = gdept_crs(ji,jj,jk) * r1_Z0                                ! depth 
     395                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     396                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     397                  ztm = tmask_crs(ji,jj,jk)                                         ! tmask 
     398                  ! 
     399                  ! alpha 
     400                  zn3 = ALP003 
     401                  ! 
     402                  zn2 = ALP012*zt + ALP102*zs+ALP002 
     403                  ! 
     404                  zn1 = ((ALP031*zt   & 
     405                     &   + ALP121*zs+ALP021)*zt   & 
     406                     &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     407                     &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
    552408                     ! 
    553                   zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta 
    554                      &                               - 0.301985e-05_wp ) * zt      & 
    555                      &   +       0.785567e-03_wp                                   & 
    556                      &   + (     0.515032e-08_wp * zs                              & 
    557                      &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     & 
    558                      &   + ( (   0.121551e-17_wp * zh                              & 
    559                      &         - 0.602281e-15_wp * zs                              & 
    560                      &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     & 
    561                      &                                + 0.408195e-10_wp   * zs     & 
    562                      &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     & 
    563                      &                                - 0.121555e-07_wp ) * zh 
     409                  zn0 = ((((ALP050*zt   & 
     410                     &   + ALP140*zs+ALP040)*zt   & 
     411                     &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     412                     &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     413                     &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     414                     &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
    564415                     ! 
    565                   !cbr zgde3w: divide by 0 
    566                   !pn2(ji,jj,jk) = zgde3w * zbeta * tmask_crs(ji,jj,jk)           &   ! N^2 
    567                   !   &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   & 
    568                   !   &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) 
    569                   pn2(ji,jj,jk) = zbeta * tmask_crs(ji,jj,jk)           &   ! N^2 
    570                      &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   & 
    571                      &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) 
    572                   IF( e3w_max_crs(ji,jj,jk) .NE. 0._wp ) pn2(ji,jj,jk) = zgde3w * e3w_max_crs(ji,jj,jk) 
    573  
    574 #if defined key_zdfddm 
    575                   !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!! 
    576                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s]) 
    577                   IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 
    578                   rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 
    579 #endif 
     416                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     417                  ! 
     418                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 
     419                  ! 
     420                  ! beta 
     421                  zn3 = BET003 
     422                  ! 
     423                  zn2 = BET012*zt + BET102*zs+BET002 
     424                  ! 
     425                  zn1 = ((BET031*zt   & 
     426                     &   + BET121*zs+BET021)*zt   & 
     427                     &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     428                     &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     429                     ! 
     430                  zn0 = ((((BET050*zt   & 
     431                     &   + BET140*zs+BET040)*zt   & 
     432                     &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     433                     &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     434                     &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     435                     &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     436                     ! 
     437                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     438                  ! 
     439                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm 
     440                  ! 
    580441               END DO 
    581442            END DO 
    582443         END DO 
    583444         ! 
    584       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    585          DO jk = 2, jpkm1 
    586             pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / e3w_max_crs(:,:,jk) * tmask_crs(:,:,jk) 
    587          END DO 
    588          ! 
    589       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    590          DO jk = 2, jpkm1 
    591             !cbr: bug divide by 0. 
    592             !pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      & 
    593             !   &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   & 
    594             !   &               / e3w_max_crs(:,:,jk) * tmask_crs(:,:,jk) 
    595             pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      & 
    596                &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   & 
    597                &               * tmask_crs(:,:,jk) 
    598             DO jj = 1, jpj 
    599                DO ji = 1, jpi 
    600                   IF( e3w_max_crs(ji,jj,jk) .NE. 0._wp ) pn2(ji,jj,jk) = pn2(ji,jj,jk) / e3w_max_crs(ji,jj,jk) 
    601                ENDDO 
    602             ENDDO 
    603          END DO 
    604 #if defined key_zdfddm 
    605          DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 
    606             DO jj = 1, jpj 
    607                DO ji = 1, jpi 
    608                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 
    609                   IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp 
    610                   rrau(ji,jj,jk) = ralpbet_crs * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 
     445      CASE( 1 )                  !==  simplified EOS  ==! 
     446         ! 
     447         DO jk = 1, jpkm1 
     448            DO jj = 1, jpj_crs 
     449               DO ji = 1, jpi_crs 
     450                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     451                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     452                  zh  = gdept_crs(ji,jj,jk)                 ! depth in meters at t-point 
     453                  ztm = tmask_crs(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
     454                  ! 
     455                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     456                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha 
     457                  ! 
     458                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     459                  pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta 
     460                  ! 
    611461               END DO 
    612462            END DO 
    613463         END DO 
    614 #endif 
    615       END SELECT 
    616  
    617   !    IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
    618 #if defined key_zdfddm 
    619   !    IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk ) 
    620 #endif 
    621       ! 
    622       IF( nn_timing == 1 ) CALL timing_stop('bn2') 
    623       ! 
    624    END SUBROUTINE eos_bn2_crs 
    625  
    626  
    627    SUBROUTINE eos_alpbet_crs( pts, palpbet, beta0 ) 
    628       !!---------------------------------------------------------------------- 
    629       !!                 ***  ROUTINE eos_alpbet  *** 
    630       !! 
    631       !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points 
    632       !! 
    633       !! ** Method  :   calculates alpha / beta ratio at T-points 
    634       !!       * nn_eos = 0  : UNESCO sea water properties 
    635       !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial 
    636       !!                       polynomial expression of McDougall (1987). 
    637       !!                       Scalar beta0 is returned = 1. 
    638       !!       * nn_eos = 1  : linear equation of state (temperature only) 
    639       !!                       The ratio is undefined, so we return alpha as palpbet 
    640       !!                       Scalar beta0 is returned = 0. 
    641       !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
    642       !!                       The alpha/beta ratio is returned as ralpbet 
    643       !!                       Scalar beta0 is returned = 1. 
    644       !! 
    645       !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points 
    646       !!            :   beta0   : 1. or 0. 
    647       !!---------------------------------------------------------------------- 
    648       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity 
    649       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio 
    650       REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T) 
    651       !! 
    652       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    653       REAL(wp) ::   zt, zs, zh   ! local scalars 
    654       !!---------------------------------------------------------------------- 
    655       ! 
    656       IF( nn_timing == 1 ) CALL timing_start('eos_alpbet') 
    657       ! 
    658       SELECT CASE ( nn_eos ) 
    659       ! 
    660       CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    661          DO jk = 1, jpk 
    662             DO jj = 1, jpj 
    663                DO ji = 1, jpi 
    664                   zt = pts(ji,jj,jk,jp_tem)           ! potential temperature 
    665                   zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35) 
    666                   zh = fsdept(ji,jj,jk)               ! depth in meters 
    667                   ! 
    668                   palpbet(ji,jj,jk) =                                              & 
    669                      &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   & 
    670                      &                                  - 0.203814e-03_wp ) * zt   & 
    671                      &                                  + 0.170907e-01_wp ) * zt   & 
    672                      &   + 0.665157e-01_wp                                         & 
    673                      &   +     ( - 0.678662e-05_wp * zs                            & 
    674                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
    675                      &   +   ( ( - 0.302285e-13_wp * zh                            & 
    676                      &           - 0.251520e-11_wp * zs                            & 
    677                      &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
    678                      &           - 0.164759e-06_wp * zs                            & 
    679                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
    680                      &                                  + 0.380374e-04_wp ) * zh 
    681                END DO 
    682             END DO 
    683          END DO 
    684          beta0 = 1._wp 
    685          ! 
    686       CASE ( 1 )              !==  Linear formulation = F( temperature )  ==! 
    687          palpbet(:,:,:) = rn_alpha 
    688          beta0 = 0._wp 
    689          ! 
    690       CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==! 
    691          palpbet(:,:,:) = ralpbet_crs 
    692          beta0 = 1._wp 
    693464         ! 
    694465      CASE DEFAULT 
     
    699470      END SELECT 
    700471      ! 
    701       IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet') 
    702       ! 
    703    END SUBROUTINE eos_alpbet_crs 
    704  
    705  
    706    FUNCTION tfreez_crs( psal ) RESULT( ptf ) 
     472      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 
     473         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk ) 
     474      ! 
     475      IF( nn_timing == 1 )   CALL timing_stop('rab_3d') 
     476      ! 
     477   END SUBROUTINE rab_crs_3d 
     478 
     479   SUBROUTINE rab_crs_2d( pts, pdep, pab ) 
     480      !!---------------------------------------------------------------------- 
     481      !!                 ***  ROUTINE rab_2d  *** 
     482      !! 
     483      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked) 
     484      !! 
     485      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     486      !!---------------------------------------------------------------------- 
     487      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     488      REAL(wp), DIMENSION(jpi_crs,jpj_crs)         , INTENT(in   ) ::   pdep   ! depth                  [m] 
     489      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     490      ! 
     491      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     492      REAL(wp) ::   zt , zh , zs              ! local scalars 
     493      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     494      !!---------------------------------------------------------------------- 
     495      ! 
     496      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     497      ! 
     498      pab(:,:,:) = 0._wp 
     499      ! 
     500      SELECT CASE ( nn_eos ) 
     501      ! 
     502      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     503         ! 
     504         DO jj = 1, jpj_crsm1 
     505            DO ji = 1, jpi_crsm1   ! vector opt. 
     506               ! 
     507               zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     508               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     509               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     510               ! 
     511               ! alpha 
     512               zn3 = ALP003 
     513               ! 
     514               zn2 = ALP012*zt + ALP102*zs+ALP002 
     515               ! 
     516               zn1 = ((ALP031*zt   & 
     517                  &   + ALP121*zs+ALP021)*zt   & 
     518                  &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     519                  &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     520                  ! 
     521               zn0 = ((((ALP050*zt   & 
     522                  &   + ALP140*zs+ALP040)*zt   & 
     523                  &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     524                  &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     525                  &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     526                  &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     527                  ! 
     528               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     529               ! 
     530               pab(ji,jj,jp_tem) = zn * r1_rau0 
     531               ! 
     532               ! beta 
     533               zn3 = BET003 
     534               ! 
     535               zn2 = BET012*zt + BET102*zs+BET002 
     536               ! 
     537               zn1 = ((BET031*zt   & 
     538                  &   + BET121*zs+BET021)*zt   & 
     539                  &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     540                  &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     541                  ! 
     542               zn0 = ((((BET050*zt   & 
     543                  &   + BET140*zs+BET040)*zt   & 
     544                  &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     545                  &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     546                  &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     547                  &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     548                  ! 
     549               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     550               ! 
     551               pab(ji,jj,jp_sal) = zn / zs * r1_rau0 
     552               ! 
     553               ! 
     554            END DO 
     555         END DO 
     556         ! 
     557         CALL crs_lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions 
     558         CALL crs_lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                     
     559         ! 
     560      CASE( 1 )                  !==  simplified EOS  ==! 
     561         ! 
     562         DO jj = 1, jpj_crsm1 
     563            DO ji = 1, jpi_crsm1   ! vector opt. 
     564               ! 
     565               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     566               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     567               zh    = pdep (ji,jj)                   ! depth at the partial step level 
     568               ! 
     569               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     570               pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha 
     571               ! 
     572               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     573               pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta 
     574               ! 
     575            END DO 
     576         END DO 
     577         ! 
     578         CALL crs_lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions 
     579         CALL crs_lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                     
     580         ! 
     581      CASE DEFAULT 
     582         IF(lwp) WRITE(numout,cform_err) 
     583         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     584         nstop = nstop + 1 
     585         ! 
     586      END SELECT 
     587      ! 
     588      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 
     589         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
     590      ! 
     591      IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     592      ! 
     593   END SUBROUTINE rab_crs_2d 
     594 
     595 
     596   SUBROUTINE rab_crs_0d( pts, pdep, pab ) 
     597      !!---------------------------------------------------------------------- 
     598      !!                 ***  ROUTINE rab_0d  *** 
     599      !! 
     600      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked) 
     601      !! 
     602      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     603      !!---------------------------------------------------------------------- 
     604      REAL(wp), DIMENSION(jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     605      REAL(wp),                      INTENT(in   ) ::   pdep   ! depth                  [m] 
     606      REAL(wp), DIMENSION(jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     607      ! 
     608      REAL(wp) ::   zt , zh , zs              ! local scalars 
     609      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     610      !!---------------------------------------------------------------------- 
     611      ! 
     612      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     613      ! 
     614      pab(:) = 0._wp 
     615      ! 
     616      SELECT CASE ( nn_eos ) 
     617      ! 
     618      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     619         ! 
     620         ! 
     621         zh  = pdep * r1_Z0                                  ! depth 
     622         zt  = pts (jp_tem) * r1_T0                           ! temperature 
     623         zs  = SQRT( ABS( pts(jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     624         ! 
     625         ! alpha 
     626         zn3 = ALP003 
     627         ! 
     628         zn2 = ALP012*zt + ALP102*zs+ALP002 
     629         ! 
     630         zn1 = ((ALP031*zt   & 
     631            &   + ALP121*zs+ALP021)*zt   & 
     632            &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     633            &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     634            ! 
     635         zn0 = ((((ALP050*zt   & 
     636            &   + ALP140*zs+ALP040)*zt   & 
     637            &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     638            &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     639            &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     640            &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     641            ! 
     642         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     643         ! 
     644         pab(jp_tem) = zn * r1_rau0 
     645         ! 
     646         ! beta 
     647         zn3 = BET003 
     648         ! 
     649         zn2 = BET012*zt + BET102*zs+BET002 
     650         ! 
     651         zn1 = ((BET031*zt   & 
     652            &   + BET121*zs+BET021)*zt   & 
     653            &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     654            &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     655            ! 
     656         zn0 = ((((BET050*zt   & 
     657            &   + BET140*zs+BET040)*zt   & 
     658            &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     659            &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     660            &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     661            &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     662            ! 
     663         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     664         ! 
     665         pab(jp_sal) = zn / zs * r1_rau0 
     666         ! 
     667         ! 
     668         ! 
     669      CASE( 1 )                  !==  simplified EOS  ==! 
     670         ! 
     671         zt    = pts(jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     672         zs    = pts(jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     673         zh    = pdep                    ! depth at the partial step level 
     674         ! 
     675         zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     676         pab(jp_tem) = zn * r1_rau0   ! alpha 
     677         ! 
     678         zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     679         pab(jp_sal) = zn * r1_rau0   ! beta 
     680         ! 
     681      CASE DEFAULT 
     682         IF(lwp) WRITE(numout,cform_err) 
     683         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     684         nstop = nstop + 1 
     685         ! 
     686      END SELECT 
     687      ! 
     688      IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     689      ! 
     690   END SUBROUTINE rab_crs_0d 
     691 
     692 
     693   SUBROUTINE bn2_crs( pts, pab, pn2 ) 
     694      !!---------------------------------------------------------------------- 
     695      !!                  ***  ROUTINE bn2  *** 
     696      !! 
     697      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the  
     698      !!                time-step of the input arguments 
     699      !! 
     700      !! ** Method  :   pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w 
     701      !!      where alpha and beta are given in pab, and computed on T-points. 
     702      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module. 
     703      !! 
     704      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point  
     705      !! 
     706      !!---------------------------------------------------------------------- 
     707      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu] 
     708      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1] 
     709      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     710      ! 
     711      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     712      REAL(wp) ::   zaw, zbw, zrw   ! local scalars 
     713      !!---------------------------------------------------------------------- 
     714      ! 
     715      pn2(:,:,:)=0._wp 
     716 
     717      IF( nn_timing == 1 ) CALL timing_start('bn2') 
     718      ! 
     719      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
     720         DO jj = 1, jpj_crs          ! surface and bottom value set to zero one for all in istate.F90 
     721            DO ji = 1, jpi_crs 
     722               !zrw =   ( gdepw_crs(ji,jj,jk  ) - gdept_crs(ji,jj,jk) )   & 
     723               !   &  / ( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) )  
     724               zrw =   gdepw_crs(ji,jj,jk  ) - gdept_crs(ji,jj,jk)     
     725               !?IF( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) .NE. 0._wp )THEN 
     726               IF( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) .LT. 0._wp )THEN 
     727                  zrw = zrw  / ( gdept_crs(ji,jj,jk-1) - gdept_crs(ji,jj,jk) )  
     728               ELSE 
     729                  zrw = 0._wp 
     730               ENDIF 
     731               ! 
     732               zaw = pab(ji,jj,jk,jp_tem) * (1._wp - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     733               zbw = pab(ji,jj,jk,jp_sal) * (1._wp - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
     734               ! 
     735               IF( e3w_max_crs(ji,jj,jk) .NE. 0._wp ) THEN 
     736                  pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
     737                     &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
     738                  &                    * tmask_crs(ji,jj,jk)  / e3w_max_crs(ji,jj,jk) 
     739               ENDIF 
     740            END DO 
     741         END DO 
     742      END DO 
     743      ! 
     744      IF( nn_timing == 1 )   CALL timing_stop('bn2') 
     745      ! 
     746   END SUBROUTINE bn2_crs 
     747 
     748   SUBROUTINE eos_init_crs 
    707749      !!---------------------------------------------------------------------- 
    708750      !!                 ***  ROUTINE eos_init  *** 
    709751      !! 
    710       !! ** Purpose :   Compute the sea surface freezing temperature [Celcius] 
    711       !! 
    712       !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???) 
    713       !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 
    714       !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 
    715       !! 
    716       !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    717       !!---------------------------------------------------------------------- 
    718       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
    719       ! Leave result array automatic rather than making explicitly allocated 
    720       REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
    721       !!---------------------------------------------------------------------- 
    722       ! 
    723       ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
    724          &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
    725       ! 
    726    END FUNCTION tfreez_crs 
    727  
    728  
    729    SUBROUTINE eos_init_crs 
    730       !!---------------------------------------------------------------------- 
    731       !!                 ***  ROUTINE eos_init  *** 
    732       !! 
    733752      !! ** Purpose :   initializations for the equation of state 
    734753      !! 
    735754      !! ** Method  :   Read the namelist nameos and control the parameters 
    736755      !!---------------------------------------------------------------------- 
    737       INTEGER ::   ios   ! Local integer output status for namelist read 
    738       !! 
    739       NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta 
    740       !!---------------------------------------------------------------------- 
    741       ! 
    742       REWIND( numnam_ref )             
    743       READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901) 
     756      INTEGER  ::   ios   ! local integer 
     757      !! 
     758      NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1,   & 
     759         &                                             rn_lambda2, rn_mu2, rn_nu 
     760      !!---------------------------------------------------------------------- 
     761      ! 
     762      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
     763      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    744764901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 
    745  
    746       REWIND( numnam_cfg )     
     765      ! 
     766      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    747767      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    748768902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
    749       IF(lwm) WRITE ( numond, nameos ) 
    750  
     769      IF(lwm) WRITE( numond, nameos ) 
     770      ! 
     771      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     772      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
    751773      ! 
    752774      IF(lwp) THEN                ! Control print 
     
    756778         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    757779         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos 
    758          WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha 
    759          WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta 
     780         IF( ln_useCT )   THEN 
     781            WRITE(numout,*) '             model uses Conservative Temperature' 
     782            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields' 
     783         ENDIF 
    760784      ENDIF 
    761785      ! 
    762786      SELECT CASE( nn_eos )         ! check option 
    763787      ! 
    764       CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==! 
     788      CASE( -1 )                       !==  polynomial TEOS-10  ==! 
    765789         IF(lwp) WRITE(numout,*) 
    766          IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and' 
    767          IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency' 
    768          ! 
    769       CASE( 1 )                        !==  Linear formulation = F( temperature )  ==! 
     790         IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 
     791         ! 
     792         rdeltaS = 32._wp 
     793         r1_S0  = 0.875_wp/35.16504_wp 
     794         r1_T0  = 1._wp/40._wp 
     795         r1_Z0  = 1.e-4_wp 
     796         ! 
     797         EOS000 = 8.0189615746e+02_wp 
     798         EOS100 = 8.6672408165e+02_wp 
     799         EOS200 = -1.7864682637e+03_wp 
     800         EOS300 = 2.0375295546e+03_wp 
     801         EOS400 = -1.2849161071e+03_wp 
     802         EOS500 = 4.3227585684e+02_wp 
     803         EOS600 = -6.0579916612e+01_wp 
     804         EOS010 = 2.6010145068e+01_wp 
     805         EOS110 = -6.5281885265e+01_wp 
     806         EOS210 = 8.1770425108e+01_wp 
     807         EOS310 = -5.6888046321e+01_wp 
     808         EOS410 = 1.7681814114e+01_wp 
     809         EOS510 = -1.9193502195_wp 
     810         EOS020 = -3.7074170417e+01_wp 
     811         EOS120 = 6.1548258127e+01_wp 
     812         EOS220 = -6.0362551501e+01_wp 
     813         EOS320 = 2.9130021253e+01_wp 
     814         EOS420 = -5.4723692739_wp 
     815         EOS030 = 2.1661789529e+01_wp 
     816         EOS130 = -3.3449108469e+01_wp 
     817         EOS230 = 1.9717078466e+01_wp 
     818         EOS330 = -3.1742946532_wp 
     819         EOS040 = -8.3627885467_wp 
     820         EOS140 = 1.1311538584e+01_wp 
     821         EOS240 = -5.3563304045_wp 
     822         EOS050 = 5.4048723791e-01_wp 
     823         EOS150 = 4.8169980163e-01_wp 
     824         EOS060 = -1.9083568888e-01_wp 
     825         EOS001 = 1.9681925209e+01_wp 
     826         EOS101 = -4.2549998214e+01_wp 
     827         EOS201 = 5.0774768218e+01_wp 
     828         EOS301 = -3.0938076334e+01_wp 
     829         EOS401 = 6.6051753097_wp 
     830         EOS011 = -1.3336301113e+01_wp 
     831         EOS111 = -4.4870114575_wp 
     832         EOS211 = 5.0042598061_wp 
     833         EOS311 = -6.5399043664e-01_wp 
     834         EOS021 = 6.7080479603_wp 
     835         EOS121 = 3.5063081279_wp 
     836         EOS221 = -1.8795372996_wp 
     837         EOS031 = -2.4649669534_wp 
     838         EOS131 = -5.5077101279e-01_wp 
     839         EOS041 = 5.5927935970e-01_wp 
     840         EOS002 = 2.0660924175_wp 
     841         EOS102 = -4.9527603989_wp 
     842         EOS202 = 2.5019633244_wp 
     843         EOS012 = 2.0564311499_wp 
     844         EOS112 = -2.1311365518e-01_wp 
     845         EOS022 = -1.2419983026_wp 
     846         EOS003 = -2.3342758797e-02_wp 
     847         EOS103 = -1.8507636718e-02_wp 
     848         EOS013 = 3.7969820455e-01_wp 
     849         ! 
     850         ALP000 = -6.5025362670e-01_wp 
     851         ALP100 = 1.6320471316_wp 
     852         ALP200 = -2.0442606277_wp 
     853         ALP300 = 1.4222011580_wp 
     854         ALP400 = -4.4204535284e-01_wp 
     855         ALP500 = 4.7983755487e-02_wp 
     856         ALP010 = 1.8537085209_wp 
     857         ALP110 = -3.0774129064_wp 
     858         ALP210 = 3.0181275751_wp 
     859         ALP310 = -1.4565010626_wp 
     860         ALP410 = 2.7361846370e-01_wp 
     861         ALP020 = -1.6246342147_wp 
     862         ALP120 = 2.5086831352_wp 
     863         ALP220 = -1.4787808849_wp 
     864         ALP320 = 2.3807209899e-01_wp 
     865         ALP030 = 8.3627885467e-01_wp 
     866         ALP130 = -1.1311538584_wp 
     867         ALP230 = 5.3563304045e-01_wp 
     868         ALP040 = -6.7560904739e-02_wp 
     869         ALP140 = -6.0212475204e-02_wp 
     870         ALP050 = 2.8625353333e-02_wp 
     871         ALP001 = 3.3340752782e-01_wp 
     872         ALP101 = 1.1217528644e-01_wp 
     873         ALP201 = -1.2510649515e-01_wp 
     874         ALP301 = 1.6349760916e-02_wp 
     875         ALP011 = -3.3540239802e-01_wp 
     876         ALP111 = -1.7531540640e-01_wp 
     877         ALP211 = 9.3976864981e-02_wp 
     878         ALP021 = 1.8487252150e-01_wp 
     879         ALP121 = 4.1307825959e-02_wp 
     880         ALP031 = -5.5927935970e-02_wp 
     881         ALP002 = -5.1410778748e-02_wp 
     882         ALP102 = 5.3278413794e-03_wp 
     883         ALP012 = 6.2099915132e-02_wp 
     884         ALP003 = -9.4924551138e-03_wp 
     885         ! 
     886         BET000 = 1.0783203594e+01_wp 
     887         BET100 = -4.4452095908e+01_wp 
     888         BET200 = 7.6048755820e+01_wp 
     889         BET300 = -6.3944280668e+01_wp 
     890         BET400 = 2.6890441098e+01_wp 
     891         BET500 = -4.5221697773_wp 
     892         BET010 = -8.1219372432e-01_wp 
     893         BET110 = 2.0346663041_wp 
     894         BET210 = -2.1232895170_wp 
     895         BET310 = 8.7994140485e-01_wp 
     896         BET410 = -1.1939638360e-01_wp 
     897         BET020 = 7.6574242289e-01_wp 
     898         BET120 = -1.5019813020_wp 
     899         BET220 = 1.0872489522_wp 
     900         BET320 = -2.7233429080e-01_wp 
     901         BET030 = -4.1615152308e-01_wp 
     902         BET130 = 4.9061350869e-01_wp 
     903         BET230 = -1.1847737788e-01_wp 
     904         BET040 = 1.4073062708e-01_wp 
     905         BET140 = -1.3327978879e-01_wp 
     906         BET050 = 5.9929880134e-03_wp 
     907         BET001 = -5.2937873009e-01_wp 
     908         BET101 = 1.2634116779_wp 
     909         BET201 = -1.1547328025_wp 
     910         BET301 = 3.2870876279e-01_wp 
     911         BET011 = -5.5824407214e-02_wp 
     912         BET111 = 1.2451933313e-01_wp 
     913         BET211 = -2.4409539932e-02_wp 
     914         BET021 = 4.3623149752e-02_wp 
     915         BET121 = -4.6767901790e-02_wp 
     916         BET031 = -6.8523260060e-03_wp 
     917         BET002 = -6.1618945251e-02_wp 
     918         BET102 = 6.2255521644e-02_wp 
     919         BET012 = -2.6514181169e-03_wp 
     920         BET003 = -2.3025968587e-04_wp 
     921         ! 
     922         PEN000 = -9.8409626043_wp 
     923         PEN100 = 2.1274999107e+01_wp 
     924         PEN200 = -2.5387384109e+01_wp 
     925         PEN300 = 1.5469038167e+01_wp 
     926         PEN400 = -3.3025876549_wp 
     927         PEN010 = 6.6681505563_wp 
     928         PEN110 = 2.2435057288_wp 
     929         PEN210 = -2.5021299030_wp 
     930         PEN310 = 3.2699521832e-01_wp 
     931         PEN020 = -3.3540239802_wp 
     932         PEN120 = -1.7531540640_wp 
     933         PEN220 = 9.3976864981e-01_wp 
     934         PEN030 = 1.2324834767_wp 
     935         PEN130 = 2.7538550639e-01_wp 
     936         PEN040 = -2.7963967985e-01_wp 
     937         PEN001 = -1.3773949450_wp 
     938         PEN101 = 3.3018402659_wp 
     939         PEN201 = -1.6679755496_wp 
     940         PEN011 = -1.3709540999_wp 
     941         PEN111 = 1.4207577012e-01_wp 
     942         PEN021 = 8.2799886843e-01_wp 
     943         PEN002 = 1.7507069098e-02_wp 
     944         PEN102 = 1.3880727538e-02_wp 
     945         PEN012 = -2.8477365341e-01_wp 
     946         ! 
     947         APE000 = -1.6670376391e-01_wp 
     948         APE100 = -5.6087643219e-02_wp 
     949         APE200 = 6.2553247576e-02_wp 
     950         APE300 = -8.1748804580e-03_wp 
     951         APE010 = 1.6770119901e-01_wp 
     952         APE110 = 8.7657703198e-02_wp 
     953         APE210 = -4.6988432490e-02_wp 
     954         APE020 = -9.2436260751e-02_wp 
     955         APE120 = -2.0653912979e-02_wp 
     956         APE030 = 2.7963967985e-02_wp 
     957         APE001 = 3.4273852498e-02_wp 
     958         APE101 = -3.5518942529e-03_wp 
     959         APE011 = -4.1399943421e-02_wp 
     960         APE002 = 7.1193413354e-03_wp 
     961         ! 
     962         BPE000 = 2.6468936504e-01_wp 
     963         BPE100 = -6.3170583896e-01_wp 
     964         BPE200 = 5.7736640125e-01_wp 
     965         BPE300 = -1.6435438140e-01_wp 
     966         BPE010 = 2.7912203607e-02_wp 
     967         BPE110 = -6.2259666565e-02_wp 
     968         BPE210 = 1.2204769966e-02_wp 
     969         BPE020 = -2.1811574876e-02_wp 
     970         BPE120 = 2.3383950895e-02_wp 
     971         BPE030 = 3.4261630030e-03_wp 
     972         BPE001 = 4.1079296834e-02_wp 
     973         BPE101 = -4.1503681096e-02_wp 
     974         BPE011 = 1.7676120780e-03_wp 
     975         BPE002 = 1.7269476440e-04_wp 
     976         ! 
     977      CASE( 0 )                        !==  polynomial EOS-80 formulation  ==! 
     978         ! 
    770979         IF(lwp) WRITE(numout,*) 
    771          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )' 
    772          IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
    773               &                         ' that T and S are used as state variables' ) 
    774          ! 
    775       CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==! 
    776          ralpbet_crs = rn_alpha / rn_beta 
    777          IF(lwp) WRITE(numout,*) 
    778          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )' 
     980         IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)' 
     981         ! 
     982         rdeltaS = 20._wp 
     983         r1_S0  = 1._wp/40._wp 
     984         r1_T0  = 1._wp/40._wp 
     985         r1_Z0  = 1.e-4_wp 
     986         ! 
     987         EOS000 = 9.5356891948e+02_wp 
     988         EOS100 = 1.7136499189e+02_wp 
     989         EOS200 = -3.7501039454e+02_wp 
     990         EOS300 = 5.1856810420e+02_wp 
     991         EOS400 = -3.7264470465e+02_wp 
     992         EOS500 = 1.4302533998e+02_wp 
     993         EOS600 = -2.2856621162e+01_wp 
     994         EOS010 = 1.0087518651e+01_wp 
     995         EOS110 = -1.3647741861e+01_wp 
     996         EOS210 = 8.8478359933_wp 
     997         EOS310 = -7.2329388377_wp 
     998         EOS410 = 1.4774410611_wp 
     999         EOS510 = 2.0036720553e-01_wp 
     1000         EOS020 = -2.5579830599e+01_wp 
     1001         EOS120 = 2.4043512327e+01_wp 
     1002         EOS220 = -1.6807503990e+01_wp 
     1003         EOS320 = 8.3811577084_wp 
     1004         EOS420 = -1.9771060192_wp 
     1005         EOS030 = 1.6846451198e+01_wp 
     1006         EOS130 = -2.1482926901e+01_wp 
     1007         EOS230 = 1.0108954054e+01_wp 
     1008         EOS330 = -6.2675951440e-01_wp 
     1009         EOS040 = -8.0812310102_wp 
     1010         EOS140 = 1.0102374985e+01_wp 
     1011         EOS240 = -4.8340368631_wp 
     1012         EOS050 = 1.2079167803_wp 
     1013         EOS150 = 1.1515380987e-01_wp 
     1014         EOS060 = -2.4520288837e-01_wp 
     1015         EOS001 = 1.0748601068e+01_wp 
     1016         EOS101 = -1.7817043500e+01_wp 
     1017         EOS201 = 2.2181366768e+01_wp 
     1018         EOS301 = -1.6750916338e+01_wp 
     1019         EOS401 = 4.1202230403_wp 
     1020         EOS011 = -1.5852644587e+01_wp 
     1021         EOS111 = -7.6639383522e-01_wp 
     1022         EOS211 = 4.1144627302_wp 
     1023         EOS311 = -6.6955877448e-01_wp 
     1024         EOS021 = 9.9994861860_wp 
     1025         EOS121 = -1.9467067787e-01_wp 
     1026         EOS221 = -1.2177554330_wp 
     1027         EOS031 = -3.4866102017_wp 
     1028         EOS131 = 2.2229155620e-01_wp 
     1029         EOS041 = 5.9503008642e-01_wp 
     1030         EOS002 = 1.0375676547_wp 
     1031         EOS102 = -3.4249470629_wp 
     1032         EOS202 = 2.0542026429_wp 
     1033         EOS012 = 2.1836324814_wp 
     1034         EOS112 = -3.4453674320e-01_wp 
     1035         EOS022 = -1.2548163097_wp 
     1036         EOS003 = 1.8729078427e-02_wp 
     1037         EOS103 = -5.7238495240e-02_wp 
     1038         EOS013 = 3.8306136687e-01_wp 
     1039         ! 
     1040         ALP000 = -2.5218796628e-01_wp 
     1041         ALP100 = 3.4119354654e-01_wp 
     1042         ALP200 = -2.2119589983e-01_wp 
     1043         ALP300 = 1.8082347094e-01_wp 
     1044         ALP400 = -3.6936026529e-02_wp 
     1045         ALP500 = -5.0091801383e-03_wp 
     1046         ALP010 = 1.2789915300_wp 
     1047         ALP110 = -1.2021756164_wp 
     1048         ALP210 = 8.4037519952e-01_wp 
     1049         ALP310 = -4.1905788542e-01_wp 
     1050         ALP410 = 9.8855300959e-02_wp 
     1051         ALP020 = -1.2634838399_wp 
     1052         ALP120 = 1.6112195176_wp 
     1053         ALP220 = -7.5817155402e-01_wp 
     1054         ALP320 = 4.7006963580e-02_wp 
     1055         ALP030 = 8.0812310102e-01_wp 
     1056         ALP130 = -1.0102374985_wp 
     1057         ALP230 = 4.8340368631e-01_wp 
     1058         ALP040 = -1.5098959754e-01_wp 
     1059         ALP140 = -1.4394226233e-02_wp 
     1060         ALP050 = 3.6780433255e-02_wp 
     1061         ALP001 = 3.9631611467e-01_wp 
     1062         ALP101 = 1.9159845880e-02_wp 
     1063         ALP201 = -1.0286156825e-01_wp 
     1064         ALP301 = 1.6738969362e-02_wp 
     1065         ALP011 = -4.9997430930e-01_wp 
     1066         ALP111 = 9.7335338937e-03_wp 
     1067         ALP211 = 6.0887771651e-02_wp 
     1068         ALP021 = 2.6149576513e-01_wp 
     1069         ALP121 = -1.6671866715e-02_wp 
     1070         ALP031 = -5.9503008642e-02_wp 
     1071         ALP002 = -5.4590812035e-02_wp 
     1072         ALP102 = 8.6134185799e-03_wp 
     1073         ALP012 = 6.2740815484e-02_wp 
     1074         ALP003 = -9.5765341718e-03_wp 
     1075         ! 
     1076         BET000 = 2.1420623987_wp 
     1077         BET100 = -9.3752598635_wp 
     1078         BET200 = 1.9446303907e+01_wp 
     1079         BET300 = -1.8632235232e+01_wp 
     1080         BET400 = 8.9390837485_wp 
     1081         BET500 = -1.7142465871_wp 
     1082         BET010 = -1.7059677327e-01_wp 
     1083         BET110 = 2.2119589983e-01_wp 
     1084         BET210 = -2.7123520642e-01_wp 
     1085         BET310 = 7.3872053057e-02_wp 
     1086         BET410 = 1.2522950346e-02_wp 
     1087         BET020 = 3.0054390409e-01_wp 
     1088         BET120 = -4.2018759976e-01_wp 
     1089         BET220 = 3.1429341406e-01_wp 
     1090         BET320 = -9.8855300959e-02_wp 
     1091         BET030 = -2.6853658626e-01_wp 
     1092         BET130 = 2.5272385134e-01_wp 
     1093         BET230 = -2.3503481790e-02_wp 
     1094         BET040 = 1.2627968731e-01_wp 
     1095         BET140 = -1.2085092158e-01_wp 
     1096         BET050 = 1.4394226233e-03_wp 
     1097         BET001 = -2.2271304375e-01_wp 
     1098         BET101 = 5.5453416919e-01_wp 
     1099         BET201 = -6.2815936268e-01_wp 
     1100         BET301 = 2.0601115202e-01_wp 
     1101         BET011 = -9.5799229402e-03_wp 
     1102         BET111 = 1.0286156825e-01_wp 
     1103         BET211 = -2.5108454043e-02_wp 
     1104         BET021 = -2.4333834734e-03_wp 
     1105         BET121 = -3.0443885826e-02_wp 
     1106         BET031 = 2.7786444526e-03_wp 
     1107         BET002 = -4.2811838287e-02_wp 
     1108         BET102 = 5.1355066072e-02_wp 
     1109         BET012 = -4.3067092900e-03_wp 
     1110         BET003 = -7.1548119050e-04_wp 
     1111         ! 
     1112         PEN000 = -5.3743005340_wp 
     1113         PEN100 = 8.9085217499_wp 
     1114         PEN200 = -1.1090683384e+01_wp 
     1115         PEN300 = 8.3754581690_wp 
     1116         PEN400 = -2.0601115202_wp 
     1117         PEN010 = 7.9263222935_wp 
     1118         PEN110 = 3.8319691761e-01_wp 
     1119         PEN210 = -2.0572313651_wp 
     1120         PEN310 = 3.3477938724e-01_wp 
     1121         PEN020 = -4.9997430930_wp 
     1122         PEN120 = 9.7335338937e-02_wp 
     1123         PEN220 = 6.0887771651e-01_wp 
     1124         PEN030 = 1.7433051009_wp 
     1125         PEN130 = -1.1114577810e-01_wp 
     1126         PEN040 = -2.9751504321e-01_wp 
     1127         PEN001 = -6.9171176978e-01_wp 
     1128         PEN101 = 2.2832980419_wp 
     1129         PEN201 = -1.3694684286_wp 
     1130         PEN011 = -1.4557549876_wp 
     1131         PEN111 = 2.2969116213e-01_wp 
     1132         PEN021 = 8.3654420645e-01_wp 
     1133         PEN002 = -1.4046808820e-02_wp 
     1134         PEN102 = 4.2928871430e-02_wp 
     1135         PEN012 = -2.8729602515e-01_wp 
     1136         ! 
     1137         APE000 = -1.9815805734e-01_wp 
     1138         APE100 = -9.5799229402e-03_wp 
     1139         APE200 = 5.1430784127e-02_wp 
     1140         APE300 = -8.3694846809e-03_wp 
     1141         APE010 = 2.4998715465e-01_wp 
     1142         APE110 = -4.8667669469e-03_wp 
     1143         APE210 = -3.0443885826e-02_wp 
     1144         APE020 = -1.3074788257e-01_wp 
     1145         APE120 = 8.3359333577e-03_wp 
     1146         APE030 = 2.9751504321e-02_wp 
     1147         APE001 = 3.6393874690e-02_wp 
     1148         APE101 = -5.7422790533e-03_wp 
     1149         APE011 = -4.1827210323e-02_wp 
     1150         APE002 = 7.1824006288e-03_wp 
     1151         ! 
     1152         BPE000 = 1.1135652187e-01_wp 
     1153         BPE100 = -2.7726708459e-01_wp 
     1154         BPE200 = 3.1407968134e-01_wp 
     1155         BPE300 = -1.0300557601e-01_wp 
     1156         BPE010 = 4.7899614701e-03_wp 
     1157         BPE110 = -5.1430784127e-02_wp 
     1158         BPE210 = 1.2554227021e-02_wp 
     1159         BPE020 = 1.2166917367e-03_wp 
     1160         BPE120 = 1.5221942913e-02_wp 
     1161         BPE030 = -1.3893222263e-03_wp 
     1162         BPE001 = 2.8541225524e-02_wp 
     1163         BPE101 = -3.4236710714e-02_wp 
     1164         BPE011 = 2.8711395266e-03_wp 
     1165         BPE002 = 5.3661089288e-04_wp 
     1166         ! 
     1167      CASE( 1 )                        !==  Simplified EOS     ==! 
     1168         IF(lwp) THEN 
     1169            WRITE(numout,*) 
     1170            WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = ' 
     1171            WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 
     1172            WRITE(numout,*) 
     1173            WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0 
     1174            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0 
     1175            WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1 
     1176            WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2 
     1177            WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1 
     1178            WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2 
     1179            WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu 
     1180            WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization ' 
     1181         ENDIF 
    7791182         ! 
    7801183      CASE DEFAULT                     !==  ERROR in nn_eos  ==! 
     
    7841187      END SELECT 
    7851188      ! 
     1189      r1_rau0     = 1._wp / rau0 
     1190      r1_rcp      = 1._wp / rcp 
     1191      r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     1192      ! 
     1193      IF(lwp) WRITE(numout,*) 
     1194      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
     1195      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     1196      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     1197      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     1198      ! 
    7861199   END SUBROUTINE eos_init_crs 
    7871200 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90

    r5105 r5601  
    2424   USE oce             ! ocean dynamics and active tracers 
    2525   USE dom_oce , ONLY : lk_vvl 
    26    USE trdmod_oce      ! tracers trends 
     26   USE trd_oce         ! tracers trends 
    2727   USE trdtra          ! tracers trends 
    2828   USE in_out_manager  ! I/O manager 
     
    123123         ! 2. upstream advection with initial mass fluxes & intermediate update 
    124124         ! -------------------------------------------------------------------- 
    125         !DO jk = 2, jpkm1          ! Interior value 
    126         !    DO jj = 1, jpj 
    127         !       DO ji = 1, jpi 
    128         !          IF( ptb(ji,jj,jk,jn) .NE. ptb(ji,jj,jk,jn) )WRITE(narea+200,*)"ADVtb",ptb(ji,jj,jk,jn) ; call flush(narea+200) 
    129         !          IF( ptn(ji,jj,jk,jn) .NE. ptn(ji,jj,jk,jn) )WRITE(narea+200,*)"ADVtn",ptb(ji,jj,jk,jn) ; call flush(narea+200) 
    130         !          IF( pun(ji,jj,jk) .NE. pun(ji,jj,jk) )WRITE(narea+200,*)"ADVun",pun(ji,jj,jk) ; call flush(narea+200) 
    131         !          IF( pvn(ji,jj,jk) .NE. pvn(ji,jj,jk) )WRITE(narea+200,*)"ADVvn",pvn(ji,jj,jk) ; call flush(narea+200) 
    132         !          IF( pwn(ji,jj,jk) .NE. pwn(ji,jj,jk) )WRITE(narea+200,*)"ADVwn",pwn(ji,jj,jk) ; call flush(narea+200) 
    133         !       END DO 
    134         !    END DO 
    135         ! END DO 
    136         ! ji=117 ; jj=211 ; jk=74 
    137         ! ji=ji-nimpp_crs+1 ; jj=jj-njmpp_crs+1 
    138         ! IF( ji .GE. 2 .AND. ji .LE. jpi_crs-1 .AND. jj .GE. 2 .AND. jj .LE. jpj_crs-1 )THEN 
    139         ! WRITE(narea+5000,*)"tvd =======> kt ",kt 
    140         ! WRITE(narea+5000,*)ptb(ji,jj,jk,jn),ptn(ji,jj,jk,jn) 
    141         ! WRITE(narea+5000,*)pun(ji-1,jj,jk),pun(ji,jj,jk) 
    142         ! WRITE(narea+5000,*)pvn(ji,jj-1,jk),pun(ji,jj,jk) 
    143         ! WRITE(narea+5000,*)pwn(ji,jj,jk),pwn(ji,jj,jk+1) 
    144         ! ENDIF 
    145125 
    146126         ! upstream tracer flux in the i and j direction 
     
    173153            END DO 
    174154         END DO 
    175 !WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,1)) , kt 
    176 !WRITE(numout,*) 'test_tra', minval(pta(:,:,:,1)) , kt 
    177155         ! total advective trend 
    178156         DO jk = 1, jpkm1 
     
    188166                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra 
    189167                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask_crs(ji,jj,jk) 
    190                   !iji=117 ; ijj=211 ; ijk=74 
    191                   !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1 
    192                   !IF( ji==iji .AND. jj==ijj )THEN 
    193                   !WRITE(narea+5000,*)"test ",jk,zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ), &  
    194                   !              zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1) 
    195                   !ENDIF 
    196                   !IF( ztra .NE. 0._wp )WRITE(narea+6000,*)"buga ",kt,ji,jj,jk,mbathy_crs(ji,jj), & 
    197                   !    zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ),zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1) 
    198                END DO 
    199             END DO 
    200          END DO 
    201          !IF(narea==267)WRITE(narea+5000,*)"1 pta(17,6,74,1) = ",pta(17,6,74,1) 
    202          !zmin=MINVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_min(zmin) 
    203          !zmax=MAXVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_max(zmax) 
    204          !IF(lwp)WRITE(numout,*)"trcadvtvdcrs a ",kt,zmin,zmax 
    205  
    206 !WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,jk)) , kt 
    207 !WRITE(numout,*) 'test_tra', minval(pta(:,:,:,jk)) , kt 
     168               END DO 
     169            END DO 
     170         END DO 
    208171         !                             ! Lateral boundary conditions on zwi  (unchanged sign) 
    209172         CALL crs_lbc_lnk( zwi, 'T', 1. )   
     
    226189            DO jj = 1, jpjm1 
    227190               DO ji = 1, fs_jpim1   ! vector opt. 
    228                   !iji=117 ; ijj=211 ; ijk=74 
    229                   !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1 
    230                   !IF( ji==iji .AND. jj==ijj )THEN 
    231                   !WRITE(narea+5000,*)"antidiffxy ",jk,pun(ji,jj,jk),ptn(ji,jj,jk,jn),ptn(ji+1,jj,jk,jn),zwx(ji,jj,jk) 
    232                   !WRITE(narea+5000,*)"antidiffxy ",jk,pvn(ji,jj,jk),ptn(ji,jj,jk,jn),ptn(ji,jj+1,jk,jn),zwy(ji,jj,jk) 
    233                   !ENDIF 
    234191                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 
    235192                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 
    236                   !iji=117 ; ijj=211 ; ijk=74 
    237                   !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1 
    238                   !IF( ji==iji .AND. jj==ijj )THEN 
    239                   !WRITE(narea+5000,*)"antidiffxy ",jk,zwx(ji,jj,jk),zwy(ji,jj,jk)  
    240                   !ENDIF 
    241                END DO 
    242             END DO 
    243          END DO 
    244   !    WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt 
     193               END DO 
     194            END DO 
     195         END DO 
    245196         ! antidiffusive flux on k 
    246197         zwz(:,:,1) = 0.e0         ! Surface value 
     
    250201               DO ji = 1, jpi 
    251202                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk) 
    252                   !iji=117 ; ijj=211 ; ijk=74 
    253                   !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1 
    254                   !IF( ji==iji .AND. jj==ijj )THEN 
    255                   !WRITE(narea+5000,*)"antidiffz ",jk,zwz(ji,jj,jk) 
    256                   !ENDIF 
    257203               END DO 
    258204            END DO 
     
    263209         ! 4. monotonicity algorithm 
    264210         ! ------------------------- 
    265          !DO jk = 2, jpkm1          ! Interior value 
    266          !   DO jj = 1, jpj 
    267          !      DO ji = 1, jpi 
    268          !         IF( ptb(ji,jj,jk,jn) .NE. ptb(ji,jj,jk,jn) )WRITE(narea+200,*)"ADV1",ptb(ji,jj,jk,jn) ; call flush(narea+200) 
    269          !         IF( zwx(ji,jj,jk) .NE. zwx(ji,jj,jk) )WRITE(narea+200,*)"ADV2",zwx(ji,jj,jk) ; call flush(narea+200) 
    270          !         IF( zwy(ji,jj,jk) .NE. zwy(ji,jj,jk) )WRITE(narea+200,*)"ADV3",zwy(ji,jj,jk) ; call flush(narea+200) 
    271          !         IF( zwz(ji,jj,jk) .NE. zwz(ji,jj,jk) )WRITE(narea+200,*)"ADV4",zwz(ji,jj,jk) ; call flush(narea+200) 
    272          !         IF( zwi(ji,jj,jk) .NE. zwi(ji,jj,jk) )WRITE(narea+200,*)"ADV5",zwi(ji,jj,jk) ; call flush(narea+200) 
    273          !         IF( tmask_crs(ji,jj,jk) .NE. tmask_crs(ji,jj,jk) )WRITE(narea+200,*)"ADV6",tmask_crs(ji,jj,jk) ; call flush(narea+200) 
    274          !      END DO 
    275          !   END DO 
    276          !END DO 
    277    
    278211         CALL nonosc_crs( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 
    279  
    280          !IF( narea==267 )THEN 
    281          !DO jk=1,jpk-1 
    282          !WRITE(narea+5000,*)"toto",jk,zwx(16,6,jk),zwx(17,6,jk),zwy(17,5,jk),zwy(17,6,jk),zwz(17,6,jk),zwz(17,6,jk+1) 
    283          !ENDDO 
    284          !ENDIF 
    285212 
    286213         ! 5. final trend with corrected fluxes 
     
    298225 
    299226 
    300                   !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN  
    301                   !WRITE(narea+5000,*)"correc ",jk,ptb(ji,jj,jk,1),pta(ji,jj,jk,1),zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ), & 
    302                   !              zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1) 
    303                   !ENDIF 
    304  
    305  
    306                   !IF( ztra .NE. 0._wp )WRITE(narea+6000,*)"bugb ",kt,ji,jj,jk,mbathy_crs(ji,jj), & 
    307                   !    zwx(ji,jj,jk) , zwx(ji-1,jj  ,jk  ),zwy(ji,jj,jk) , zwy(ji  ,jj-1,jk  ),zwz(ji,jj,jk),zwz(ji  ,jj  ,jk+1) 
    308                END DO 
    309             END DO 
    310          END DO 
    311          !IF(narea==267)WRITE(narea+5000,*)"2 pta(17,6,74,1) = ",pta(17,6,74,1) 
    312          !zmin=MINVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_min(zmin) 
    313          !zmax=MAXVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_max(zmax) 
    314          !IF(lwp)WRITE(numout,*)"trcadvtvdcrs b ",kt,zmin,zmax 
    315  
    316 !WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,jk)) , kt 
    317 !WRITE(numout,*) 'test_tra', minval(pta(:,:,:,jk)) , kt 
    318 !WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt 
     227               END DO 
     228            END DO 
     229         END DO 
     230 
    319231         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    320232         IF( l_trd )  THEN  
     
    323235            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    324236             
    325             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    326             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    327             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
     237            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
     238            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
     239            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
    328240         END IF 
    329241         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     
    339251      ! 
    340252      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd') 
    341   !    IF(lwp) WRITE(numout,*) 'TEST2', pta 
    342 !WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt 
    343253      ! 
    344254   END SUBROUTINE tra_adv_tvd_crs 
     
    434344               zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
    435345               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) ) 
    436                !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN  
    437                !   WRITE(narea+5000,*)"nonosc ",jk 
    438                !   WRITE(narea+5000,*)"paa",zbetdo(ji,jj,jk),zbetup(ji+1,jj,jk),zbetup(ji,jj,jk),zbetdo(ji+1,jj,jk) 
    439                !   WRITE(narea+5000,*)"paa",zau,zbu,zcu, paa(ji,jj,jk) 
    440                !ENDIF 
    441346               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu ) 
    442                !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"paa",paa(ji,jj,jk) 
    443347 
    444348               zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
    445349               zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
    446350               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 
    447                !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN  
    448                !   WRITE(narea+5000,*)"pbb",zbetdo(ji,jj,jk),zbetup(ji,jj+1,jk),zbetup(ji,jj,jk),zbetdo(ji,jj+1,jk) 
    449                !   WRITE(narea+5000,*)"pbb",zav,zbv,zcv, pbb(ji,jj,jk) 
    450                !ENDIF 
    451351               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv ) 
    452                !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"pbb",pbb(ji,jj,jk) 
    453352 
    454353      ! monotonic flux in the k direction, i.e. pcc 
     
    457356               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 
    458357               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 
    459                !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN  
    460                !   WRITE(narea+5000,*)"pcc",zbetdo(ji,jj,jk+1),zbetup(ji,jj,jk),zbetup(ji,jj,jk+1),zbetdo(ji,jj,jk) 
    461                !   WRITE(narea+5000,*)"pcc",za,zb,zc, pcc(ji,jj,jk+1) 
    462                !ENDIF 
    463358               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb ) 
    464                !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"pcc",pcc(ji,jj,jk+1) 
    465359            END DO 
    466360         END DO 
    467361      END DO 
    468362 
    469          !IF( narea==267 )THEN 
    470          !DO jk=1,jpk-1 
    471          !WRITE(narea+5000,*)"nono",jk,paa(16,6,jk),paa(17,6,jk),pbb(17,5,jk),pbb(17,6,jk),pcc(17,6,jk),pcc(17,6,jk+1) 
    472          !ENDDO 
    473          !ENDIF 
    474  
    475363      CALL crs_lbc_lnk( paa, 'U', -1. )   ;   CALL crs_lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    476          !IF( narea==267 )THEN 
    477          !DO jk=1,jpk-1 
    478          !WRITE(narea+5000,*)"nono1",jk,paa(16,6,jk),paa(17,6,jk),pbb(17,5,jk),pbb(17,6,jk),pcc(17,6,jk),pcc(17,6,jk+1) 
    479          !!ENDDO 
    480          !ENDIF 
    481364      ! 
    482365      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl_crs.F90

    r5105 r5601  
    2828   USE phycst         ! physical constant 
    2929   USE eosbn2_crs     ! equation of state 
    30    USE trdmod_oce     ! trends: ocean variables 
     30   USE trd_oce        ! trends: ocean variables 
    3131   USE trdtra         ! trends: active tracers 
    3232   USE iom            ! IOM server                
     
    3838   USE crs 
    3939   USE crslbclnk 
    40    USE crsiom 
     40   USE crsfld 
    4141 
    4242 
     
    154154         ztrdt(:,:,:) = tsa_crs(:,:,:,jp_tem) - ztrdt(:,:,:) 
    155155         ztrds(:,:,:) = tsa_crs(:,:,:,jp_sal) - ztrds(:,:,:) 
    156          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt ) 
    157          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds ) 
     156         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
     157         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    158158         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
    159159      ENDIF 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90

    r5105 r5601  
    1919   !!                  the isopycnal or geopotential s-coord. operator  
    2020   !!---------------------------------------------------------------------- 
    21    USE oce             ! ocean dynamics and active tracers 
    22    USE dom_oce         ! ocean space and time domain 
    23    USE trc_oce         ! share passive tracers/Ocean variables 
    24    USE zdf_oce         ! ocean vertical physics 
    25    USE ldftra_oce      ! ocean active tracers: lateral physics 
    26  !  USE ldfslp          ! iso-neutral slopes 
     21!   USE oce             ! ocean dynamics and active tracers 
     22!   USE dom_oce         ! ocean space and time domain 
     23!   USE trc_oce         ! share passive tracers/Ocean variables 
     24!   USE zdf_oce         ! ocean vertical physics 
     25!   USE ldftra_oce      ! ocean active tracers: lateral physics 
     26!   USE ldfslp          ! iso-neutral slopes 
    2727   USE ldfslp_crs          ! iso-neutral slopes 
    2828   USE diaptr          ! poleward transport diagnostics 
     
    3535   USE wrk_nemo        ! Memory Allocation 
    3636   USE timing          ! Timing 
    37    USE crs 
     37!   USE crs 
     38   USE oce_trc 
     39   USE iom, ONLY : iom_put,iom_swap 
    3840 
    3941   IMPLICIT NONE 
     
    9496      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9597      !!---------------------------------------------------------------------- 
    96       USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace 
    9798      ! 
    9899      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     
    113114#endif 
    114115      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d 
    115       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw  
     116      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw , zftu,  zftv  
    116117      !!---------------------------------------------------------------------- 
    117118      ! 
     
    119120      ! 
    120121      CALL wrk_alloc( jpi, jpj,      zdkt, zdk1t, z2d )  
    121       CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw )  
     122      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw , zftu, zftv )  
    122123      ! 
    123124 
     
    149150            END DO 
    150151         END DO 
    151     !    WRITE(numout,*) ' test1 ', zdit 
    152 !cc commenté pour le test concluant de TMP16 --> pgu mauvais, correction dans 
    153 !zpshde_crs ( probleme de signe lorsque ze3wu negatif, de mem pour pgv) 
    154152         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level  
    155153            DO jj = 1, jpjm1 
     
    160158            END DO 
    161159         ENDIF 
    162 !cc 
    163      !   WRITE(numout,*) ' test2 ', zdit 
    164160 
    165161         !!---------------------------------------------------------------------- 
     
    183179            DO jj = 1 , jpjm1 
    184180               DO ji = 1, fs_jpim1   ! vector opt. 
    185    !               zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj) 
    186   zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj) 
    187  !               zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj) 
    188 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj) 
     181                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj) 
     182                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj) 
    189183 
    190184                  zmsku = 1. / MAX(  tmask_crs(ji+1,jj,jk  ) + tmask_crs(ji,jj,jk+1)   & 
     
    194188                     &             + tmask_crs(ji,jj+1,jk+1) + tmask_crs(ji,jj,jk  ), 1. ) 
    195189                  ! 
    196     !              zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk)) vue avec Gurvan OK 
    197                 zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk)) 
    198   !                zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))  vue avec Gurvan OK 
    199                 zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk)) 
    200            !        zcof1 = - fsahtu(ji,jj,jk) * e2u_crs(ji,jj) * uslp(ji,jj,jk) * zmsku 
    201            !        zcof2 = - fsahtv(ji,jj,jk) * e1v_crs(ji,jj) * vslp(ji,jj,jk) * zmskv   
     190                  zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk)) 
     191                  zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk)) 
    202192                  ! 
    203193                  zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   & 
     
    209199               END DO 
    210200            END DO 
     201            CALL iom_swap( "nemo_crs"  ) 
     202            CALL iom_put( "zftu" , zftu ) 
     203            CALL iom_put( "zftv" , zftv ) 
     204            CALL iom_swap( "nemo" ) 
    211205 
    212206            ! II.4 Second derivative (divergence) and add to the general trend 
     
    285279                  zcoef3 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmsku * wslpi_crs(ji,jj,jk) / e1t_crs(ji,jj) 
    286280                  zcoef4 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmskv * wslpj_crs(ji,jj,jk) / e2t_crs(ji,jj) 
    287            !       zcoef3 = zcoef0 * e2t_crs(ji,jj) * zmsku * wslpi (ji,jj,jk) 
    288            !       zcoef4 = zcoef0 * e1t_crs(ji,jj) * zmskv * wslpj (ji,jj,jk) 
    289281                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      & 
    290282                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   & 
     
    312304      ! 
    313305      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d )  
    314       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw )  
     306      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw , zftu, zftv )  
    315307      ! 
    316308      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r4990 r5601  
    290290         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
    291291      ELSE                           
    292          ll_tra     = .FALSE.          ! passive tracers case 
     292         ll_tra     = .FALSE.           ! passive tracers case 
    293293         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
    294294         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90

    r5105 r5601  
    7878      !! ** Action  : - pta  becomes the after tracer 
    7979      !!--------------------------------------------------------------------- 
    80       USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace 
    8180      ! 
    8281      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
     
    9089      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    9190      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt 
     91      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt,zwd,zws 
    9392      !!--------------------------------------------------------------------- 
    9493      ! 
    95 !WRITE(numout,*) 'test6456_trb_sbc1', pta(:,:,:,1), kt 
    96       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp') 
    97       ! 
    98       CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt )  
     94      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp_crs') 
     95      ! 
     96      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt, zwd, zws )  
    9997      ! 
    10098      IF( kt == kit000 )  THEN 
     
    121119            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 
    122120            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk) 
    123 #if defined key_zdfddm 
    124             ELSE                                            ;   zwt(:,:,2:jpk) = avs_crs(:,:,2:jpk) 
    125 #endif 
     121            ELSE                                            ;   zwt(:,:,2:jpk) = avt_crs(:,:,2:jpk) 
    126122            ENDIF 
    127123            zwt(:,:,1) = 0._wp 
     
    135131                     DO ji = fs_2, fs_jpim1   ! vector opt. 
    136132                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)  
    137     !                    WRITE(numout,*) 'ah_wslp2', ah_wslp2(ji,jj,jk)       
    138133                     END DO 
    139134                  END DO 
     
    152147 
    153148#endif 
    154 !WRITE(numout,*) 'test6456_trb_sbc2', pta(:,:,:,1), kt 
    155             ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    156 ! WRITE(numout,*) 'wslpi_crs', wslpi_crs(:,:,:) 
    157 ! WRITE(numout,*) 'wslpj_crs(ji,jj,jk-1)',wslpj_crs(:,:,:) 
    158 ! WRITE(numout,*) ' fsahtw',  fsahtw(:,:,:) 
    159  !WRITE(numout,*) 'ah_wslp2', ah_wslp2(:,:,:)  
    160 ! WRITE(numout,*) 'zwt2(ji,jj,jk-1)', zwt(:,:,:)  
    161  
    162149            DO jk = 1, jpkm1 
    163150               DO jj = 2, jpjm1 
    164151                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    165               !        ze3ta =  ( 1. - r_vvl ) +        r_vvl   * ocean_volume_crs_t(ji,jj,jk)   ! after scale factor at T-point 
    166              !         ze3tn =         r_vvl   + ( 1. - r_vvl ) * ocean_volume_crs_t(ji,jj,jk)   ! now   scale factor at T-point 
    167152                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * e3t_crs(ji,jj,jk)   ! after scale factor at T-point 
    168153                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * e3t_crs(ji,jj,jk)   ! now   scale factor at T-point 
    169                      zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_1d(jk  ) )  !cc 
    170                      zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_1d(jk+1) )  !cc 
     154                     !cbr zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_1d(jk  ) )  !cc 
     155                     !cbr zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_1d(jk+1) )  !cc 
     156                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_max_crs(ji,jj,jk) ) 
     157                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_max_crs(ji,jj,jk+1) ) 
    171158                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    172       !               WRITE(numout,*) 'ze3tn', ze3tn 
    173       !               WRITE(numout,*) 'e3w_0', e3w_0(jk) 
    174       !               WRITE(numout,*) 'ze3ta', ze3ta 
    175       !               WRITE(numout,*) 'zwt3(ji,jj,jk-1)', zwt(ji,jj,jk) 
    176159                 END DO 
    177160               END DO 
    178161            END DO 
    179   ! WRITE(numout,*) 'zwi(ji,jj,jk-1)', zwi(:,:,:) 
    180   ! WRITE(numout,*) 'zws(ji,jj,jk-1)', zws(:,:,:) 
    181   ! WRITE(numout,*) 'zwd(ji,jj,jk-1)', zwd(:,:,:)  
    182162            ! 
    183163            !! Matrix inversion from the first level 
     
    216196            ! 
    217197         END IF 
    218 ! WRITE(numout,*) 'zwt4(ji,jj,jk-1)', zwt(:,:,:)  
    219198         !     
    220 !WRITE(numout,*) 'test6456_trb_sbc4', pta(:,:,:,1), kt      
    221199         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    222200         DO jj = 2, jpjm1 
    223201            DO ji = fs_2, fs_jpim1 
    224            !     ze3tb = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,1) 
    225            !     ze3tn = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,1) 
    226202               ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1) 
    227203               ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1) 
    228204               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 
    229 !WRITE(numout,*) 'test6456_trb_sbc4', pta(:,:,:,1), kt  
    230             END DO 
    231          END DO 
    232  
    233 !WRITE(numout,*) 'kt', kt  
     205            END DO 
     206         END DO 
     207 
    234208         DO jk = 2, jpkm1 
    235209            DO jj = 2, jpjm1 
    236210               DO ji = fs_2, fs_jpim1 
    237            !        ze3tb = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,jk) 
    238            !        ze3tn = ( 1. - r_vvl ) + r_vvl * ocean_volume_crs_t(ji,jj,jk) 
    239211                  ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk) 
    240212                  ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk) 
     
    246218         END DO 
    247219 
    248 !WRITE(numout,*) 'test6456_trb_sbc5', pta(:,:,:,1), kt 
    249220         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer) 
    250221         DO jj = 2, jpjm1 
     
    267238      !                                               ! ================= ! 
    268239      ! 
    269 !WRITE(numout,*) 'test6456_trb_sbc6', pta(:,:,:,1), kt 
    270       CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwt )  
     240      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwt, zwd, zws )  
    271241      ! 
    272242      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp_crs') 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90

    r5105 r5601  
    103103      !!---------------------------------------------------------------------- 
    104104      ! 
    105       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde') 
     105      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_crs') 
    106106      ! 
    107107!!      CALL wrk_alloc( jpi, jpj,       zri, zrj, zhi, zhj )  
     
    128128               ! i- direction 
    129129               IF( ze3wu >= 0._wp ) THEN      ! case 1 
    130                   !cbr zmaxu =  ze3wu / e3w_max_crs(ji+1,jj,iku)   
    131                   zmaxu =  ze3wu 
    132                   IF( e3w_max_crs(ji+1,jj,iku) .NE. 0._wp ) zmaxu = zmaxu / e3w_max_crs(ji+1,jj,iku) 
     130                  zmaxu =  ze3wu / e3w_max_crs(ji+1,jj,iku)   
    133131                 !    zmaxu =  ze3wu / e3w_crs(ji+1,jj,iku) 
    134132                  ! interpolated values of tracers 
     
    137135                  pgtu(ji,jj,jn) = umask_crs(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    138136               ELSE                           ! case 2 
    139                   !cbr zmaxu = -ze3wu / e3w_max_crs(ji,jj,iku) 
    140                   zmaxu =  -ze3wu 
    141                   IF( e3w_max_crs(ji,jj,iku) .NE. 0._wp ) zmaxu = zmaxu / e3w_max_crs(ji,jj,iku) 
     137                  zmaxu = -ze3wu / e3w_max_crs(ji,jj,iku) 
    142138                 !    zmaxu = -ze3wu / e3w_crs(ji,jj,iku) 
    143139                  ! interpolated values of tracers 
     
    149145               ! j- direction 
    150146               IF( ze3wv >= 0._wp ) THEN      ! case 1 
    151                   !cbr zmaxv =  ze3wv / e3w_max_crs(ji,jj+1,ikv) 
    152                   zmaxv =  ze3wv 
    153                   IF( e3w_max_crs(ji,jj+1,ikv) .NE. 0._wp ) zmaxv =  zmaxv / e3w_max_crs(ji,jj+1,ikv) 
     147                  zmaxv =  ze3wv / e3w_max_crs(ji,jj+1,ikv) 
    154148               !      zmaxv =  ze3wv / e3w_crs(ji,jj+1,ikv) 
    155149                  ! interpolated values of tracers 
     
    158152                  pgtv(ji,jj,jn) = vmask_crs(ji,jj,1) * ( zte(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    159153               ELSE                           ! case 2 
    160                   !cbr zmaxv =  -ze3wv / e3w_max_crs(ji,jj,ikv) 
    161                   zmaxv =  -ze3wv 
    162                   IF( e3w_max_crs(ji,jj,ikv) .NE. 0._wp )zmaxv = zmaxv / e3w_max_crs(ji,jj,ikv) 
     154                  zmaxv =  -ze3wv / e3w_max_crs(ji,jj,ikv) 
    163155                !     zmaxv = -ze3wv / e3w_crs(ji,jj,ikv) 
    164156                  ! interpolated values of tracers 
     
    237229      DEALLOCATE( zri , zrj, zte, zhi, zhj, zti) 
    238230      ! 
    239       IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde') 
     231      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde_crs') 
    240232      ! 
    241233   END SUBROUTINE zps_hde_crs 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r4990 r5601  
    8383      REAL(wp) ::   zN2_c        ! local scalar 
    8484      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace 
     85      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d   ! 2D workspace 
    8586      !!---------------------------------------------------------------------- 
    8687      ! 
     
    8889      ! 
    8990      CALL wrk_alloc( jpi,jpj, imld ) 
     91      CALL wrk_alloc( jpi,jpj, z2d ) 
    9092 
    9193      IF( kt == nit000 ) THEN 
     
    135137         CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth 
    136138         CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth 
     139         z2d(:,:)=REAL(nmln,wp)  
     140         CALL iom_put( "nmln"  , z2d )   ! turbocline depth 
    137141      ENDIF 
    138142       
     
    140144      ! 
    141145      CALL wrk_dealloc( jpi,jpj, imld ) 
     146      CALL wrk_dealloc( jpi,jpj, z2d ) 
    142147      ! 
    143148      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl') 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90

    r5105 r5601  
    66   !! History :  1.0  ! 2003-08  (G. Madec)  original code 
    77   !!            3.2  ! 2009-07  (S. Masson, G. Madec)  IOM + merge of DO-loop 
     8   !!            3.7  ! 2012-03  (G. Madec)  make public the density criteria for trdmxl  
     9   !!             -   ! 2014-02  (F. Roquet)  mixed layer depth calculated using N2 instead of rhop  
    810   !!---------------------------------------------------------------------- 
    911   !!   zdf_mxl      : Compute the turbocline and mixed layer depths. 
    1012   !!---------------------------------------------------------------------- 
    11    USE oce             ! ocean dynamics and tracers variables 
    12    USE dom_oce         ! ocean space and time domain variables 
     13   !USE oce             ! ocean dynamics and tracers variables 
     14   !USE dom_oce         ! ocean space and time domain variables 
     15   !USE oce_trc 
    1316   USE zdf_oce         ! ocean vertical physics 
    1417   USE in_out_manager  ! I/O manager 
    1518   USE prtctl          ! Print control 
     19   USE phycst          ! physical constants 
    1620   USE iom             ! I/O library 
    1721   USE lib_mpp         ! MPP library 
     
    2630   PUBLIC   zdf_mxl_crs       ! called by step.F90 
    2731 
    28    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP) 
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m] 
    30    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m] 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m] 
     32   REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    3233 
    3334   !! * Substitutions 
     
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    37    !! $Id: zdfmxl.F90 3294 2012-01-28 16:44:18Z rblod $  
     38   !! $Id: zdfmxl.F90 4990 2014-12-15 16:42:49Z timgraham $  
    3839   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3940   !!---------------------------------------------------------------------- 
    4041CONTAINS 
    41  
    42    INTEGER FUNCTION zdf_mxl_alloc_crs() 
    43       !!---------------------------------------------------------------------- 
    44       !!               ***  FUNCTION zdf_mxl_alloc  *** 
    45       !!---------------------------------------------------------------------- 
    46       zdf_mxl_alloc_crs = 0      ! set to zero if no array to be allocated 
    47       IF( .NOT. ALLOCATED( nmln_crs ) ) THEN 
    48          ALLOCATE( nmln_crs(jpi_crs,jpj_crs), hmld_crs(jpi_crs,jpj_crs), hmlp_crs(jpi_crs,jpj_crs) & !! declaration in crs.F90 
    49          &       , hmlpt_crs(jpi_crs,jpj_crs), STAT= zdf_mxl_alloc_crs ) 
    50          ! 
    51          IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc_crs ) 
    52          IF( zdf_mxl_alloc_crs /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 
    53          ! 
    54       ENDIF 
    55    END FUNCTION zdf_mxl_alloc_crs 
    56  
    5742 
    5843   SUBROUTINE zdf_mxl_crs( kt ) 
     
    6550      !! ** Method  :   The mixed layer depth is the shallowest W depth with  
    6651      !!      the density of the corresponding T point (just bellow) bellow a 
    67       !!      given value defined locally as rho(10m) + zrho_c 
     52      !!      given value defined locally as rho(10m) + rho_c 
    6853      !!               The turbocline depth is the depth at which the vertical 
    6954      !!      eddy diffusivity coefficient (resulting from the vertical physics 
    7055      !!      alone, not the isopycnal part, see trazdf.F) fall below a given 
    71       !!      value defined locally (avt_c here taken equal to 5 cm/s2) 
     56      !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default) 
    7257      !! 
    7358      !! ** Action  :   nmln, hmld, hmlp, hmlpt 
    7459      !!---------------------------------------------------------------------- 
    7560      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    76       !! 
    77       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    78       INTEGER  ::   iikn, iiki          ! temporary integer within a do loop 
    79       INTEGER, POINTER, DIMENSION(:,:) ::   imld                ! temporary workspace 
    80       REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
    81       REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
     61      ! 
     62      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     63      INTEGER  ::   iiki,iikn   ! local integer 
     64      REAL(wp) ::   zN2_c        ! local scalar 
     65      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace 
    8266      !!---------------------------------------------------------------------- 
    8367      ! 
    84       IF( nn_timing == 1 )  CALL timing_start('zdf_mxl') 
     68      IF( nn_timing == 1 )  CALL timing_start('zdf_mxl_crs') 
    8569      ! 
    8670      CALL wrk_alloc( jpi_crs,jpj_crs, imld ) 
     
    8872      IF( kt == nit000 ) THEN 
    8973         IF(lwp) WRITE(numout,*) 
    90          IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth' 
     74         IF(lwp) WRITE(numout,*) 'zdf_mxl_crs : mixed layer depth' 
    9175         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    92          !                             ! allocate zdfmxl arrays 
    93          IF( zdf_mxl_alloc_crs() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' ) 
    9476      ENDIF 
    9577 
    96       ! w-level of the mixing and mixed layers 
    97       nmln_crs(:,:) = mbkt_crs(:,:) + 1        ! Initialization to the number of w ocean point 
    98       imld(:,:)     = mbkt_crs(:,:) + 1 
    99       DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10 
     78      ! w-level of the turbocline 
     79      imld(:,:)=0 
     80      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    10081         DO jj = 1, jpj_crs 
    10182            DO ji = 1, jpi_crs 
    102                IF( rhop_crs(ji,jj,jk) > rhop_crs(ji,jj,nla10) + zrho_c )   nmln_crs(ji,jj) = jk      ! Mixed layer 
    103         !       IF( avt (ji,jj,jk) < zavt_c                     )   imld(ji,jj) = jk      ! Turbocline  
     83               IF( avt_crs (ji,jj,jk) < avt_c )   imld(ji,jj) = MAX( jk, 1 )      ! Turbocline  
    10484            END DO 
    10585         END DO 
    10686      END DO 
     87 
    10788      ! depth of the mixing and mixed layers 
    108       !write(narea+2000,*)"nlb10 ",nlb10,SHAPE(hmlpt_crs),SHAPE(gdepw_crs) ; call flush(narea+2000) 
     89      hmld_crs(:,:) = 0._wp 
     90      hmlpt_crs(:,:) = 0._wp 
    10991      DO jj = 1, jpj_crs 
    11092         DO ji = 1, jpi_crs 
    111            ! iiki = imld(ji,jj) 
     93            iiki = imld(ji,jj) 
    11294            iikn = nmln_crs(ji,jj) 
    113             ! write(narea+2000,*)ji,jj,iikn,gdept_crs(ji,jj,iikn-1) ; call flush(narea+2000) 
    114        !     hmld (ji,jj) = gdepw_crs(ji,jj,iiki  ) * tmask_crs(ji,jj,1)    ! Turbocline depth  
    115             !IF( iikn .LT. 2 .OR. iikn .GT. jpk )write(narea+2000,*)"iikn ",ji,jj,iikn ; call flush(narea+2000) 
    116             hmlp_crs (ji,jj) = gdepw_crs(ji,jj,iikn  ) * tmask_crs(ji,jj,1)    ! Mixed layer depth 
    117             hmlpt_crs(ji,jj) = gdept_crs(ji,jj,iikn-1)                     ! depth of the last T-point inside the mixed layer 
     95            IF( iiki .NE. 0 ) hmld_crs (ji,jj) = ( gdepw_crs(ji,jj,iiki  ) - gdepw_crs(ji,jj,1 )            )   * tmask_crs(ji,jj,1)  ! Turbocline depth  
     96            IF( iiki .NE. 0 ) hmlpt_crs(ji,jj) = ( gdept_crs(ji,jj,iikn-1) - gdepw_crs(ji,jj,1 )            )   * tmask_crs(ji,jj,1)  ! depth of the last T-point inside the mixed layer 
    11897         END DO 
    11998      END DO 
    120       IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode 
    121   !       CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth 
    122    !      CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth 
    123       ENDIF 
    124        
    125     !  IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 
    12699      ! 
    127100      CALL wrk_dealloc( jpi_crs,jpj_crs, imld ) 
    128101      ! 
    129       IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl') 
     102      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl_crs') 
    130103      ! 
    131104   END SUBROUTINE zdf_mxl_crs 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5105 r5601  
    8282   USE crsini          ! initialise grid coarsening utility 
    8383   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     84   USE trabbl_crs 
    8485 
    8586   IMPLICIT NONE 
     
    114115      !!---------------------------------------------------------------------- 
    115116      INTEGER ::   istp       ! time step index 
     117      CHARACTER(len=20) :: cmd  
    116118      !!---------------------------------------------------------------------- 
    117119      ! 
     
    410412      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing 
    411413      ! 
    412       IF( ln_crs .AND. lk_ldfslp ) THEN 
     414      IF( ln_crs_top .AND. lk_ldfslp ) THEN 
    413415                            CALL dom_grid_crs 
    414416                            CALL ldf_slp_init_crs 
     
    420422      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    421423      ! 
    422       IF( ln_crs .AND. lk_trabbl     )  THEN 
     424      IF( ln_crs_top .AND. lk_trabbl     )  THEN 
    423425                            CALL dom_grid_crs  
    424426                            CALL tra_bbl_init_crs   ! advective (and/or diffusive) bottom boundary layer scheme 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5105 r5601  
    110110      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    111111      !  THERMODYNAMICS 
    112                          CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points 
    113                          CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points 
     112                         !cbr not used CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points 
     113                         !cbr not used CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points 
    114114                         CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 
    115115                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
     
    139139                         CALL zdf_mxl( kstp )         ! mixed layer depth 
    140140 
    141       IF(ln_crs)         CALL zdf_mxl_crs(kstp) 
    142141                                                      ! write TKE or GLS information in the restart file 
    143142      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
     
    154153                         CALL ldf_slp_grif( kstp ) 
    155154         ELSE 
     155                         CALL iom_put("rabt",rab_n(:,:,:,jp_tem)) 
     156                         CALL iom_put("rabs",rab_n(:,:,:,jp_sal)) 
     157                         CALL iom_put("rhd",rhd) 
     158                         CALL iom_put("rn2b",rn2b) 
    156159                         CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator 
    157160         ENDIF 
     
    228231      IF( ln_crs )   THEN 
    229232                         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) 
     233 
     234                         CALL eos_rab_crs( tsn_crs, rab_crs_n )       ! now    local thermal/haline expension ratio at T-points 
     235                         CALL bn2_crs    ( tsn_crs, rab_crs_n, rb2_crs  ) ! now    Brunt-Vaisala frequency 
     236                         CALL eos_crs ( tsn_crs, rhd_crs, rhop_crs, gdept_crs(:,:,:) ) ! now in situ density for hpg computation 
     237 
     238         IF( ln_zps )    CALL zps_hde_crs( kstp, jpts, tsb_crs, gtsu_crs, gtsv_crs, rhd_crs, gru_crs, grv_crs ) 
     239 
    234240         IF( lk_ldfslp .AND.  .NOT. ln_traldf_grif )  & 
    235241                         CALL ldf_slp_crs( kstp, rhd_crs, rb2_crs ) 
    236242                         CALL dom_grid_glo 
    237       ENDIF 
     243 
     244      ENDIF 
     245                         CALL zdf_mxl_crs(kstp) 
    238246 
    239247      IF( ln_crs_top )   CALL dom_grid_crs 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r2787 r5601  
    1616   USE trc 
    1717   USE trcsms_my_trc 
     18   USE dom_oce, ONLY : gdepw_1d,e3t_1d,nyear_len 
    1819 
    1920   IMPLICIT NONE 
     
    4445      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: initialisation of MY_TRC model' 
    4546      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     47 
     48      nlb_age = MINLOC( gdepw_1d, mask = gdepw_1d > age_depth, dim = 1  ) 
     49      nl_age = nlb_age - 1 
     50      nla_age = nl_age - 1 
     51      frac_kill_age = (age_depth - gdepw_1d(nl_age))/e3t_1d(nl_age) 
     52      frac_add_age = 1._wp -  frac_kill_age 
     53      rryear = 1._wp / ( nyear_len(1) * rday ) 
     54 
    4655       
     56      IF( .NOT. ln_rsttr ) trb(:,:,:,jp_myt0:jp_myt1) = 0. 
    4757      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0. 
    4858      ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r4990 r5601  
    2525   PUBLIC   trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module 
    2626 
     27   INTEGER , PUBLIC :: nl_age                         ! T level surrounding age_depth 
     28   INTEGER , PUBLIC :: nla_age                        ! T level wholly above age_depth 
     29   INTEGER , PUBLIC :: nlb_age                        ! T level wholly below age_depth 
     30 
     31   REAL(wp), PUBLIC ::   rryear                    !: recip number of seconds in one year 
     32   REAL(wp), PUBLIC ::   age_depth = 10.           !: depth over which age tracer reset to zero 
     33   REAL(wp), PUBLIC ::   age_kill_rate = -1./7200. !: recip of relaxation timescale (s) for  age tracer shallower than age_depth 
     34   REAL(wp), PUBLIC ::   frac_kill_age             !: fraction of level nl_age above age_depth where it is relaxed towards zero 
     35   REAL(wp), PUBLIC ::   frac_add_age              !: fraction of level nl_age below age_depth where it is incremented 
     36 
     37 
    2738   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc 
    2839 
     
    4455      ! 
    4556      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    46       INTEGER ::   jn   ! dummy loop index 
     57      INTEGER ::   jn, jk   ! dummy loop index 
    4758      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt 
    4859!!---------------------------------------------------------------------- 
     
    5667      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
    5768 
    58       WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) ) 
    59         trn(:,:,1,jpmyt1) = 1._wp 
    60         trb(:,:,1,jpmyt1) = 1._wp 
    61         tra(:,:,1,jpmyt1) = 0._wp 
    62       END WHERE 
    63  
     69      DO jk = 1, nla_age 
     70         tra(:,:,jk,jpmyt1) = age_kill_rate * trb(:,:,jk,jpmyt1) 
     71      ENDDO 
     72      ! 
     73      tra(:,:,nl_age,jpmyt1) = frac_kill_age * age_kill_rate * trb(:,:,nl_age,jpmyt1)  & 
     74          &                  + frac_add_age  * rryear * tmask(:,:,nl_age) 
     75      ! 
     76      DO jk = nlb_age, jpk 
     77         tra(:,:,jk,jpmyt1) = tmask(:,:,jk) * rryear 
     78      ENDDO 
     79      ! 
    6480      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 
    6581          DO jn = jp_myt0, jp_myt1 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r5105 r5601  
    1414   USE trc         ! passive tracers common variables  
    1515   USE oce_trc 
    16    USE crs, ONLY : ln_crs 
     16   USE crs, ONLY : ln_crs,ln_crs_top,ahtt_crs,ahtu_crs,ahtv_crs,ahtw_crs,jpi_crs,jpj_crs 
     17   USE iom, ONLY : iom_swap, iom_put 
    1718 
    1819   IMPLICIT NONE 
     
    3334      INTEGER              :: jn 
    3435      !!--------------------------------------------------------------------- 
    35       IF( ln_crs ) CALL iom_swap( "nemo_crs" ) 
     36      IF( ln_crs_top ) CALL iom_swap( "nemo_crs" ) 
     37 
     38      CALL iom_put("ahtt_crs",ahtt_crs) 
     39      CALL iom_put("ahtu_crs",ahtu_crs) 
     40      CALL iom_put("ahtv_crs",ahtv_crs) 
     41      CALL iom_put("ahtw_crs",ahtw_crs) 
     42 
    3643  
    3744      ! write the tracer concentrations in the file 
     
    4047         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    4148         IF( lk_vvl ) THEN 
    42             CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) ) 
     49            CALL iom_put( TRIM(cltra), trn(:,:,:,jn) * fse3t_n(:,:,:) ) 
    4350         ELSE 
    4451            CALL iom_put( TRIM(cltra), trn(:,:,:,jn) ) 
     
    4653      END DO 
    4754      ! 
    48       IF( ln_crs ) CALL iom_swap( "nemo" ) 
     55      IF( ln_crs_top ) CALL iom_swap( "nemo" ) 
    4956      ! 
    5057   END SUBROUTINE trc_wri_my_trc 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r4610 r5601  
    1616   USE oce_trc         ! ocean dynamics and active tracers 
    1717   USE trc             ! ocean passive tracers variables 
     18   USe domvvl 
    1819   USE trcnam_trp      ! passive tracers transport namelist variables 
    1920   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl_crs.F90

    r5105 r5601  
    2525   USE trabbl_crs              !  
    2626   USE prtctl_trc          ! Print control for debbuging 
    27    USE trdmod_oce 
     27   USE trd_oce 
    2828   USE trdtra 
    2929 
     
    9595        DO jn = 1, jptra 
    9696           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    97            CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
     97           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    9898        END DO 
    9999        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_crs.F90

    r5105 r5601  
    2525   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    2626   USE traldf_lap_crs      ! lateral mixing            (tra_ldf_lap routine) 
    27    USE trdmod_oce 
     27   USE trd_oce 
    2828   USE trdtra 
    2929   USE prtctl_trc      ! Print control 
     
    8383                          CALL tra_ldf_iso_crs     ( kt, nittrc000, 'TRC', gtru ,gtrv , trb, tra, jptra, rn_ahtb_0 ) 
    8484                       ENDIF 
    85       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian 
     85      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )  ! iso-level bilaplacian 
    8686      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
    8787         ! 
     
    9797         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    9898                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    99          CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
     99         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            ) 
    100100         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    101101                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     
    108108        DO jn = 1, jptra 
    109109           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    110            CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
     110           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    111111        END DO 
    112112        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r4990 r5601  
    9595         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    9696         !                                             ! add the trend to the general tracer trend 
    97          DO jj = 2, jpj 
    98             DO ji = fs_2, fs_jpim1   ! vector opt. 
    99                zse3t = 1. / fse3t(ji,jj,1) 
    100                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
     97         IF( lk_vvl ) THEN  ! online coupling with vvl 
     98 
     99             
     100            DO jj = 2, jpj 
     101               DO ji = fs_2, fs_jpim1   ! vector opt. 
     102                  zse3t = 1. / fse3t(ji,jj,1) 
     103                  tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
     104               END DO 
    101105            END DO 
    102          END DO 
    103           
     106         ELSE 
     107            DO jj = 2, jpj 
     108               DO ji = fs_2, fs_jpim1   ! vector opt. 
     109                  zse3t = 1. / fse3t(ji,jj,1) 
     110                  tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
     111               END DO 
     112            END DO 
     113         ENDIF 
     114 
    104115         IF( l_trdtrc ) THEN 
    105116            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc_crs.F90

    r5105 r5601  
    1919   USE trc             ! ocean  passive tracers variables 
    2020   USE prtctl_trc      ! Print control for debbuging 
    21    USE trdmod_oce 
     21   USE trd_oce 
    2222   USE trdtra 
    2323!cbr   USE crs 
     
    101101         IF( l_trdtrc ) THEN 
    102102            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    103             CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd ) 
     103            CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 
    104104         END IF 
    105105         !                                                       ! =========== 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r5105 r5601  
    3535   USE zpshde_crs      ! partial step: hor. derivative       (zps_hde routine) 
    3636   USE dom_oce , ONLY : ln_crs 
    37    USe crs, ONLY : jpi_crs,jpj_crs,wn_crs !cbr 
     37   USE crs     , ONLY : jpi_crs,jpj_crs,wn_crs,ln_crs_top !cbr 
     38   USE ldfslp_crs 
    3839 
    3940#if defined key_agrif 
     
    7576      IF( .NOT. lk_c1d ) THEN 
    7677         ! 
    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 ) 
     78         IF( ln_crs_top ) THEN ;    CALL trc_sbc_crs( kstp ) 
     79         ELSE              ;    CALL trc_sbc( kstp ) 
     80         ENDIF 
     81         IF( ln_crs_top ) THEN ;    CALL trc_bbl_crs( kstp ) 
    8382         ELSE              ;    CALL trc_bbl( kstp ) 
    8483         ENDIF 
    8584         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    86 !         CALL test(kstp,3) 
    8785 
    88          IF( ln_crs ) THEN ;    CALL trc_adv_crs( kstp ) 
     86         IF( ln_crs_top ) THEN ;    CALL trc_adv_crs( kstp ) 
    8987         ELSE              ;    CALL trc_adv( kstp ) 
    9088         ENDIF 
    91 !         CALL test(kstp,4) 
    9289 
    9390         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    94          IF( ln_crs ) THEN ;    CALL trc_ldf_crs( kstp ) 
     91         IF( ln_crs_top ) THEN ;    CALL trc_ldf_crs( kstp ) 
    9592         ELSE              ;    CALL trc_ldf( kstp ) 
    9693         ENDIF 
    97 !         CALL test(kstp,5) 
    9894         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    9995            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
     
    10197         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge 
    10298#endif 
    103          IF( ln_crs ) THEN ;    CALL trc_zdf_crs( kstp ) 
     99         IF( ln_crs_top ) THEN ;    CALL trc_zdf_crs( kstp ) 
    104100         ELSE              ;    CALL trc_zdf( kstp ) 
    105101         ENDIF 
    106 !         CALL test(kstp,6) 
    107102                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
    108 !         CALL test(kstp,7) 
    109103         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
    110104 
     
    112106      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only 
    113107#endif 
    114          IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 
     108          ! Partial steps: now horizontal gradient of passive 
    115109         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 ) 
     110         IF( ln_crs_top ) THEN ;    CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv ) 
     111         ELSE              ;    CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi ) 
    118112         ENDIF 
    119113         ENDIF 
     
    136130   INTEGER,INTENT(IN) :: kt,i 
    137131   REAL(wp)::zmin,zmax 
    138    INTEGER :: ji,jj,jk 
     132   INTEGER :: ii,jj,kk 
    139133   zmin=MINVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 
    140134   zmax=MAXVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
     
    146140   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
    147141   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    
     142   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,30,1),mask=(tmask(2:jpi-1,2:jpj-1,30)==1)) ; CALL mpp_min(zmin) 
     143   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,30,1),mask=(tmask(2:jpi-1,2:jpj-1,30)==1)) ; CALL mpp_max(zmax) 
    154144 
    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     
    165145   END SUBROUTINE test 
    166146#else 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_crs.F90

    r5105 r5601  
    1919   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    2020   USE trazdf_imp_crs      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    21    USE trdmod_oce 
     21   USE trd_oce 
    2222   USE trdtra 
    2323   USE prtctl_trc      ! Print control 
     24   USE timing 
    2425 
    2526   IMPLICIT NONE 
     
    7273      ! 
    7374      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options 
    74  
    75 #if ! defined key_pisces 
    76       IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    77          r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    78       ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
    79          r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     75!cbr bug 
     76!#if ! defined key_pisces 
     77!      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
     78!         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
     79!      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
     80!         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     81!      ENDIF 
     82!#else 
     83!      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping) 
     84!#endif 
     85      IF( ln_top_euler) THEN 
     86         r2dt(:) =  rdttrc(:)              ! = rdttrc (use Euler time stepping) 
     87      ELSE 
     88         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
     89            r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
     90         ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
     91            r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     92         ENDIF 
    8093      ENDIF 
    81 #else 
    82       r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping) 
    83 #endif 
    8494 
    8595      IF( l_trdtrc )  THEN 
     
    98108      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    99109      CASE ( 1 ) ;  CALL tra_zdf_imp_crs( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
    100  
    101110      END SELECT 
    102111 
     
    106115               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 
    107116            END DO 
    108             CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) ) 
     117            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 
    109118         END DO 
    110119         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5105 r5601  
    142142   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa ) 
    143143   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) 
     144   USE crs , ONLY :   rhd     =>    rhd_crs    !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     145   USE crs , ONLY :   rn2b    =>    rb2_crs     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     146   USE crs , ONLY :   rab_n   =>    rab_crs_n     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    145147   USE crs , ONLY :   hdivn   =>    hdivn_crs   !: horizontal divergence (1/s) 
    146148   USE crs , ONLY :   hdivb   =>    hdivb_crs   !: horizontal divergence (1/s) 
     
    160162   USE crs , ONLY :   rnf        =>    rnf_crs        !: river runoff   [Kg/m2/s] 
    161163   USE crs , ONLY :   fr_i       =>    fr_i_crs       !: ice fraction (between 0 to 1) 
     164   USE trcnam_trp , ONLY :  aht0     =>   rn_ahtrc_0        !: horizontal eddy diffusivity for tracers (m2/s) 
     165   USE crs , ONLY :  ahtu     =>   ahtu_crs        !: lateral diffusivity coef. at u-points  
     166   USE crs , ONLY :  ahtv     =>   ahtv_crs        !: lateral diffusivity coef. at v-points  
     167   USE crs , ONLY :  ahtw     =>   ahtw_crs        !: lateral diffusivity coef. at w-points  
     168   USE crs , ONLY :  ahtt     =>   ahtt_crs        !: lateral diffusivity coef. at t-points 
     169   USE ldftra_oce , ONLY :  rldf     =>   rldf 
    162170 
    163171   USE crs , ONLY :   avt        =>   avt_crs         !: vert. diffusivity coef. at w-point for temp   
     
    177185  !* direction of lateral diffusion * 
    178186#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 
     187   USE crs , ONLY :   uslp       =>   uslp_crs         !: i-direction slope at u-, w-points 
     188   USE crs , ONLY :   vslp       =>   vslp_crs         !: j-direction slope at v-, w-points 
     189   USE crs , ONLY :   wslpi      =>   wslpi_crs        !: i-direction slope at u-, w-points 
     190   USE crs , ONLY :   wslpj      =>   wslpj_crs        !: j-direction slope at v-, w-points