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 7398 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2016-11-30T15:44:11+01:00 (8 years ago)
Author:
cbricaud
Message:

coarsening branch: first implementation of coarsening in PISCES

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC
Files:
5 edited

Legend:

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

    r7312 r7398  
    7474 
    7575      INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset 
    76       INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending  j-indices of parent subset 
     76      INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs  ! starting and ending  j-indices of parent subset 
    7777      INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs 
    7878      INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs 
    79       INTEGER  :: mxbinctr, mybinctr            ! central point in grid box 
    80       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain 
    81       INTEGER, DIMENSION(:), ALLOCATABLE ::   nldit_crs, nldit_full     !: first, last indoor index for each i-domain 
    82       INTEGER, DIMENSION(:), ALLOCATABLE ::   nleit_crs, nleit_full    !: first, last indoor index for each j-domain 
    83       INTEGER, DIMENSION(:), ALLOCATABLE ::   nimppt_crs, nimppt_full    !: first, last indoor index for each j-domain 
    84       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcjt_crs, nlcjt_full  !: dimensions of every subdomain 
    85       INTEGER, DIMENSION(:), ALLOCATABLE ::   nldjt_crs, nldjt_full     !: first, last indoor index for each i-domain 
    86       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlejt_crs, nlejt_full    !: first, last indoor index for each j-domain 
    87       INTEGER, DIMENSION(:), ALLOCATABLE ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain 
     79      INTEGER                            :: mxbinctr, mybinctr                    ! central point in grid box 
     80      INTEGER, DIMENSION(:), ALLOCATABLE :: nlcit_crs, nlcit_full                 ! dimensions of every subdomain 
     81      INTEGER, DIMENSION(:), ALLOCATABLE :: nldit_crs, nldit_full                 ! first, last indoor index for each i-domain 
     82      INTEGER, DIMENSION(:), ALLOCATABLE :: nleit_crs, nleit_full                 ! first, last indoor index for each j-domain 
     83      INTEGER, DIMENSION(:), ALLOCATABLE :: nimppt_crs, nimppt_full               ! first, last indoor index for each j-domain 
     84      INTEGER, DIMENSION(:), ALLOCATABLE :: nlcjt_crs, nlcjt_full                 ! dimensions of every subdomain 
     85      INTEGER, DIMENSION(:), ALLOCATABLE :: nldjt_crs, nldjt_full                 ! first, last indoor index for each i-domain 
     86      INTEGER, DIMENSION(:), ALLOCATABLE :: nlejt_crs, nlejt_full                 ! first, last indoor index for each j-domain 
     87      INTEGER, DIMENSION(:), ALLOCATABLE :: njmppt_crs, njmppt_full               ! first, last indoor index for each j-domain 
    8888 
    8989      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   nfiimpp_full 
     
    9494      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE,SAVE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs 
    9595       
    96   !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol       
    97  
    9896      ! Scale factors 
    9997      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T 
    100       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U 
    101       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V 
    102       REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F 
    103  
    104       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ht_0_crs 
     98      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs            ! horizontal scale factors grid type U 
     99      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs            ! horizontal scale factors grid type V 
     100      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs            ! horizontal scale factors grid type F 
     101 
     102      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: ht_0_crs 
    105103      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_0_crs, e3u_0_crs, e3v_0_crs, e3f_0_crs, e3w_0_crs 
    106104      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_0_crs, e3u_max_0_crs, e3v_max_0_crs, e3f_max_0_crs, e3w_max_0_crs 
     
    110108      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_n_crs, e3u_n_crs, e3v_n_crs, e3f_n_crs, e3w_n_crs 
    111109      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_a_crs, e3u_a_crs, e3v_a_crs, e3f_a_crs, e3w_a_crs 
    112  
    113110      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_n_crs, e3u_max_n_crs, e3v_max_n_crs, e3f_max_n_crs, e3w_max_n_crs 
    114111#endif 
    115112 
    116        
    117113      ! Surface 
    118114      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_crs, e2e3u_crs, e1e3v_crs 
    119115      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk 
    120                                                                   ! vertical scale factors  
     116       
    121117      ! Coordinates 
    122118      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs  
     
    135131      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt 
    136132 
    137       ! CRS Namelist 
     133      ! Namelist 
    138134      INTEGER           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid 
    139135      INTEGER           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid 
    140                                                 !: 1 = binning centers at equator (north fold my have artifacts)      
    141                                                 !:    for even reduction factors, equator placed in bin biased south 
    142136      INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output 
    143137                                                !: 0 = no mesh mask output 
     
    147141      INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)  
    148142      LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence  
    149       LOGICAL, PUBLIC   :: ln_crs_top = .FALSE.          !:coarsening online for the bio 
     143      LOGICAL, PUBLIC   :: ln_crs_top   = .FALSE.    !:coarsening online for the bio 
    150144      ! 
    151       INTEGER           :: nrestx, nresty       !: for determining odd or even reduction factor 
    152  
    153145 
    154146      ! Grid reduction factors 
     
    156148      REAL(wp)     ::  rfacty_r                !: inverse of y-dim reduction factor 
    157149      REAL(wp)     ::  rfactxy  
    158  
    159       INTEGER, DIMENSION(:)    , ALLOCATABLE      :: nfactx,nfacty 
     150      INTEGER      :: nrestx, nresty           !: for determining odd or even reduction factor 
     151      INTEGER, DIMENSION(:), ALLOCATABLE      :: nfactx,nfacty 
    160152 
    161153 
     
    175167      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fmmflx_crs 
    176168      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs, taum_crs 
    177       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs,rnf_b_crs 
     169      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs,rnf_b_crs,h_rnf_crs 
     170      INTEGER , PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: nk_rnf_crs 
    178171      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_i_crs,trc_o_crs 
    179172      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: sbc_trc_crs, sbc_trc_b_crs 
    180173 
    181       REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE ::  uslp_crs, wslpi_crs          !: i_slope at U- and W-points 
    182       REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE ::  vslp_crs, wslpj_crs          !: j-slope at V- and W-points 
     174      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: uslp_crs, wslpi_crs          !: i_slope at U- and W-points 
     175      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: vslp_crs, wslpj_crs          !: j-slope at V- and W-points 
    183176 
    184177      ! Horizontal diffusion 
     
    315308         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 
    316309         &     vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs),  & 
    317          &     rnf_crs (jpi_crs,jpj_crs), rnf_b_crs(jpi_crs ,jpj_crs), & 
     310         &     rnf_crs (jpi_crs,jpj_crs), rnf_b_crs(jpi_crs ,jpj_crs), nk_rnf_crs(jpi_crs ,jpj_crs), h_rnf_crs(jpi_crs ,jpj_crs), & 
    318311         &     emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 
    319312         &     sbc_trc_crs (jpi_crs,jpj_crs,jpts), sbc_trc_b_crs(jpi_crs,jpj_crs,jpts), & 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r7256 r7398  
    1515   USE ldftra_oce      ! ocean active tracers: lateral physics 
    1616   USE sbc_oce         ! Surface boundary condition: ocean fields 
     17   USE sbcrnf 
    1718   USE zdf_oce         ! vertical  physics: ocean fields 
    1819   USE zdfddm          ! vertical  physics: double diffusion 
     
    308309      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    309310      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 ) 
     311      CALL crs_dom_ope( h_rnf, 'MAX', 'T', tmask, h_rnf_crs                                   , psgn=1.0 ) 
     312 
     313      z2d=REAL(nk_rnf,wp) 
     314      CALL crs_dom_ope( z2d  , 'MAX', 'T', tmask, z2d_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     315      nk_rnf_crs=INT(z2d_crs) 
     316 
    310317      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    311318#if defined key_vvl 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r7320 r7398  
    237237     WHERE(e3v_max_0_crs == 0._wp) e3v_max_0_crs=r_inf 
    238238     WHERE(e3w_max_0_crs == 0._wp) e3w_max_0_crs=r_inf 
     239     DO jk = 1, jpk 
     240        DO ji = 1, jpi_crs 
     241           DO jj = 1, jpj_crs 
     242              IF( e3t_max_0_crs(ji,jj,jk) == 0._wp ) e3t_max_0_crs(ji,jj,jk) = e3t_1d(jk) 
     243              IF( e3w_max_0_crs(ji,jj,jk) == 0._wp ) e3w_max_0_crs(ji,jj,jk) = e3w_1d(jk) 
     244              IF( e3u_max_0_crs(ji,jj,jk) == 0._wp ) e3u_max_0_crs(ji,jj,jk) = e3t_1d(jk) 
     245              IF( e3v_max_0_crs(ji,jj,jk) == 0._wp ) e3v_max_0_crs(ji,jj,jk) = e3t_1d(jk) 
     246           ENDDO 
     247        ENDDO 
     248     ENDDO 
    239249 
    240250#if defined key_vvl 
     
    290300     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_0_crs, p_e3=zfse3t, psgn=1.0 )  
    291301     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 ) 
     302 
     303     DO jk = 1, jpk 
     304        DO ji = 1, jpi_crs 
     305           DO jj = 1, jpj_crs 
     306              IF( gdept_0_crs(ji,jj,jk) .LE. 0._wp ) gdept_0_crs(ji,jj,jk) = gdept_1d(jk) 
     307              IF( gdepw_0_crs(ji,jj,jk) .LE. 0._wp ) gdepw_0_crs(ji,jj,jk) = gdepw_1d(jk) 
     308           ENDDO 
     309        ENDDO 
     310     ENDDO 
     311 
    292312#if defined key_vvl 
    293313     gdept_n_crs(:,:,:) = gdept_0_crs(:,:,:) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r7256 r7398  
    5050   USE ioipsl, ONLY :  ju2ymds    ! for calendar 
    5151   USE crs             ! Grid coarsening 
     52   USE crslbclnk 
    5253 
    5354   IMPLICIT NONE 
     
    823824                        jstartrow = MAX(1,jstartrow) 
    824825                     ENDIF 
    825                      istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
     826                     IF( lk_crs .AND. jpi == jpi_crs .AND. jpi .NE. 0  )THEN 
     827                        istart(1:2) = (/ mig_crs(1), mjg_crs(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
     828                     ELSE 
     829                        istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
     830                     ENDIF 
    826831                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below 
    827832                  ENDIF 
     
    922927            !--- overlap areas and extra hallows (mpp) 
    923928            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    924                CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 
     929               IF( lk_crs .AND. jpi == jpi_crs .AND. jpi .NE. 0 )THEN 
     930                  CALL crs_lbc_lnk( pv_r2d,'Z',-999.,'no0') 
     931               ELSE 
     932                  CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 
     933               ENDIF 
    925934            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    926935               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    927936               IF( icnt(3) == jpk ) THEN 
    928                   CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
     937                  IF( lk_crs .AND. jpi == jpi_crs .AND. jpi .NE. 0 )THEN 
     938                     CALL crs_lbc_lnk( pv_r3d,'Z',-999.,'no0') 
     939                  ELSE 
     940                     CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
     941                  ENDIF 
    929942               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    930943                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90

    r7207 r7398  
    7878 
    7979      ! w-level of the turbocline 
    80       imld(:,:)=0 
     80      imld(:,:)=1 
    8181      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    8282         DO jj = 1, jpj_crs 
     
    101101      END DO 
    102102      ! 
     103      IF( lk_crs ) CALL iom_swap( "nemo_crs" ) 
     104      CALL iom_put( "mldkz5"  , hmld_crs ) 
     105      IF( lk_crs ) CALL iom_swap( "nemo" ) 
     106      ! 
    103107      CALL wrk_dealloc( jpi_crs,jpj_crs, imld ) 
    104108      ! 
Note: See TracChangeset for help on using the changeset viewer.