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 6060 for branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90 – NEMO

Ignore:
Timestamp:
2015-12-16T10:25:22+01:00 (8 years ago)
Author:
timgraham
Message:

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5836 r6060  
    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 
Note: See TracChangeset for help on using the changeset viewer.