Changeset 5920 for branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM
- Timestamp:
- 2015-11-25T17:58:51+01:00 (8 years ago)
- Location:
- branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM
- Files:
-
- 8 edited
-
CONFIG/SHARED/namelist_ref (modified) (2 diffs)
-
NEMO/OPA_SRC/DOM/dom_oce.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DOM/domain.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DOM/iscplhsb.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/DOM/iscplini.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DOM/iscplrst.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/LBC/mppini_2.h90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/CONFIG/SHARED/namelist_ref
r5823 r5920 126 126 nn_msh = 1 ! create (=1) a mesh file or not (=0) 127 127 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 128 129 rn_e3zps_min= 20. ! partial step thickness is set larger than the minimum of 129 130 rn_e3zps_rat= 0.1 ! rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1 … … 473 474 &namsbc_iscpl ! land ice / ocean coupling option 474 475 !----------------------------------------------------------------------- 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) 476 477 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) 477 479 / 478 480 !----------------------------------------------------------------------- -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r5802 r5920 32 32 REAL(wp), PUBLIC :: rn_bathy !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1) 33 33 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 34 35 REAL(wp), PUBLIC :: rn_e3zps_min !: miminum thickness for partial steps (meters) 35 36 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 142 142 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 143 143 & 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, & 150 150 & ppa2, ppkth2, ppacr2 151 151 NAMELIST/namcla/ nn_cla -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5823 r5920 531 531 ! set grounded point to 0 532 532 ! (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 ) 534 534 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 535 535 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp … … 1258 1258 DO jl = 1, 10 1259 1259 ! 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) 1261 1261 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 1262 1262 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
r5835 r5920 33 33 !! * Substitutions 34 34 # include "domzgr_substitute.h90" 35 # include "vectopt_loop_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 57 58 REAL(wp), INTENT(in ) :: prdt_iscpl !! coupling period 58 59 !! 59 INTEGER :: ji, jj, jk !! loop index60 INTEGER :: ji, jj, jk !! loop index 60 61 INTEGER :: jip1, jim1, jjp1, jjm1 61 62 !! 62 63 REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb 63 REAL(wp):: r1_ tiscpl64 REAL(wp):: r1_rdtiscpl 64 65 REAL(wp):: zjip1_ratio , zjim1_ratio , zjjp1_ratio , zjjm1_ratio 65 66 !! 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 73 73 INTEGER :: jpts, npts 74 74 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_wp75 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 82 82 pvol_flx(:,:,: ) = 0.0_wp 83 83 pts_flx (:,:,:,:) = 0.0_wp 84 r1_tiscpl = 1._wp / (prdt_iscpl * rn_rdt) 84 85 r1_rdtiscpl = 1._wp / prdt_iscpl 85 86 86 87 ! mask tsn and tsb … … 93 94 94 95 ! 95 z ssh0(:,:)= sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:)96 IF ( lk_vvl ) z ssh0 = 0.0_wp ! already includein the levels by definition96 zdssh(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:) 97 IF ( lk_vvl ) zdssh = 0.0_wp ! already included in the levels by definition 97 98 98 99 DO jk = 1,jpk-1 99 DO j i = 2,jpi-1100 DO j j = 2,jpj-1100 DO jj = 2,jpj-1 101 DO ji = fs_2,fs_jpim1 101 102 IF (tmask_h(ji,jj) == 1._wp) THEN 102 103 103 104 ! 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) 105 106 106 107 ! heat diff 107 zdtem (ji,jj)= tsn(ji,jj,jk,jp_tem) * fse3t_n(ji,jj,jk) * tmask (ji,jj,jk) &108 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) 109 110 ! salt diff 110 zdsal (ji,jj)= tsn(ji,jj,jk,jp_sal) * fse3t_n(ji,jj,jk) * tmask (ji,jj,jk) &111 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) 112 113 113 114 ! shh changes 114 115 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 vvl116 z ssh0(ji,jj) = 0._wp116 zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl 117 zdssh(ji,jj) = 0._wp 117 118 END IF 118 119 119 120 ! volume, heat and salt differences in each cell 120 pvol_flx(ji,jj,jk) = pvol_flx(ji,jj,jk) + zde3t (ji,jj) * r1_tiscpl121 pts_flx (ji,jj,jk,jp_sal)= pts_flx (ji,jj,jk,jp_sal) + zdsal (ji,jj) * r1_tiscpl122 pts_flx (ji,jj,jk,jp_tem)= pts_flx (ji,jj,jk,jp_tem) + zdtem (ji,jj) * r1_tiscpl121 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 123 124 124 125 ! case where we close a cell: check if the neighbour cells are wet … … 192 193 ! fill narea location with the number of problematic point 193 194 DO jk = 1,jpk-1 194 DO j i = 2,jpi-1195 DO j j = 2,jpj-1195 DO jj = 2,jpj-1 196 DO ji = fs_2,fs_jpim1 196 197 IF ( ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1) == 0._wp .AND. tmask_h(ji,jj) == 1._wp & 197 198 .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN … … 218 219 jpts = SUM(vnpts(1:narea-1)) 219 220 DO jk = 1,jpk-1 220 DO j i = 2,jpi-1221 DO j j = 2,jpj-1221 DO jj = 2,jpj-1 222 DO ji = fs_2,fs_jpim1 222 223 IF ( ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1) == 0._wp .AND. tmask_h(ji,jj) == 1._wp & 223 224 .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN … … 286 287 287 288 ! 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 291 291 END SUBROUTINE iscpl_cons 292 292 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90
r5835 r5920 22 22 PUBLIC iscpl_init 23 23 PUBLIC iscpl_alloc 24 !! !!* namsbc_iscpl namelist *24 !! !!* namsbc_iscpl namelist * 25 25 LOGICAL , PUBLIC :: ln_hsb 26 REAL(wp), PUBLIC :: rn_fiscpl 26 INTEGER , PUBLIC :: nn_fiscpl, nstp_iscpl 27 INTEGER , PUBLIC :: nn_drown 27 28 REAL(wp), PUBLIC :: rdt_iscpl 28 !! !!* namsbc_iscpl namelist *29 !! !!* namsbc_iscpl namelist * 29 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: hdiv_iscpl 30 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: htsc_iscpl … … 50 51 SUBROUTINE iscpl_init() 51 52 INTEGER :: ios ! Local integer output status for namelist read 52 NAMELIST/namsbc_iscpl/ rn_fiscpl,ln_hsb53 NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb 53 54 !!---------------------------------------------------------------------- 54 55 ! ! ============ … … 56 57 ! ! ============ 57 58 ! 58 rn_fiscpl = 2480.59 nn_fiscpl = 0 59 60 ln_hsb = .FALSE. 60 61 REWIND( numnam_ref ) ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling … … 67 68 IF(lwm) WRITE ( numond, namsbc_iscpl ) 68 69 ! 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 70 72 ! 71 73 IF (lwp) THEN 72 74 WRITE(numout,*) 'iscpl_rst:' 73 75 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 77 83 END IF 78 84 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r5835 r5920 34 34 !! * Substitutions 35 35 # include "domzgr_substitute.h90" 36 # include "vectopt_loop_substitute.h90" 36 37 !!---------------------------------------------------------------------- 37 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 187 188 DO iz = 1,10 ! need to be tuned (configuration dependent) (OK for ISOMIP+) 188 189 zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 189 DO j i = 2,jpi-1190 DO j j = 2,jpj-1190 DO jj = 2,jpj-1 191 DO ji = fs_2, fs_jpim1 ! vector opt. 191 192 jip1=ji+1; jim1=ji-1; 192 193 jjp1=jj+1; jjm1=jj-1; … … 280 281 vb(:,:,:)=vn(:,:,:) 281 282 DO jk = 1,jpk 282 DO j i = 1,jpi283 DO j j = 1,jpj283 DO jj = 1,jpj 284 DO ji = 1,jpi 284 285 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); 285 286 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); … … 310 311 zucorr = 0._wp 311 312 zvcorr = 0._wp 312 DO j i = 1,jpi313 DO j j = 1,jpj313 DO jj = 1,jpj 314 DO ji = 1,jpi 314 315 IF (zbun(ji,jj) .NE. zbub(ji,jj) .AND. hu1(ji,jj) .NE. 0._wp ) THEN 315 316 zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/hu1(ji,jj) … … 334 335 ztmask1(:,:,:) = ptmask_b(:,:,:) 335 336 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) 337 338 DO jk = 1,jpk-1 338 339 zdmask=tmask(:,:,jk)-ztmask0(:,:,jk); 339 DO j i = 2,jpi-1340 DO jj = 2,jpj-1340 DO jj = 2,jpj-1 341 DO ji = fs_2,fs_jpim1 341 342 jip1=ji+1; jim1=ji-1; 342 343 jjp1=jj+1; jjm1=jj-1; 343 344 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 344 346 !! horizontal basic extrapolation 345 IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN346 347 tsn(ji,jj,jk,1)=( zts0(jip1,jj ,jk,1)*ztmask0(jip1,jj ,jk) & 347 348 & +zts0(jim1,jj ,jk,1)*ztmask0(jim1,jj ,jk) & … … 353 354 & +zts0(ji ,jjm1,jk,2)*ztmask0(ji ,jjm1,jk) ) / summsk 354 355 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 358 358 jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1) 359 359 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 136 136 137 137 imask(:,:)=1 138 WHERE ( zdta(:,:) - zdtaisf(:,:) <= 1e-2) imask = 0138 WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0 139 139 140 140 ! 1. Dimension arrays for subdomains
Note: See TracChangeset
for help on using the changeset viewer.
