New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

Ignore:
Timestamp:
2017-12-13T15:58:53+01:00 (6 years ago)
Author:
timgraham
Message:

Merge of dev_CNRS_2017 into branch

Location:
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r6140 r9019  
    140140      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields 
    141141      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs 
    142       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs 
     142      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs 
    143143      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs     
    144144      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs     
    … …  
    151151 
    152152      ! Vertical diffusion 
    153       REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp   
    154 # if defined key_zdfddm 
    155       REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point 
    156 # endif 
     153      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: temperature vertical diffusivity coeff. [m2/s] at w-point 
     154      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity    vertical diffusivity coeff. [m2/s] at w-point 
    157155 
    158156      ! Mixing and Mixed Layer Depth 
    … …  
    230228 
    231229 
    232       ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , & 
    233          &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),& 
    234          &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11)) 
     230      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs   (jpi_crs,jpj_crs,jpk) ,     & 
     231         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(11)) 
    235232 
    236233     ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 
    … …  
    239236         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  ) 
    240237 
    241      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    & 
    242 # if defined key_zdfddm 
    243          &      avs_crs(jpi_crs,jpj_crs,jpk),    & 
    244 # endif 
    245          &      STAT=ierr(13) ) 
     238     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),   & 
     239         &                                        avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) ) 
    246240 
    247241      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , & 
    248242         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 
    249243          
    250       ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), & 
    251        &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
    252                 njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), & 
    253        &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) ) 
    254  
    255           
     244      ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij),   & 
     245         &      nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
     246                njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij),   & 
     247         &      njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) ) 
     248    
    256249      crs_dom_alloc = MAXVAL(ierr) 
    257  
     250      ! 
    258251   END FUNCTION crs_dom_alloc 
    259252 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r7646 r9019  
    18951895      jpjglo_crsm1 = jpjglo_crs - 1   
    18961896 
    1897       jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci 
    1898       jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj    
     1897      jpi_crs = ( jpiglo_crs   - 2 * nn_hls + (jpni-1) ) / jpni + 2 * nn_hls 
     1898      jpj_crs = ( jpjglo_crsm1 - 2 * nn_hls + (jpnj-1) ) / jpnj + 2 * nn_hls    
    18991899               
    19001900      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors   
    … …  
    19401940              CASE ( -1 ) 
    19411941                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    1942                 nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
     1942                nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls 
    19431943                nldjt_crs(jn) = nldjt(jn) 
    19441944               
    … …  
    19471947                nldjt_crs(jn) = nldjt(jn) 
    19481948                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    1949                 nlejt_crs(jn) = nlejt_crs(jn) + jprecj 
    1950                 nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
     1949                nlejt_crs(jn) = nlejt_crs(jn) + nn_hls 
     1950                nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls 
    19511951                 
    19521952              CASE ( 1, 2 ) 
    19531953               
    1954                 nlejt_crs(jn) = nlejt_crs(jn) + jprecj 
     1954                nlejt_crs(jn) = nlejt_crs(jn) + nn_hls 
    19551955                nlcjt_crs(jn) = nlejt_crs(jn) 
    19561956                nldjt_crs(jn) = nldjt(jn) 
    … …  
    19901990           SELECT CASE( ibonit(jn) ) 
    19911991              CASE ( -1 ) 
    1992                  nleit_crs(jn) = nleit_crs(jn) + jpreci            
    1993                  nlcit_crs(jn) = nleit_crs(jn) + jpreci 
     1992                 nleit_crs(jn) = nleit_crs(jn) + nn_hls            
     1993                 nlcit_crs(jn) = nleit_crs(jn) + nn_hls 
    19941994                 nldit_crs(jn) = nldit(jn)  
    19951995               
    19961996              CASE ( 0 ) 
    1997                  nleit_crs(jn) = nleit_crs(jn) + jpreci 
    1998                  nlcit_crs(jn) = nleit_crs(jn) + jpreci 
     1997                 nleit_crs(jn) = nleit_crs(jn) + nn_hls 
     1998                 nlcit_crs(jn) = nleit_crs(jn) + nn_hls 
    19991999                 nldit_crs(jn) = nldit(jn)  
    20002000                 
    20012001              CASE ( 1, 2 ) 
    20022002                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1 
    2003                  nleit_crs(jn) = nleit_crs(jn) + jpreci 
     2003                 nleit_crs(jn) = nleit_crs(jn) + nn_hls 
    20042004                 nlcit_crs(jn) = nleit_crs(jn) 
    20052005                 nldit_crs(jn) = nldit(jn)  

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r6140 r9019  
    133133       
    134134      tmask_i_crs(:,:) = tmask_crs(:,:,1) 
    135       iif = jpreci 
    136       iil = nlci_crs - jpreci + 1 
    137       ijf = jpreci 
    138       ijl = nlcj_crs - jprecj + 1 
     135      iif = nn_hls 
     136      iil = nlci_crs - nn_hls + 1 
     137      ijf = nn_hls 
     138      ijl = nlcj_crs - nn_hls + 1 
    139139      
    140140      tmask_i_crs( 1:iif ,    :  ) = 0._wp 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r6140 r9019  
    2525   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2626   USE timing          ! preformance summary 
    27    USE wrk_nemo        ! working array 
    2827 
    2928   IMPLICIT NONE 
    … …  
    5857      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    5958      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars 
    60       ! 
    61       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3 
    62       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs 
    63       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs   
     59      REAL(wp) ::   zztmp             !   -      - 
     60      ! 
     61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zt  , zs  , z3d 
     63      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) ::   zt_crs, zs_crs   
    6464      !!---------------------------------------------------------------------- 
    6565      !  
    6666      IF( nn_timing == 1 )   CALL timing_start('crs_fld') 
    67  
    68       !  Initialize arrays 
    69       CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3w ) 
    70       CALL wrk_alloc( jpi,jpj,jpk,   ze3u, ze3v ) 
    71       CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs   ) 
    72       ! 
    73       CALL wrk_alloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs ) 
    7467 
    7568      ! Depth work arrrays 
    … …  
    8477         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity 
    8578         wn_crs   (:,:,:  ) = 0._wp    ! w 
    86          avt_crs  (:,:,:  ) = 0._wp    ! avt 
     79         avs_crs  (:,:,:  ) = 0._wp    ! avt 
    8780         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv 
    88          rke_crs  (:,:,:  ) = 0._wp    ! rke 
    8981         sshn_crs (:,:    ) = 0._wp    ! ssh 
    9082         utau_crs (:,:    ) = 0._wp    ! taux 
    … …  
    158150      CALL iom_put( "voces" , zs_crs )   ! vS 
    159151 
    160       
    161       !  Kinetic energy 
    162       CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
    163       CALL iom_put( "eken", rke_crs ) 
    164  
     152      IF( iom_use( "eken") ) THEN     !      kinetic energy 
     153         z3d(:,:,jk) = 0._wp  
     154         DO jk = 1, jpkm1 
     155            DO jj = 2, jpjm1 
     156               DO ji = fs_2, fs_jpim1   ! vector opt. 
     157                  zztmp  = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     158                  z3d(ji,jj,jk) = 0.25_wp * zztmp * (                                    & 
     159                     &            un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   & 
     160                     &          + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   & 
     161                     &          + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   & 
     162                     &          + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   ) 
     163               END DO 
     164            END DO 
     165         END DO 
     166         CALL lbc_lnk( z3d, 'T', 1. ) 
     167         ! 
     168         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
     169         CALL iom_put( "eken", zt_crs ) 
     170      ENDIF 
    165171      !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 )  
    166172      DO jk = 1, jpkm1 
    … …  
    175181                   hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)  
    176182               ENDIF 
    177             ENDDO 
    178          ENDDO 
    179       ENDDO 
     183            END DO 
     184         END DO 
     185      END DO 
    180186      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 ) 
    181187      ! 
    … …  
    196202      !  free memory 
    197203 
    198       !  avt, avs 
    199 !!gm BUG   TOP always uses avs !!! 
     204      !  avs 
    200205      SELECT CASE ( nn_crs_kz ) 
    201206         CASE ( 0 ) 
    202207            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     208            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    203209         CASE ( 1 ) 
    204210            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     211            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    205212         CASE ( 2 ) 
    206213            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     214            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    207215      END SELECT 
    208216      ! 
    209       CALL iom_put( "avt", avt_crs )   !  Kz 
     217      CALL iom_put( "avt", avt_crs )   !  Kz on T 
     218      CALL iom_put( "avs", avs_crs )   !  Kz on S 
    210219       
    211220      !  sbc fields   
    … …  
    231240      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output  
    232241 
    233       !  free memory 
    234       CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3w ) 
    235       CALL wrk_dealloc( jpi,jpj,jpk,   ze3u, ze3v ) 
    236       CALL wrk_dealloc( jpi,jpj,jpk,   zt  , zs   ) 
    237       CALL wrk_dealloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs ) 
    238242      ! 
    239243      CALL iom_swap( "nemo" )     ! return back on high-resolution grid 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r7646 r9019  
    250250      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w ) 
    251251      ! 
     252      IF( nn_timing == 1 )  CALL timing_stop('crs_init') 
     253      ! 
    252254   END SUBROUTINE crs_init 
    253255     

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    r6140 r9019  
    1515    
    1616   INTERFACE crs_lbc_lnk 
    17       MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d 
     17      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d 
    1818   END INTERFACE 
    1919    
    … …  
    4949      ll_grid_crs = ( jpi == jpi_crs ) 
    5050      ! 
    51       IF( PRESENT(pval) ) THEN  ;  zval = pval 
    52       ELSE                      ;  zval = 0._wp 
     51      IF( PRESENT(pval) ) THEN   ;   zval = pval 
     52      ELSE                       ;   zval = 0._wp 
    5353      ENDIF 
    5454      ! 
    5555      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    5656      ! 
    57       IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  ) 
    58       ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  ) 
     57      IF( PRESENT( cd_mpp ) ) THEN   ;  CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  ) 
     58      ELSE                           ;   CALL lbc_lnk( pt3d1, cd_type1, psgn        , pval=zval  ) 
    5959      ENDIF 
    6060      ! 
    … …  
    6262      ! 
    6363   END SUBROUTINE crs_lbc_lnk_3d 
    64     
    65     
    66    SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    67       !!--------------------------------------------------------------------- 
    68       !!                  ***  SUBROUTINE crs_lbc_lnk  *** 
    69       !! 
    70       !! ** Purpose :   set lateral boundary conditions for coarsened grid 
    71       !! 
    72       !! ** Method  :   Swap domain indices from full to coarse domain 
    73       !!                before arguments are passed directly to lbc_lnk. 
    74       !!                Upon exiting, switch back to full domain indices. 
    75       !!---------------------------------------------------------------------- 
    76       CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type 
    77       REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign 
    78       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied 
    79       ! 
    80       LOGICAL ::   ll_grid_crs 
    81       !!---------------------------------------------------------------------- 
    82       ! 
    83       ll_grid_crs = ( jpi == jpi_crs ) 
    84       ! 
    85       IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    86       ! 
    87       CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  ) 
    88       ! 
    89       IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    90       ! 
    91    END SUBROUTINE crs_lbc_lnk_3d_gather 
    92  
    9364    
    9465    
    … …  
    11586      ll_grid_crs = ( jpi == jpi_crs ) 
    11687      ! 
    117       IF( PRESENT(pval) ) THEN  ;  zval = pval 
    118       ELSE                      ;  zval = 0._wp 
     88      IF( PRESENT(pval) ) THEN   ;   zval = pval 
     89      ELSE                       ;   zval = 0._wp 
    11990      ENDIF 
    12091      ! 
    12192      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    12293      ! 
    123       IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
    124       ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  ) 
     94      IF( PRESENT( cd_mpp ) ) THEN   ;  CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
     95      ELSE                           ;   CALL lbc_lnk( pt2d, cd_type, psgn        , pval=zval  ) 
    12596      ENDIF 
    12697      ! 
Note: See TracChangeset for help on using the changeset viewer.