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 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/CRS
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r5215 r6140  
    1111   USE in_out_manager 
    1212 
    13  
    1413   IMPLICIT NONE 
    1514   PUBLIC 
    1615 
    17     
    1816   PUBLIC crs_dom_alloc  ! Called from crsini.F90 
    1917   PUBLIC crs_dom_alloc2  ! Called from crsini.F90 
     
    161159      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                        
    162160 
    163       ! Direction of lateral diffusion 
    164  
    165  
     161   !!---------------------------------------------------------------------- 
     162   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    166163   !! $Id$ 
     164   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     165   !!---------------------------------------------------------------------- 
    167166CONTAINS 
    168167    
     
    258257 
    259258   END FUNCTION crs_dom_alloc 
    260     
     259 
     260 
    261261   INTEGER FUNCTION crs_dom_alloc2() 
    262262      !!------------------------------------------------------------------- 
     
    272272      crs_dom_alloc2 = MAXVAL(ierr) 
    273273 
    274       END FUNCTION crs_dom_alloc2 
     274   END FUNCTION crs_dom_alloc2 
     275 
    275276 
    276277   SUBROUTINE dom_grid_glo 
     
    312313   END SUBROUTINE dom_grid_glo 
    313314 
     315 
    314316   SUBROUTINE dom_grid_crs 
    315317      !!-------------------------------------------------------------------- 
     
    318320      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain 
    319321      !!--------------------------------------------------------------------- 
    320  
    321322      ! 
    322323      !                        Switch to coarse grid domain 
     
    349350      nlejt(:)  = nlejt_crs(:) 
    350351      njmppt(:) = njmppt_crs(:) 
    351  
    352  
    353352      ! 
    354353   END SUBROUTINE dom_grid_crs 
    355354    
    356        
    357355   !!====================================================================== 
    358  
    359356END MODULE crs 
    360357 
  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r5302 r6140  
    3030   !!       Original.   May 2012.  (J. Simeon, C. Calone, G. Madec, C. Ethe) 
    3131   !!=================================================================== 
    32  
    3332   USE dom_oce        ! ocean space and time domain and to get jperio 
    34    USE wrk_nemo       ! work arrays 
    3533   USE crs            ! domain for coarse grid 
     34   ! 
    3635   USE in_out_manager  
    3736   USE par_kind 
    3837   USE crslbclnk 
     38   USE wrk_nemo       ! work arrays 
    3939   USE lib_mpp 
    40     
    4140 
    4241   IMPLICIT NONE 
     
    5453   REAL(wp) :: r_inf = 1e+36 
    5554 
    56    !! Substitutions 
    57 #  include "domzgr_substitute.h90" 
    58     
     55   !!---------------------------------------------------------------------- 
     56   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5957   !! $Id$ 
     58   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     59   !!---------------------------------------------------------------------- 
    6060CONTAINS 
    61  
    6261 
    6362   SUBROUTINE crs_dom_msk 
     
    133132   END SUBROUTINE crs_dom_msk 
    134133 
     134 
    135135   SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs ) 
    136136      !!---------------------------------------------------------------- 
     
    334334      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V) 
    335335      !!              cd_op       = applied operation (SUM, VOL, WGT) 
    336       !!              p_fse3      = (Optional) parent grid vertical level thickness (fse3u or fse3v) 
     336      !!              p_e3      = (Optional) parent grid vertical level thickness (e3u or e3v) 
    337337      !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid 
    338338      !!              p_cfield2d_2 = (Optional) 2D field on coarse grid 
     
    342342      !! History.     4 Jun.  Write for WGT and scale factors only 
    343343      !!---------------------------------------------------------------- 
    344       !!  
    345       !!  Arguments 
    346       CHARACTER(len=1),                         INTENT(in)  :: cd_type  ! grid type U,V  
    347       REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_mask  ! Parent grid U,V mask 
    348       REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1) 
    349       REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2) 
    350       REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
    351  
    352       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity  
    353       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity  
    354  
    355       !! Local variables 
    356       REAL(wp)                                :: zdAm 
    357       INTEGER                                 :: ji, jj, jk , ii, ij, je_2 
    358  
    359       REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol, zmask       
     344      CHARACTER(len=1),                         INTENT(in   ) ::   cd_type    ! grid type U,V  
     345      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_mask     ! Parent grid U,V mask 
     346      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e1       ! Parent grid U,V scale factors (e1) 
     347      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e2       ! Parent grid U,V scale factors (e2) 
     348      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_e3       ! Parent grid vertical level thickness (e3u, e3v) 
     349      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld1_crs ! Coarse grid box 3D quantity  
     350      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld2_crs ! Coarse grid box 3D quantity  
     351      ! 
     352      INTEGER  ::   ji, jj, jk , ii, ij, je_2 
     353      REAL(wp) ::   zdAm 
     354      REAL(wp), DIMENSION(:,:,:), POINTER ::   zvol, zmask       
    360355      !!----------------------------------------------------------------   
    361     
    362       CALL wrk_alloc( jpi, jpj, jpk, zvol, zmask ) 
    363  
    364       p_fld1_crs(:,:,:) = 0.0 
    365       p_fld2_crs(:,:,:) = 0.0 
     356      ! 
     357      CALL wrk_alloc( jpi,jpj,jpk,  zvol, zmask ) 
     358      ! 
     359      p_fld1_crs(:,:,:) = 0._wp 
     360      p_fld2_crs(:,:,:) = 0._wp 
    366361 
    367362      DO jk = 1, jpk 
    368363         zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk)  
    369       ENDDO 
    370  
    371       zmask(:,:,:) = 0.0 
     364      END DO 
     365 
     366      zmask(:,:,:) = 0._wp 
    372367      IF( cd_type == 'W' ) THEN 
    373368         zmask(:,:,1) = p_mask(:,:,1)  
     
    469464      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors;  
    470465      !!                                       for velocities (U or V) 
    471       !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v) 
     466      !!              p_e3      = parent grid vertical level thickness (e3u or e3v) 
    472467      !!              p_pfield    = U or V on the parent grid 
    473468      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging 
     
    478473      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights. 
    479474      !!---------------------------------------------------------------- 
    480       !!  
    481       !!  Arguments 
    482       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    483       CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
     475      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld      ! T, U, V or W on parent grid 
     476      CHARACTER(len=3),                         INTENT(in)           :: cd_op      ! Operation SUM, MAX or MIN 
    484477      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V  
    485       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
    486       REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2) 
    487       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
     478      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask     ! Parent grid T,U,V mask 
     479      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12      ! Parent grid T,U,V scale factors (e1 or e2) 
     480      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3       ! Parent grid vertical level thickness (e3u, e3v) 
    488481      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    489       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V maska 
    490       REAL(wp),                                 INTENT(in)           :: psgn    ! sign  
    491  
    492  
    493       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    494  
    495       !! Local variables 
    496       INTEGER  :: ji, jj, jk  
    497       INTEGER  :: ii, ij, ijie, ijje, je_2 
    498       REAL(wp) :: zflcrs, zsfcrs    
    499       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask   
     482      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska 
     483      REAL(wp),                                 INTENT(in)           :: psgn       ! sign  
     484      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out)        :: p_fld_crs  ! Coarse grid box 3D quantity  
     485      ! 
     486      INTEGER  ::   ji, jj, jk  
     487      INTEGER  ::   ii, ij, ijie, ijje, je_2 
     488      REAL(wp) ::   zflcrs, zsfcrs    
     489      REAL(wp), DIMENSION(:,:,:), POINTER ::   zsurf, zsurfmsk, zmask   
    500490      !!----------------------------------------------------------------   
    501     
    502       p_fld_crs(:,:,:) = 0.0 
    503  
     491      ! 
     492      p_fld_crs(:,:,:) = 0._wp 
     493      ! 
    504494      SELECT CASE ( cd_op ) 
    505        
    506          CASE ( 'VOL' ) 
    507        
    508             CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    509           
    510             SELECT CASE ( cd_type ) 
    511              
    512                CASE( 'T', 'W' ) 
    513                   IF( cd_type == 'T' ) THEN 
     495      ! 
     496      CASE ( 'VOL' ) 
     497         ! 
     498         CALL wrk_alloc( jpi,jpj,jpk,  zsurf, zsurfmsk ) 
     499         !    
     500         SELECT CASE ( cd_type ) 
     501         !    
     502         CASE( 'T', 'W' ) 
     503               IF( cd_type == 'T' ) THEN 
    514504                     DO jk = 1, jpk 
    515505                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)  
     
    11361126      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors;  
    11371127      !!                                       for velocities (U or V) 
    1138       !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v) 
     1128      !!              p_e3      = parent grid vertical level thickness (e3u or e3v) 
    11391129      !!              p_pfield    = U or V on the parent grid 
    11401130      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging 
     
    11451135      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights. 
    11461136      !!---------------------------------------------------------------- 
    1147       !!  
    1148       !!  Arguments 
    11491137      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    11501138      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
     
    11521140      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
    11531141      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2) 
    1154       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
     1142      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (e3u, e3v) 
    11551143      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    11561144      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask 
    11571145      REAL(wp),                                 INTENT(in)           :: psgn    
    1158  
    11591146      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    1160  
    1161       !! Local variables 
     1147      ! 
    11621148      INTEGER  :: ji, jj, jk                 ! dummy loop indices 
    11631149      INTEGER  :: ijie, ijje, ii, ij, je_2 
    11641150      REAL(wp) :: zflcrs, zsfcrs    
    11651151      REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk    
    1166  
    11671152      !!----------------------------------------------------------------   
    1168     
    1169       p_fld_crs(:,:) = 0.0 
    1170  
     1153      ! 
     1154      p_fld_crs(:,:) = 0._wp 
     1155      ! 
    11711156      SELECT CASE ( cd_op ) 
    11721157       
  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r5215 r6140  
    3333   PUBLIC crs_dom_wri        ! routine called by crsini.F90 
    3434 
     35   !!---------------------------------------------------------------------- 
     36   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3537   !! $Id$ 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    3640CONTAINS 
    3741 
  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r5836 r6140  
    3333 
    3434   !! * Substitutions 
    35 #  include "zdfddm_substitute.h90" 
    36 #  include "domzgr_substitute.h90" 
    3735#  include "vectopt_loop_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
     
    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  :   
     
    6159      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars 
    6260      ! 
    63       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfse3t, zfse3u, zfse3v, zfse3w   ! 3D workspace for e3 
     61      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3 
    6462      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs 
    6563      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs   
     
    6967 
    7068      !  Initialize arrays 
    71       CALL wrk_alloc( jpi,jpj,jpk,   zfse3t, zfse3w ) 
    72       CALL wrk_alloc( jpi,jpj,jpk,   zfse3u, zfse3v ) 
    73       CALL wrk_alloc( jpi,jpj,jpk,   zt    , zs     ) 
    74       ! 
    75       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 ) 
    7674 
    7775      ! Depth work arrrays 
    78       zfse3t(:,:,:) = fse3t(:,:,:) 
    79       zfse3u(:,:,:) = fse3u(:,:,:) 
    80       zfse3v(:,:,:) = fse3v(:,:,:) 
    81       zfse3w(:,:,:) = fse3w(:,:,:) 
     76      ze3t(:,:,:) = e3t_n(:,:,:) 
     77      ze3u(:,:,:) = e3u_n(:,:,:) 
     78      ze3v(:,:,:) = e3v_n(:,:,:) 
     79      ze3w(:,:,:) = e3w_n(:,:,:) 
    8280 
    8381      IF( kt == nit000  ) THEN 
     
    107105      !  Temperature 
    108106      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp 
    109       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 ) 
    110108      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    111109 
     
    116114      !  Salinity 
    117115      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
    118       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 ) 
    119117      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    120118 
     
    123121 
    124122      !  U-velocity 
    125       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 ) 
    126124      ! 
    127125      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
     
    134132         END DO 
    135133      END DO 
    136       CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    137       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 ) 
    138136 
    139137      CALL iom_put( "uoce"  , un_crs )   ! i-current  
     
    142140 
    143141      !  V-velocity 
    144       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 ) 
    145143      !                                                                                  
    146144      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
     
    153151         END DO 
    154152      END DO 
    155       CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    156       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 ) 
    157155  
    158156      CALL iom_put( "voce"  , vn_crs )   ! i-current  
     
    162160      
    163161      !  Kinetic energy 
    164       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 ) 
    165163      CALL iom_put( "eken", rke_crs ) 
    166164 
     
    188186      IF( ln_crs_wn ) THEN 
    189187         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 
    190        !  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 ) 
    191189      ELSE 
    192190        wn_crs(:,:,jpk) = 0._wp 
     
    199197 
    200198      !  avt, avs 
     199!!gm BUG   TOP always uses avs !!! 
    201200      SELECT CASE ( nn_crs_kz ) 
    202201         CASE ( 0 ) 
    203             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 ) 
    204203         CASE ( 1 ) 
    205             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 ) 
    206205         CASE ( 2 ) 
    207             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 ) 
    208207      END SELECT 
    209208      ! 
     
    211210       
    212211      !  sbc fields   
    213       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 )   
    214213      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 ) 
    215214      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 ) 
     
    233232 
    234233      !  free memory 
    235       CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    236       CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    237       CALL wrk_dealloc( jpi, jpj, jpk, zt, zs       ) 
    238       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 ) 
    239238      ! 
    240239      CALL iom_swap( "nemo" )     ! return back on high-resolution grid 
  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5836 r6140  
    1212   USE par_kind, ONLY: wp 
    1313   USE par_oce                  ! For parameter jpi,jpj,jphgr_msh 
    14    USE dom_oce                  ! For parameters in par_oce (jperio, lk_vvl) 
     14   USE dom_oce                  ! For parameters in par_oce 
    1515   USE crs                      ! Coarse grid domain 
    1616   USE phycst, ONLY: omega, rad ! physical constants 
     
    3030   PUBLIC   crs_init   ! called by nemogcm.F90 module 
    3131 
    32    !! * Substitutions 
    33 #  include "domzgr_substitute.h90" 
    34    !!---------------------------------------------------------------------- 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3534   !! $Id$ 
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    3737CONTAINS 
     
    6464      !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output. 
    6565      !! As is, crsfun takes into account vvl.    
    66       !!      Talked about pre-setting the surface array to avoid IF/ENDIFS and division. 
     66      !!      Talked about pre-setting the surface array to avoid IF/ENDIF and division. 
    6767      !!      But have then to make that preset array here and elsewhere. 
    6868      !!      that is called every timestep... 
     
    7373      INTEGER  :: ierr                                ! allocation error status 
    7474      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    75       REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w 
     75      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t, ze3u, ze3v, ze3w 
    7676 
    7777      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn 
     
    187187      
    188188     ! 
    189      CALL wrk_alloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w ) 
    190      ! 
    191      zfse3t(:,:,:) = fse3t(:,:,:) 
    192      zfse3u(:,:,:) = fse3u(:,:,:) 
    193      zfse3v(:,:,:) = fse3v(:,:,:) 
    194      zfse3w(:,:,:) = fse3w(:,:,:) 
     189     CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w ) 
     190     ! 
     191     ze3t(:,:,:) = e3t_n(:,:,:) 
     192     ze3u(:,:,:) = e3u_n(:,:,:) 
     193     ze3v(:,:,:) = e3v_n(:,:,:) 
     194     ze3w(:,:,:) = e3w_n(:,:,:) 
    195195 
    196196     !    3.d.2   Surfaces  
    197      CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    ) 
    198      CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u ) 
    199      CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 
     197     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t  ) 
     198     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u ) 
     199     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v ) 
    200200    
    201201     facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:) 
     
    204204     !    3.d.3   Vertical scale factors 
    205205     ! 
    206      CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
    207      CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
    208      CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 
    209      CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
     206     CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
     207     CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
     208     CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 
     209     CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
    210210 
    211211     ! Replace 0 by e3t_0 or e3w_0 
     
    222222 
    223223     !    3.d.3   Vertical depth (meters) 
    224      CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t, psgn=1.0 )  
    225      CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w, psgn=1.0 ) 
     224     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 )  
     225     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 ) 
    226226 
    227227 
     
    230230     !--------------------------------------------------------- 
    231231     ! 4.a. Ocean volume or area unmasked and masked 
    232      CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t ) 
     232     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t ) 
    233233     ! 
    234234     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:) 
     
    237237     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:) 
    238238 
    239      CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w ) 
     239     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w ) 
    240240     ! 
    241241     !--------------------------------------------------------- 
     
    252252      ! 7. Finish and clean-up 
    253253      !--------------------------------------------------------- 
    254       CALL wrk_dealloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w ) 
     254      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w ) 
    255255      ! 
    256256   END SUBROUTINE crs_init 
  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    r5215 r6140  
    11MODULE crslbclnk 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  crslbclnk  *** 
     
    76   !!===================================================================== 
    87   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code 
    9  
     8   !!---------------------------------------------------------------------- 
     9   USE par_kind, ONLY: wp 
    1010   USE dom_oce 
    1111   USE crs 
     12   ! 
    1213   USE lbclnk 
    13    USE par_kind, ONLY: wp 
    1414   USE in_out_manager 
    15  
    16     
    1715    
    1816   INTERFACE crs_lbc_lnk 
     
    2220   PUBLIC crs_lbc_lnk 
    2321    
     22   !!---------------------------------------------------------------------- 
     23   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    2424   !! $Id$ 
     25   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     26   !!---------------------------------------------------------------------- 
    2527CONTAINS 
    2628 
     
    3537      !!                Upon exiting, switch back to full domain indices. 
    3638      !!---------------------------------------------------------------------- 
    37       !! Arguments 
    38       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type 
    39       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    40  
    41       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1 ! 3D array on which the lbc is applied 
    42       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    43       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    44        
    45       !! local vairables 
    46       LOGICAL                                                   ::   ll_grid_crs 
    47       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    48  
     39      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1 ! grid type 
     40      REAL(wp)                                , INTENT(in   ) ::   psgn     ! control of the sign 
     41      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1    ! 3D array on which the lbc is applied 
     42      REAL(wp)                      , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo 
     43      CHARACTER(len=3)              , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing) 
     44      ! 
     45      LOGICAL  ::   ll_grid_crs 
     46      REAL(wp) ::   zval   ! valeur sur les halo 
    4947      !!---------------------------------------------------------------------- 
    50        
     48      ! 
    5149      ll_grid_crs = ( jpi == jpi_crs ) 
    52        
     50      ! 
    5351      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    54       ELSE                      ;  zval = 0.0 
     52      ELSE                      ;  zval = 0._wp 
    5553      ENDIF 
    56        
    57       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    58  
     54      ! 
     55      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     56      ! 
    5957      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  ) 
    6058      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  ) 
    6159      ENDIF 
    62  
    63       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    64  
     60      ! 
     61      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     62      ! 
    6563   END SUBROUTINE crs_lbc_lnk_3d 
     64    
    6665    
    6766   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
     
    7574      !!                Upon exiting, switch back to full domain indices. 
    7675      !!---------------------------------------------------------------------- 
    77       !! Arguments 
    78       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1,cd_type2 ! grid type 
    79       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    80  
    81       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1,pt3d2 ! 3D array on which the lbc is applied 
    82        
    83       !! local vairables 
    84       LOGICAL                                                   ::   ll_grid_crs 
     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 
    8581      !!---------------------------------------------------------------------- 
    86        
     82      ! 
    8783      ll_grid_crs = ( jpi == jpi_crs ) 
    88        
    89       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    90  
     84      ! 
     85      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     86      ! 
    9187      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  ) 
    92  
    93       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    94  
     88      ! 
     89      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     90      ! 
    9591   END SUBROUTINE crs_lbc_lnk_3d_gather 
    9692 
     
    107103      !!                Upon exiting, switch back to full domain indices. 
    108104      !!---------------------------------------------------------------------- 
    109       !! Arguments 
    110       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type  ! grid type 
    111       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    112  
    113       REAL(wp), DIMENSION(jpi_crs,jpj_crs),     INTENT(inout)   ::   pt2d     ! 2D array on which the lbc is applied 
    114       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    115       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp   ! MPP only (here do nothing) 
    116       !! local variables 
    117        
    118       LOGICAL                                                   ::   ll_grid_crs 
    119       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    120  
     105      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type  ! grid type 
     106      REAL(wp)                            , INTENT(in   ) ::   psgn     ! control of the sign 
     107      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) ::   pt2d     ! 2D array on which the lbc is applied 
     108      REAL(wp)                  , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo 
     109      CHARACTER(len=3)          , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing) 
     110      !       
     111      LOGICAL  ::   ll_grid_crs 
     112      REAL(wp) ::   zval     ! valeur sur les halo 
    121113      !!---------------------------------------------------------------------- 
    122        
     114      ! 
    123115      ll_grid_crs = ( jpi == jpi_crs ) 
    124        
     116      ! 
    125117      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    126       ELSE                      ;  zval = 0.0 
     118      ELSE                      ;  zval = 0._wp 
    127119      ENDIF 
    128        
    129       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    130  
     120      ! 
     121      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     122      ! 
    131123      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
    132124      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  ) 
    133125      ENDIF 
    134  
    135       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    136  
     126      ! 
     127      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     128      ! 
    137129   END SUBROUTINE crs_lbc_lnk_2d 
    138130 
    139  
     131   !!====================================================================== 
    140132END MODULE crslbclnk 
Note: See TracChangeset for help on using the changeset viewer.