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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    • Property svn:keywords set to Id
    r4149 r6225  
    1111   !!                       other variables needed to be passed to TOP 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers  
    14    USE dom_oce         ! ocean space and time domain 
    15    USE ldftra_oce      ! ocean active tracers: lateral physics 
    16    USE sbc_oce         ! Surface boundary condition: ocean fields 
    17    USE zdf_oce         ! vertical  physics: ocean fields 
    18    USE zdfddm          ! vertical  physics: double diffusion 
    19    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    20    USE in_out_manager  ! I/O manager 
    21    USE timing          ! preformance summary 
    22    USE wrk_nemo        ! working array 
    2313   USE crs 
    2414   USE crsdom 
    2515   USE crslbclnk 
    26    USE iom 
     16   USE oce             ! ocean dynamics and tracers  
     17   USE dom_oce         ! ocean space and time domain 
     18   USE sbc_oce         ! Surface boundary condition: ocean fields 
     19   USE zdf_oce         ! vertical  physics: ocean fields 
     20   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients 
     21   USE zdfddm          ! vertical  physics: double diffusion 
     22   ! 
     23   USE in_out_manager  ! I/O manager 
     24   USE iom             !  
     25   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     26   USE timing          ! preformance summary 
     27   USE wrk_nemo        ! working array 
    2728 
    2829   IMPLICIT NONE 
    … …  
    3132   PUBLIC   crs_fld                 ! routines called by step.F90 
    3233 
    33  
    3434   !! * Substitutions 
    35 #  include "zdfddm_substitute.h90" 
    36 #  include "domzgr_substitute.h90" 
    3735#  include "vectopt_loop_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    40    !! $Id $ 
     37   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     38   !! $Id$ 
    4139   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4240   !!---------------------------------------------------------------------- 
    … …  
    5250      !!      2. At time of output, rescale [1] by dimension and time 
    5351      !!         to yield the spatial and temporal average. 
    54       !!  See. diawri_dimg.h90, sbcmod.F90 
     52      !!  See. sbcmod.F90 
    5553      !! 
    5654      !! ** Method  :   
    5755      !!---------------------------------------------------------------------- 
    58       !! 
    59        
    60       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    61       !! 
    62       INTEGER               ::   ji, jj, jk              ! dummy loop indices 
    63       !! 
    64       REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 
    65       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs  
    66       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 
    67       REAL(wp)       :: z2dcrsu, z2dcrsv 
    68       !! 
    69        !!---------------------------------------------------------------------- 
     56      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     57      ! 
     58      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
     59      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   
     64      !!---------------------------------------------------------------------- 
    7065      !  
    71  
    7266      IF( nn_timing == 1 )   CALL timing_start('crs_fld') 
    7367 
    7468      !  Initialize arrays 
    75       CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    76       CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    77       CALL wrk_alloc( jpi, jpj, jpk, zt, zs       ) 
    78       ! 
    79       CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     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 ) 
    8074 
    8175      ! Depth work arrrays 
    82       zfse3t(:,:,:) = fse3t(:,:,:) 
    83       zfse3u(:,:,:) = fse3u(:,:,:) 
    84       zfse3v(:,:,:) = fse3v(:,:,:) 
    85       zfse3w(:,:,:) = fse3w(:,:,:) 
     76      ze3t(:,:,:) = e3t_n(:,:,:) 
     77      ze3u(:,:,:) = e3u_n(:,:,:) 
     78      ze3v(:,:,:) = e3v_n(:,:,:) 
     79      ze3w(:,:,:) = e3w_n(:,:,:) 
    8680 
    8781      IF( kt == nit000  ) THEN 
    … …  
    111105      !  Temperature 
    112106      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp 
    113       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     107      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
    114108      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    115109 
    … …  
    120114      !  Salinity 
    121115      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
    122       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     116      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
    123117      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    124118 
    … …  
    127121 
    128122      !  U-velocity 
    129       CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     123      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    130124      ! 
    131125      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    138132         END DO 
    139133      END DO 
    140       CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    141       CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     134      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     135      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    142136 
    143137      CALL iom_put( "uoce"  , un_crs )   ! i-current  
    … …  
    146140 
    147141      !  V-velocity 
    148       CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     142      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    149143      !                                                                                  
    150144      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    157151         END DO 
    158152      END DO 
    159       CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    160       CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     153      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     154      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    161155  
    162156      CALL iom_put( "voce"  , vn_crs )   ! i-current  
    … …  
    166160      
    167161      !  Kinetic energy 
    168       CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     162      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
    169163      CALL iom_put( "eken", rke_crs ) 
    170164 
    171       !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 )  
     165      !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 )  
    172166      DO jk = 1, jpkm1 
    173167         DO ji = 2, jpi_crsm1 
    … …  
    192186      IF( ln_crs_wn ) THEN 
    193187         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 
    194        !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w ) 
     188       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 
    195189      ELSE 
    196190        wn_crs(:,:,jpk) = 0._wp 
    … …  
    203197 
    204198      !  avt, avs 
     199!!gm BUG   TOP always uses avs !!! 
    205200      SELECT CASE ( nn_crs_kz ) 
    206201         CASE ( 0 ) 
    207             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     202            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    208203         CASE ( 1 ) 
    209             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     204            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    210205         CASE ( 2 ) 
    211             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     206            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    212207      END SELECT 
    213208      ! 
    … …  
    215210       
    216211      !  sbc fields   
    217       CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )   
     212      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 )   
    218213      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 ) 
    219214      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 ) 
    … …  
    237232 
    238233      !  free memory 
    239       CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    240       CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    241       CALL wrk_dealloc( jpi, jpj, jpk, zt, zs       ) 
    242       CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     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 ) 
    243238      ! 
    244239      CALL iom_swap( "nemo" )     ! return back on high-resolution grid 
Note: See TracChangeset for help on using the changeset viewer.