Changeset 5920


Ignore:
Timestamp:
2015-11-25T17:58:51+01:00 (5 years ago)
Author:
mathiot
Message:

ice sheet coupling: add treshold to define grounded area, remove useless va
riable, change some variable name + add some namelist parameter

Location:
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5823 r5920  
    126126   nn_msh      =    1      !  create (=1) a mesh file or not (=0) 
    127127   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0) 
     128   rn_isfhmin  =    0.01   !  treshold (m) to discriminate grounding ice to floating ice 
    128129   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of 
    129130   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1 
     
    473474&namsbc_iscpl  !   land ice / ocean coupling option                      
    474475!----------------------------------------------------------------------- 
    475    rn_fiscpl = 43800    ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency) 
     476   nn_drown  = 10       ! number of iteration of the extrapolation loop (fill the new wet cells) 
    476477   ln_hsb    = .false.  ! activate conservation module (conservation exact after a time of rn_fiscpl) 
     478   nn_fiscpl = 43800    ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency) 
    477479/ 
    478480!----------------------------------------------------------------------- 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5802 r5920  
    3232   REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1) 
    3333   REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0) 
     34   REAL(wp), PUBLIC ::   rn_isfhmin      !: threshold to discriminate grounded ice to floating ice 
    3435   REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters) 
    3536   REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5779 r5920  
    142142         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    143143         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler, ln_iscpl 
    144       NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    145          &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
    146          &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,    & 
    147          &             jphgr_msh, & 
    148          &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 
    149          &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
     144      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, rn_isfhmin,  & 
     145         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                             & 
     146         &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,                                   & 
     147         &             jphgr_msh,                                                                     & 
     148         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                          & 
     149         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                   & 
    150150         &             ppa2, ppkth2, ppacr2 
    151151      NAMELIST/namcla/ nn_cla 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5823 r5920  
    531531               ! set grounded point to 0  
    532532               ! (a treshold could be set here if needed, or set it offline based on the grounded fraction) 
    533                WHERE ( bathy(:,:) .LE. risfdep(:,:) ) 
     533               WHERE ( bathy(:,:) .LE. risfdep(:,:) + rn_isfhmin ) 
    534534                  misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    535535                  mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
     
    12581258      DO jl = 1, 10      
    12591259         ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments) 
    1260          WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 
     1260         WHERE (bathy(:,:) .LE. risfdep(:,:) + rn_isfhmin) 
    12611261            misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    12621262            mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r5835 r5920  
    3333   !! * Substitutions   
    3434#  include "domzgr_substitute.h90"   
     35#  include "vectopt_loop_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    5758      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period  
    5859      !! 
    59       INTEGER :: ji, jj, jk      !! loop index 
     60      INTEGER :: ji, jj, jk                                    !! loop index 
    6061      INTEGER :: jip1, jim1, jjp1, jjm1 
    6162      !! 
    6263      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb 
    63       REAL(wp):: r1_tiscpl 
     64      REAL(wp):: r1_rdtiscpl 
    6465      REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio 
    6566      !! 
    66       REAL(wp), DIMENSION(:,:    ), POINTER :: zde3t, zdtem, zdsal 
    67       REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0   
    68       REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmp3d 
    69       ! 
    70       REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zlon, zlat 
    71       REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 
    72       INTEGER , DIMENSION(:    ), ALLOCATABLE :: ixpts, iypts, izpts, vnpts 
     67      REAL(wp):: zde3t, zdtem, zdsal 
     68      REAL(wp), DIMENSION(:,:), POINTER :: zdssh 
     69      !! 
     70      REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat 
     71      REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 
     72      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, vnpts 
    7373      INTEGER :: jpts, npts 
    7474 
    75       CALL wrk_alloc(jpi,jpj,jpk,   ztmp3d ) 
    76       CALL wrk_alloc(jpi,jpj,       zde3t , zdtem, zdsal ) 
    77       CALL wrk_alloc(jpi,jpj,       zssh0  ) 
    78  
    79     ! get unbalance (volume heat and salt) 
    80     ! initialisation 
    81       zde3t   (:,:)     = 0.0_wp 
     75      CALL wrk_alloc(jpi,jpj, zdssh ) 
     76 
     77      ! get imbalance (volume heat and salt) 
     78      ! initialisation difference 
     79      zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp 
     80 
     81      ! initialisation correction term 
    8282      pvol_flx(:,:,:  ) = 0.0_wp 
    8383      pts_flx (:,:,:,:) = 0.0_wp 
    84       r1_tiscpl = 1._wp / (prdt_iscpl * rn_rdt)  
     84       
     85      r1_rdtiscpl = 1._wp / prdt_iscpl  
    8586 
    8687      ! mask tsn and tsb  
     
    9394 
    9495      !  
    95       zssh0(:,:)        = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:) 
    96       IF ( lk_vvl ) zssh0 = 0.0_wp ! already include in the levels by definition 
     96      zdssh(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:) 
     97      IF ( lk_vvl ) zdssh = 0.0_wp ! already included in the levels by definition 
    9798       
    9899      DO jk = 1,jpk-1 
    99          DO ji = 2,jpi-1 
    100             DO jj = 2,jpj-1 
     100         DO jj = 2,jpj-1 
     101            DO ji = fs_2,fs_jpim1 
    101102               IF (tmask_h(ji,jj) == 1._wp) THEN 
    102103 
    103104                  ! volume differences 
    104                   zde3t(ji,jj) = fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk) 
     105                  zde3t = fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk) 
    105106 
    106107                  ! heat diff 
    107                   zdtem(ji,jj) = tsn(ji,jj,jk,jp_tem) * fse3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   & 
    108                                - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk) 
     108                  zdtem = tsn(ji,jj,jk,jp_tem) * fse3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   & 
     109                        - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk) 
    109110                  ! salt diff 
    110                   zdsal(ji,jj) = tsn(ji,jj,jk,jp_sal) * fse3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   & 
    111                                - tsb(ji,jj,jk,jp_sal) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk) 
     111                  zdsal = tsn(ji,jj,jk,jp_sal) * fse3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   & 
     112                        - tsb(ji,jj,jk,jp_sal) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk) 
    112113                
    113114                  ! shh changes 
    114115                  IF ( ptmask_b(ji,jj,jk) == 1._wp .OR. tmask(ji,jj,jk) == 1._wp ) THEN  
    115                      zde3t(ji,jj) = zde3t(ji,jj) + zssh0(ji,jj) ! zssh0 = 0 if vvl 
    116                      zssh0(ji,jj) = 0._wp 
     116                     zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl 
     117                     zdssh(ji,jj) = 0._wp 
    117118                  END IF 
    118119 
    119120                  ! volume, heat and salt differences in each cell  
    120                   pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t(ji,jj) * r1_tiscpl 
    121                   pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal(ji,jj) * r1_tiscpl  
    122                   pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem(ji,jj) * r1_tiscpl 
     121                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl 
     122                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl  
     123                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl 
    123124 
    124125                  ! case where we close a cell: check if the neighbour cells are wet  
     
    192193      ! fill narea location with the number of problematic point 
    193194      DO jk = 1,jpk-1 
    194          DO ji = 2,jpi-1 
    195             DO jj = 2,jpj-1 
     195         DO jj = 2,jpj-1 
     196            DO ji = fs_2,fs_jpim1 
    196197               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  & 
    197198                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN 
     
    218219      jpts = SUM(vnpts(1:narea-1)) 
    219220      DO jk = 1,jpk-1 
    220          DO ji = 2,jpi-1 
    221             DO jj = 2,jpj-1 
     221         DO jj = 2,jpj-1 
     222            DO ji = fs_2,fs_jpim1 
    222223               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  & 
    223224                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN 
     
    286287 
    287288      ! deallocate variables 
    288       CALL wrk_dealloc(jpi,jpj,jpk,   ztmp3d )  
    289       CALL wrk_dealloc(jpi,jpj,       zde3t  )  
    290       CALL wrk_dealloc(jpi,jpj,       zssh0  )  
     289      CALL wrk_dealloc(jpi,jpj, zdssh )  
     290 
    291291   END SUBROUTINE iscpl_cons 
    292292 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90

    r5835 r5920  
    2222   PUBLIC   iscpl_init       
    2323   PUBLIC   iscpl_alloc  
    24    !!                                                     !!* namsbc_iscpl namelist * 
     24   !!                                                      !!* namsbc_iscpl namelist * 
    2525   LOGICAL , PUBLIC                                        ::   ln_hsb 
    26    REAL(wp), PUBLIC                                        ::   rn_fiscpl 
     26   INTEGER , PUBLIC                                        ::   nn_fiscpl, nstp_iscpl 
     27   INTEGER , PUBLIC                                        ::   nn_drown 
    2728   REAL(wp), PUBLIC                                        ::   rdt_iscpl 
    28    !!                                                     !!* namsbc_iscpl namelist * 
     29   !!                                                      !!* namsbc_iscpl namelist * 
    2930   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::   hdiv_iscpl 
    3031   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl 
     
    5051   SUBROUTINE iscpl_init() 
    5152      INTEGER ::   ios           ! Local integer output status for namelist read 
    52       NAMELIST/namsbc_iscpl/rn_fiscpl,ln_hsb 
     53      NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb 
    5354      !!---------------------------------------------------------------------- 
    5455      !                                   ! ============ 
     
    5657      !                                   ! ============ 
    5758      ! 
    58       rn_fiscpl = 2480. 
     59      nn_fiscpl = 0 
    5960      ln_hsb    = .FALSE. 
    6061      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling 
     
    6768      IF(lwm) WRITE ( numond, namsbc_iscpl ) 
    6869      ! 
    69       rdt_iscpl=MAX(rn_fiscpl, nitend-nit000+1.0) ! the coupling period have to be less or egal than the total number of time step 
     70      nstp_iscpl=MIN(nn_fiscpl, nitend-nit000+1) ! the coupling period have to be less or egal than the total number of time step 
     71      rdt_iscpl = nstp_iscpl * rn_rdt 
    7072      ! 
    7173      IF (lwp) THEN 
    7274         WRITE(numout,*) 'iscpl_rst:' 
    7375         WRITE(numout,*) '~~~~~~~~~' 
    74          WRITE(numout,*) ' coupling     flag (ln_iscpl )  = ', ln_iscpl 
    75          WRITE(numout,*) ' conservation flag (ln_hsb   )  = ', ln_hsb 
    76          WRITE(numout,*) ' nb of stp for cons (rn_fiscpl) = ', rdt_iscpl 
     76         WRITE(numout,*) ' coupling     flag (ln_iscpl )            = ', ln_iscpl 
     77         WRITE(numout,*) ' conservation flag (ln_hsb   )            = ', ln_hsb 
     78         WRITE(numout,*) ' nb of stp for cons (rn_fiscpl)           = ', nstp_iscpl 
     79         IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified & 
     80            &                                           (larger than run length)' 
     81         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl 
     82         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown 
    7783      END IF 
    7884 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r5835 r5920  
    3434   !! * Substitutions   
    3535#  include "domzgr_substitute.h90"   
     36#  include "vectopt_loop_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    187188      DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
    188189         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 
    189          DO ji = 2,jpi-1 
    190             DO jj = 2,jpj-1 
     190         DO jj = 2,jpj-1 
     191            DO ji = fs_2, fs_jpim1   ! vector opt. 
    191192               jip1=ji+1; jim1=ji-1; 
    192193               jjp1=jj+1; jjm1=jj-1; 
     
    280281      vb(:,:,:)=vn(:,:,:) 
    281282      DO jk = 1,jpk 
    282          DO ji = 1,jpi 
    283             DO jj = 1,jpj 
     283         DO jj = 1,jpj 
     284            DO ji = 1,jpi 
    284285               un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/fse3u_n(ji,jj,jk)*umask(ji,jj,jk); 
    285286               vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/fse3v_n(ji,jj,jk)*vmask(ji,jj,jk); 
     
    310311      zucorr = 0._wp 
    311312      zvcorr = 0._wp 
    312       DO ji = 1,jpi 
    313          DO jj = 1,jpj 
     313      DO jj = 1,jpj 
     314         DO ji = 1,jpi 
    314315            IF (zbun(ji,jj) .NE. zbub(ji,jj) .AND. hu1(ji,jj) .NE. 0._wp ) THEN 
    315316               zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/hu1(ji,jj) 
     
    334335      ztmask1(:,:,:) = ptmask_b(:,:,:) 
    335336      ztmask0(:,:,:) = ptmask_b(:,:,:) 
    336       DO iz = 1,10 ! resolution dependent (OK for ISOMIP+ case) 
     337      DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case) 
    337338          DO jk = 1,jpk-1 
    338339              zdmask=tmask(:,:,jk)-ztmask0(:,:,jk); 
    339               DO ji = 2,jpi-1 
    340                   DO jj = 2,jpj-1 
     340              DO jj = 2,jpj-1 
     341                 DO ji = fs_2,fs_jpim1 
    341342                      jip1=ji+1; jim1=ji-1; 
    342343                      jjp1=jj+1; jjm1=jj-1; 
    343344                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk)) 
     345                      IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 
    344346                      !! horizontal basic extrapolation 
    345                       IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 
    346347                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) & 
    347348                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) & 
     
    353354                         &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk 
    354355                         ztmask1(ji,jj,jk)=1 
    355                       END IF 
    356                       !! vertical extrapolation if horizontal extra failed 
    357                       IF (zdmask(ji,jj)==1._wp .AND. summsk==0._wp) THEN 
     356                      ELSEIF (zdmask(ji,jj)==1._wp .AND. summsk==0._wp) THEN 
     357                      !! vertical extrapolation if horizontal extrapolation failed 
    358358                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1) 
    359359                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1)) 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r5619 r5920  
    136136 
    137137      imask(:,:)=1 
    138       WHERE ( zdta(:,:) - zdtaisf(:,:) <= 1e-2 ) imask = 0 
     138      WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0 
    139139 
    140140      !  1. Dimension arrays for subdomains 
Note: See TracChangeset for help on using the changeset viewer.