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 6772 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90 – NEMO

Ignore:
Timestamp:
2016-07-01T18:02:45+02:00 (8 years ago)
Author:
cbricaud
Message:

clean in coarsening branch

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r6101 r6772  
    1717    
    1818   PUBLIC crs_dom_alloc  ! Called from crsini.F90 
    19    PUBLIC crs_dom_alloc1  ! Called from crsini.F90 
    20    PUBLIC crs_dom_alloc2  ! Called from crsini.F90 
    2119   PUBLIC dom_grid_glo    
    2220   PUBLIC dom_grid_crs  
    … …  
    104102      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V 
    105103      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F 
    106       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs 
    107       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3f_max_crs, e3w_max_crs 
     104 
     105      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ht_0_crs 
     106      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_0_crs, e3u_0_crs, e3v_0_crs, e3f_0_crs, e3w_0_crs 
     107      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_0_crs, e3u_max_0_crs, e3v_max_0_crs, e3f_max_0_crs, e3w_max_0_crs 
     108 
     109#if defined key_vvl 
     110      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_b_crs, e3u_b_crs, e3v_b_crs, e3f_b_crs, e3w_b_crs 
     111      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_n_crs, e3u_n_crs, e3v_n_crs, e3f_n_crs, e3w_n_crs 
     112      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_a_crs, e3u_a_crs, e3v_a_crs, e3f_a_crs, e3w_a_crs 
     113 
     114      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_n_crs, e3u_max_n_crs, e3v_max_n_crs, e3f_max_n_crs, e3w_max_n_crs 
     115#endif 
     116 
    108117       
    109118      ! Surface 
    … …  
    116125      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: ff_crs 
    117126      INTEGER,  DIMENSION(:,:),   ALLOCATABLE,SAVE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs 
    118       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs 
     127 
     128      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_0_crs, gdepu_0_crs, gdepv_0_crs, gdepw_0_crs 
     129#if defined key_vvl 
     130      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_n_crs, gdepu_n_crs, gdepv_n_crs, gdepw_n_crs 
     131#endif 
    119132 
    120133      ! Weights 
    … …  
    146159      REAL(wp)     ::  rfactxy  
    147160 
     161      INTEGER, DIMENSION(:)    , ALLOCATABLE      :: nfactx,nfacty 
     162 
     163 
    148164      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields 
    149       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs,rab_crs_n 
     165      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs,tsa_crs,rab_crs_n 
    150166      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs 
    151167      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: ub_crs, vb_crs 
    … …  
    161177      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fmmflx_crs 
    162178      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs, taum_crs 
    163       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs 
     179      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs,rnf_b_crs 
     180      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_i_crs,trc_o_crs 
     181      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: sbc_trc_crs, sbc_trc_b_crs 
    164182 
    165183      REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE ::   uslp_crs, wslpi_crs          !: i_slope at U- and W-points 
    … …  
    195213CONTAINS 
    196214    
    197    INTEGER FUNCTION crs_dom_alloc1() 
     215   INTEGER FUNCTION crs_dom_alloc() 
    198216      !!------------------------------------------------------------------- 
    199217      !!                     *** FUNCTION crs_dom_alloc *** 
    … …  
    210228       &       mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs),  & 
    211229       &       mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs),  & 
    212        &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  STAT=ierr(1) )  
    213  
     230       &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  &  
     231       &       mis_crs (jpi_crs)   , mie_crs (jpi_crs)   ,  & 
     232       &       mjs_crs (jpj_crs)   , mje_crs (jpj_crs)   ,  & 
     233       &       nfactx  (jpi_crs)   , nfacty  (jpj_crs)   ,  & 
     234       &       nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij) , & 
     235       &       nimppt_full(jpnij), nlcit_full(jpnij), nldit_full(jpnij), nleit_full(jpnij), & 
     236       &       njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij) , & 
     237       &       njmppt_full(jpnij), nlcjt_full(jpnij), nldjt_full(jpnij), nlejt_full(jpnij), & 
     238       &       nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) , STAT=ierr(1) )  
    214239 
    215240      ! Set up Mask and Mesh 
    … …  
    232257         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5)) 
    233258 
    234       ALLOCATE( e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)    , &  
    235          &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)    , & 
    236          &      e3f_crs(jpi_crs,jpj_crs,jpk)    , e1e2w_msk(jpi_crs,jpj_crs,jpk)  , &  
     259      ALLOCATE( e3t_0_crs(jpi_crs,jpj_crs,jpk)    , e3w_0_crs(jpi_crs,jpj_crs,jpk)    , & 
     260         &      e3u_0_crs(jpi_crs,jpj_crs,jpk)    , e3v_0_crs(jpi_crs,jpj_crs,jpk)    , & 
     261         &           ht_0_crs(jpi_crs,jpj_crs),                                     & 
     262#if defined key_vvl 
     263         &      e3t_b_crs(jpi_crs,jpj_crs,jpk)    , e3w_b_crs(jpi_crs,jpj_crs,jpk)    , & 
     264         &      e3u_b_crs(jpi_crs,jpj_crs,jpk)    , e3v_b_crs(jpi_crs,jpj_crs,jpk)    , & 
     265         &      e3t_n_crs(jpi_crs,jpj_crs,jpk)    , e3w_n_crs(jpi_crs,jpj_crs,jpk)    , & 
     266         &      e3u_n_crs(jpi_crs,jpj_crs,jpk)    , e3v_n_crs(jpi_crs,jpj_crs,jpk)    , & 
     267         &      e3t_a_crs(jpi_crs,jpj_crs,jpk)    , e3w_a_crs(jpi_crs,jpj_crs,jpk)    , & 
     268         &      e3u_a_crs(jpi_crs,jpj_crs,jpk)    , e3v_a_crs(jpi_crs,jpj_crs,jpk)    , & 
     269#endif 
     270         &      e1e2w_msk(jpi_crs,jpj_crs,jpk)  , & 
    237271         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk)  , & 
    238272         &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk)  , & 
    239          &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , e3t_max_crs(jpi_crs,jpj_crs,jpk), & 
    240          &      e3w_max_crs(jpi_crs,jpj_crs,jpk), e3u_max_crs(jpi_crs,jpj_crs,jpk), & 
    241          &      e3v_max_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6)) 
     273         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , & 
     274         &      e3t_max_0_crs(jpi_crs,jpj_crs,jpk), e3w_max_0_crs(jpi_crs,jpj_crs,jpk) , & 
     275         &      e3u_max_0_crs(jpi_crs,jpj_crs,jpk), e3v_max_0_crs(jpi_crs,jpj_crs,jpk) , & 
     276#if defined key_vvl 
     277         &      e3t_max_n_crs(jpi_crs,jpj_crs,jpk), e3w_max_n_crs(jpi_crs,jpj_crs,jpk) , & 
     278         &      e3u_max_n_crs(jpi_crs,jpj_crs,jpk), e3v_max_n_crs(jpi_crs,jpj_crs,jpk) , & 
     279#endif 
     280         &      STAT=ierr(6)) 
    242281 
    243282 
    … …  
    255294         &      mbku_crs(jpi_crs,jpj_crs)  , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9)) 
    256295 
    257       ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk), gdepu_crs(jpi_crs,jpj_crs,jpk) , & 
    258          &      gdepv_crs(jpi_crs,jpj_crs,jpk), gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) ) 
     296      ALLOCATE( gdept_0_crs(jpi_crs,jpj_crs,jpk), gdepu_0_crs(jpi_crs,jpj_crs,jpk) , & 
     297         &      gdepv_0_crs(jpi_crs,jpj_crs,jpk), gdepw_0_crs(jpi_crs,jpj_crs,jpk) , & 
     298#if defined key_vvl 
     299         &      gdept_n_crs(jpi_crs,jpj_crs,jpk), gdepu_n_crs(jpi_crs,jpj_crs,jpk) , & 
     300         &      gdepv_n_crs(jpi_crs,jpj_crs,jpk), gdepw_n_crs(jpi_crs,jpj_crs,jpk) , & 
     301#endif 
     302         & STAT=ierr(10)) 
    259303 
    260304 
    … …  
    270314 
    271315     ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs),  ssha_crs(jpi_crs,jpj_crs), & 
     316         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 
     317         &     vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs),  & 
     318         &     rnf_crs (jpi_crs,jpj_crs), rnf_b_crs(jpi_crs ,jpj_crs), & 
    272319         &     emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 
    273          &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 
    274          &     vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), & 
     320         &     sbc_trc_crs (jpi_crs,jpj_crs,jpts), sbc_trc_b_crs(jpi_crs,jpj_crs,jpts), & 
     321         &     trc_i_crs (jpi_crs,jpj_crs,jpts), trc_o_crs(jpi_crs,jpj_crs,jpts), & 
    275322         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  ) 
    276323 
    … …  
    285332#endif 
    286333 
    287      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts),  & 
     334     ALLOCATE( tsb_crs(jpi_crs,jpj_crs,jpk,jpts), tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsa_crs(jpi_crs,jpj_crs,jpk,jpts),  & 
    288335               en_crs(jpi_crs,jpj_crs,jpk),   avt_crs(jpi_crs,jpj_crs,jpk),    & 
    289336# if defined key_zdfddm 
    … …  
    295342         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(15) ) 
    296343 
    297       crs_dom_alloc1 = MAXVAL(ierr) 
    298  
    299    END FUNCTION crs_dom_alloc1 
    300  
    301    INTEGER FUNCTION crs_dom_alloc() 
    302       !!------------------------------------------------------------------- 
    303       !!                     *** FUNCTION crs_dom_alloc *** 
    304       !!  ** Purpose :   Allocate public crs arrays   
    305       !!------------------------------------------------------------------- 
    306       !! Local variables 
    307       INTEGER, DIMENSION(2) :: ierr 
    308  
    309       ierr(:) = 0 
    310           
    311       ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), & 
    312        &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
    313                 njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), & 
    314        &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(1) ) 
    315  
    316       ALLOCATE( nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) ,STAT=ierr(2) ) 
    317  
    318344      crs_dom_alloc = MAXVAL(ierr) 
    319345 
    320346   END FUNCTION crs_dom_alloc 
    321     
    322    INTEGER FUNCTION crs_dom_alloc2() 
    323       !!------------------------------------------------------------------- 
    324       !!                     *** FUNCTION crs_dom_alloc *** 
    325       !!  ** Purpose :   Allocate public crs arrays   
    326       !!------------------------------------------------------------------- 
    327       !! Local variables 
    328       INTEGER, DIMENSION(1) :: ierr 
    329  
    330       ierr(:) = 0 
    331        
    332       !cbr ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) ) 
    333       !cbr pk on alloue ac nlej_crs ?????? 
    334       !cbrALLOCATE( mjs_crs(nlcj_crs) , mje_crs(nlcj_crs), mis_crs(nlci_crs) , mie_crs(nlci_crs), STAT=ierr(1) ) 
    335       ALLOCATE( mjs_crs(jpj_crs) , mje_crs(jpj_crs), mis_crs(jpi_crs) , mie_crs(jpi_crs), STAT=ierr(1) ) 
    336       crs_dom_alloc2 = MAXVAL(ierr) 
    337  
    338       END FUNCTION crs_dom_alloc2 
    339347 
    340348   SUBROUTINE dom_grid_glo 
Note: See TracChangeset for help on using the changeset viewer.