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/crsdom.F90 – 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.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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       
Note: See TracChangeset for help on using the changeset viewer.