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

    • Property svn:keywords set to Id
    r4314 r6225  
    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) 
     57   !! $Id$ 
     58   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     59   !!---------------------------------------------------------------------- 
    5960CONTAINS 
    60  
    6161 
    6262   SUBROUTINE crs_dom_msk 
    … …  
    132132   END SUBROUTINE crs_dom_msk 
    133133 
     134 
    134135   SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs ) 
    135136      !!---------------------------------------------------------------- 
    … …  
    333334      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V) 
    334335      !!              cd_op       = applied operation (SUM, VOL, WGT) 
    335       !!              p_fse3      = (Optional) parent grid vertical level thickness (fse3u or fse3v) 
     336      !!              p_e3      = (Optional) parent grid vertical level thickness (e3u or e3v) 
    336337      !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid 
    337338      !!              p_cfield2d_2 = (Optional) 2D field on coarse grid 
    … …  
    341342      !! History.     4 Jun.  Write for WGT and scale factors only 
    342343      !!---------------------------------------------------------------- 
    343       !!  
    344       !!  Arguments 
    345       CHARACTER(len=1),                         INTENT(in)  :: cd_type  ! grid type U,V  
    346       REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_mask  ! Parent grid U,V mask 
    347       REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1) 
    348       REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2) 
    349       REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
    350  
    351       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity  
    352       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity  
    353  
    354       !! Local variables 
    355       REAL(wp)                                :: zdAm 
    356       INTEGER                                 :: ji, jj, jk , ii, ij, je_2 
    357  
    358       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       
    359355      !!----------------------------------------------------------------   
    360     
    361       CALL wrk_alloc( jpi, jpj, jpk, zvol, zmask ) 
    362  
    363       p_fld1_crs(:,:,:) = 0.0 
    364       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 
    365361 
    366362      DO jk = 1, jpk 
    367363         zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk)  
    368       ENDDO 
    369  
    370       zmask(:,:,:) = 0.0 
     364      END DO 
     365 
     366      zmask(:,:,:) = 0._wp 
    371367      IF( cd_type == 'W' ) THEN 
    372368         zmask(:,:,1) = p_mask(:,:,1)  
    … …  
    468464      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors;  
    469465      !!                                       for velocities (U or V) 
    470       !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v) 
     466      !!              p_e3      = parent grid vertical level thickness (e3u or e3v) 
    471467      !!              p_pfield    = U or V on the parent grid 
    472468      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging 
    … …  
    477473      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights. 
    478474      !!---------------------------------------------------------------- 
    479       !!  
    480       !!  Arguments 
    481       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    482       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 
    483477      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V  
    484       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
    485       REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2) 
    486       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) 
    487481      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    488       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V maska 
    489       REAL(wp),                                 INTENT(in)           :: psgn    ! sign  
    490  
    491  
    492       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    493  
    494       !! Local variables 
    495       INTEGER  :: ji, jj, jk  
    496       INTEGER  :: ii, ij, ijie, ijje, je_2 
    497       REAL(wp) :: zflcrs, zsfcrs    
    498       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   
    499490      !!----------------------------------------------------------------   
    500     
    501       p_fld_crs(:,:,:) = 0.0 
    502  
     491      ! 
     492      p_fld_crs(:,:,:) = 0._wp 
     493      ! 
    503494      SELECT CASE ( cd_op ) 
    504        
    505          CASE ( 'VOL' ) 
    506        
    507             CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    508           
    509             SELECT CASE ( cd_type ) 
    510              
    511                CASE( 'T', 'W' ) 
    512                   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 
    513504                     DO jk = 1, jpk 
    514505                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)  
    … …  
    11351126      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors;  
    11361127      !!                                       for velocities (U or V) 
    1137       !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v) 
     1128      !!              p_e3      = parent grid vertical level thickness (e3u or e3v) 
    11381129      !!              p_pfield    = U or V on the parent grid 
    11391130      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging 
    … …  
    11441135      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights. 
    11451136      !!---------------------------------------------------------------- 
    1146       !!  
    1147       !!  Arguments 
    11481137      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    11491138      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
    … …  
    11511140      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
    11521141      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2) 
    1153       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) 
    11541143      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    11551144      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask 
    11561145      REAL(wp),                                 INTENT(in)           :: psgn    
    1157  
    11581146      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    1159  
    1160       !! Local variables 
     1147      ! 
    11611148      INTEGER  :: ji, jj, jk                 ! dummy loop indices 
    11621149      INTEGER  :: ijie, ijje, ii, ij, je_2 
    11631150      REAL(wp) :: zflcrs, zsfcrs    
    11641151      REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk    
    1165  
    11661152      !!----------------------------------------------------------------   
    1167     
    1168       p_fld_crs(:,:) = 0.0 
    1169  
     1153      ! 
     1154      p_fld_crs(:,:) = 0._wp 
     1155      ! 
    11701156      SELECT CASE ( cd_op ) 
    11711157       
    … …  
    18821868      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
    18831869 
    1884       CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     1870      CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf ) 
    18851871 
    18861872   END SUBROUTINE crs_dom_sfc 
    … …  
    22742260      ENDDO 
    22752261      
    2276       CALL wrk_alloc( jpi_crs, jpj_crs, zmbk ) 
    2277  
    22782262      zmbk(:,:) = 0.0 
    22792263      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) ) 
Note: See TracChangeset for help on using the changeset viewer.