Changeset 5823 for branches/NERC
- Timestamp:
- 2015-10-22T17:18:18+02:00 (9 years ago)
- Location:
- branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/CONFIG/SHARED/namelist_ref
r5619 r5823 474 474 !----------------------------------------------------------------------- 475 475 rn_fiscpl = 43800 ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency) 476 ln_h fb = .false. ! activate conservation module (conservation exact after a time of rn_fiscpl)476 ln_hsb = .false. ! activate conservation module (conservation exact after a time of rn_fiscpl) 477 477 / 478 478 !----------------------------------------------------------------------- … … 810 810 rn_smsh = 1. ! Smagorinsky diffusivity: = 0 - use only sheer 811 811 rn_aht_m = 2000. ! upper limit or stability criteria for lateral eddy diffusivity (m2/s) 812 /813 !-----------------------------------------------------------------------814 &namtra_dmpfile ! tracer: T & S newtonian damping815 !-----------------------------------------------------------------------816 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !817 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !818 sn_dmpt = 'resto', -1 ,'Tinit' , .true. , .true. , 'yearly' , '' , '' , ''819 sn_dmps = 'resto', -1 ,'Sinit' , .true. , .true. , 'yearly' , '' , '' , ''820 812 / 821 813 !----------------------------------------------------------------------- -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5820 r5823 140 140 ! 2 - Content variations ! 141 141 ! ------------------------ ! 142 ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl) 142 143 zdiff_v2 = 0._wp 143 144 zdiff_hc = 0._wp … … 160 161 z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 161 162 END IF 162 z_ssh_hc = glob_sum ( z2d0 )163 z_ssh_sc = glob_sum ( z2d1 )163 z_ssh_hc = glob_sum_full( z2d0 ) 164 z_ssh_sc = glob_sum_full( z2d1 ) 164 165 ENDIF 165 166 … … 201 202 ! ENDIF 202 203 !!gm end 203 IF ( lk_vvl ) THEN204 IF (lwp) PRINT *, 'cons heat : ', kt, zdiff_hc / zvol_tot, zdiff_sc / zvol_tot205 IF (lwp) PRINT *, 'cons volu : ', kt, zdiff_v2 * 1.e-9206 ELSE207 IF (lwp) PRINT *, 'cons heat : ', kt, zdiff_hc1 * 1.e-20 * rau0 * rcp, zdiff_sc1 * 1.e-9208 IF (lwp) PRINT *, 'cons vol : ', kt, zdiff_v1 * 1.e-9209 END IF210 204 IF( lk_vvl ) THEN 211 205 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) … … 269 263 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 270 264 ENDIF 271 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) 265 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 272 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 273 267 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) … … 323 317 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 324 318 ENDIF 325 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) 319 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 326 320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 327 321 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5802 r5823 529 529 WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp 530 530 531 ! set grounded point to 0 (treshold at 1cm, have to be update after first coupling experience) 532 WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 531 ! set grounded point to 0 532 ! (a treshold could be set here if needed, or set it offline based on the grounded fraction) 533 WHERE ( bathy(:,:) .LE. risfdep(:,:) ) 533 534 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 534 535 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp … … 575 576 ! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin 576 577 IF ( ln_isfcav ) THEN 577 WHERE ( bathy == risfdep)578 WHERE ( bathy == risfdep ) 578 579 bathy = 0.0_wp ; risfdep = 0.0_wp 579 580 END WHERE -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
r5820 r5823 103 103 ! heat diff 104 104 zdtem(ji,jj) = tsn(ji,jj,jk,jp_tem) * fse3t_n(ji,jj,jk) * tmask (ji,jj,jk) & 105 - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)105 - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk) 106 106 ! salt diff 107 107 zdsal(ji,jj) = tsn(ji,jj,jk,jp_sal) * fse3t_n(ji,jj,jk) * tmask (ji,jj,jk) & -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90
r5790 r5823 13 13 USE dom_oce ! ocean space and time domain 14 14 USE oce ! global tra/dyn variable 15 USE in_out_manager ! I/O manager16 15 USE lib_mpp ! MPP library 17 16 USE lib_fortran ! MPP library 18 USE i om17 USE in_out_manager ! I/O manager 19 18 20 19 IMPLICIT NONE … … 45 44 ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc ) 46 45 ! 47 IF( lk_mpp 46 IF( lk_mpp ) CALL mpp_sum ( iscpl_alloc ) 48 47 IF( iscpl_alloc > 0 ) CALL ctl_warn('iscpl_alloc: allocation of arrays failed') 49 48 END FUNCTION iscpl_alloc -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r5820 r5823 21 21 USE lib_fortran ! MPP library 22 22 USE wrk_nemo ! Memory allocation 23 USE lbclnk 24 USE domngb 25 USE sbc_ice, ONLY : lk_lim3 26 USE iscplini 27 USE iscplhsb 23 USE lbclnk ! communication 24 USE iscplini ! ice sheet coupling: initialisation 25 USE iscplhsb ! ice sheet coupling: conservation 28 26 29 27 IMPLICIT NONE 30 28 PRIVATE 31 29 32 PUBLIC iscpl_stp 30 PUBLIC iscpl_stp ! step management 33 31 PUBLIC iscpl_rst_interpol ! routine to wet and dry 34 32 !! … … 55 53 REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b , ze3u_b , ze3v_b 56 54 REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b 57 !!----------------------------------------------------------------------55 !!---------------------------------------------------------------------- 58 56 INTEGER :: inum0 59 57 CHARACTER(20) :: cfile … … 141 139 REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b !! mask before 142 140 REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: pe3t_b , pe3u_b , pe3v_b !! scale factor before 143 REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: pdepw_b 141 REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: pdepw_b !! depth w before 144 142 REAL(wp), DIMENSION(:,: ), INTENT(in ) :: psmask_b !! mask before 145 143 !! … … 157 155 REAL(wp), DIMENSION(:,:,: ), POINTER :: zwmaskn, zwmaskb, ztmp3d 158 156 REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 159 !! 157 158 !! allocate variables 160 159 CALL wrk_alloc(jpi,jpj,jpk,2, zts0 ) 161 160 CALL wrk_alloc(jpi,jpj,jpk, ztmask0, ztmask1 , ztrp, ztmp3d ) … … 165 164 CALL wrk_alloc(jpi,jpj, zbub , zbvb , zbun , zbvn ) 166 165 CALL wrk_alloc(jpi,jpj, zssh0 , zssh1, hu1, hv1 ) 166 167 167 !! mask value to be sure 168 168 tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:) … … 182 182 zsmask0(:,:) = psmask_b(:,:) 183 183 zsmask1(:,:) = psmask_b(:,:) 184 DO iz = 1,10 ! need to be tuned (configuration dependent) 184 DO iz = 1,10 ! need to be tuned (configuration dependent) (OK for ISOMIP+) 185 185 zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 186 186 DO ji = 2,jpi-1 … … 189 189 jjp1=jj+1; jjm1=jj-1; 190 190 summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1)) 191 IF (zdsmask(ji,jj)==1 .AND. summsk .NE. 0) THEN191 IF (zdsmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 192 192 sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj) & 193 193 & + zssh0(jim1,jj)*zsmask0(jim1,jj) & 194 194 & + zssh0(ji,jjp1)*zsmask0(ji,jjp1) & 195 195 & + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk 196 zsmask1(ji,jj)=1 196 zsmask1(ji,jj)=1._wp 197 197 END IF 198 198 END DO 199 199 END DO 200 CALL lbc_lnk(sshn,'T',1. )201 CALL lbc_lnk(zsmask1,'T',1. )200 CALL lbc_lnk(sshn,'T',1._wp) 201 CALL lbc_lnk(zsmask1,'T',1._wp) 202 202 zssh0 = sshn 203 203 zsmask0 = zsmask1 … … 257 257 END DO 258 258 259 hu(:,:) = 0._wp ! Ocean depth at U-points260 hv(:,:) = 0._wp ! Ocean depth at V-points261 ht(:,:) = 0._wp ! Ocean depth at T-points259 ! t-, u- and v- water column thickness 260 ! ------------------------------------ 261 ht(:,:) = 0._wp ; hu(:,:) = 0._wp ; hv(:,:) = 0._wp 262 262 DO jk = 1, jpkm1 263 263 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) … … 272 272 273 273 !============================================================================= 274 275 274 ! compute velocity 276 275 ! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor). … … 332 331 ztmask1(:,:,:) = ptmask_b(:,:,:) 333 332 ztmask0(:,:,:) = ptmask_b(:,:,:) 334 DO iz = 1,10 333 DO iz = 1,10 ! resolution dependent (OK for ISOMIP+ case) 335 334 DO jk = 1,jpk-1 336 335 zdmask=tmask(:,:,jk)-ztmask0(:,:,jk); … … 341 340 summsk= (ztmask0(jip1,jj ,jk)+ztmask0(jim1,jj ,jk)+ztmask0(ji ,jjp1,jk)+ztmask0(ji ,jjm1,jk)) 342 341 !! horizontal basic extrapolation 343 IF (zdmask(ji,jj)==1 .AND. summsk .NE. 0) THEN342 IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 344 343 tsn(ji,jj,jk,1)=( zts0(jip1,jj ,jk,1)*ztmask0(jip1,jj ,jk) & 345 344 & +zts0(jim1,jj ,jk,1)*ztmask0(jim1,jj ,jk) & … … 353 352 END IF 354 353 !! vertical extrapolation if horizontal extra failed 355 IF (zdmask(ji,jj)==1 .AND. summsk==0) THEN354 IF (zdmask(ji,jj)==1._wp .AND. summsk==0._wp) THEN 356 355 jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1) 357 356 summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1)) 358 IF (zdmask(ji,jj)==1 .AND. summsk .NE. 0) THEN357 IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp ) THEN 359 358 tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1) & 360 359 & +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk 361 360 tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1) & 362 361 & +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk 363 ztmask1(ji,jj,jk)=1 362 ztmask1(ji,jj,jk)=1._wp 364 363 END IF 365 364 END IF … … 367 366 END DO 368 367 END DO 369 CALL lbc_lnk(tsn(:,:,:,1),'T',1.) 370 CALL lbc_lnk(tsn(:,:,:,2),'T',1.) 371 CALL lbc_lnk(ztmask1,'T',1.) 368 369 CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp) 370 CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp) 371 CALL lbc_lnk(ztmask1,'T',1._wp) 372 373 ! update 372 374 zts0(:,:,:,:) = tsn(:,:,:,:) 373 375 ztmask0 = ztmask1 374 END DO 376 377 END DO 378 379 ! mask new tsn field 375 380 tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:) 376 381 tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) … … 381 386 DO jj = 1,jpj 382 387 DO ji = 1,jpi 383 IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1. 0_wp .AND. (tmask(ji,jj,1)==0 .OR. ptmask_b(ji,jj,1)==0) ) THEN388 IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN 384 389 !compute weight 385 390 zdzp1 = MAX(0._wp,fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1)) 386 391 zdz = fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk ) 387 392 zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk ) - fsdepw_n(ji,jj,jk )) 388 IF (zdz .LT. 0. 0_wp) THEN393 IF (zdz .LT. 0._wp) THEN 389 394 WRITE(numout,*) 'ERROR dz n ', ji,jj,jk,zdz,fsdepw_n(ji,jj,jk+1),fsdepw_n(ji,jj,jk),fsdepw_n(ji,jj,jk-1) 390 395 WRITE(numout,*) 'ERROR dz n = ',fse3t_n (ji,jj,jk+1),fse3t_n (ji,jj,jk),fse3t_n (ji,jj,jk-1), sshn(ji,jj) … … 411 416 END IF 412 417 413 ! Special value for closed pool and set the mask to 0 to run 414 WHERE (tmask(:,:,:) == 1.0 .AND. tsn(:,:,:,2) == 0._wp) 415 tsn(:,:,:,2)= -99._wp 416 tmask(:,:,:) = 0.0 417 umask(:,:,:) = 0.0 418 vmask(:,:,:) = 0.0 418 ! closed pool 419 ! ----------------------------------------------------------------------------------------- 420 ! case we open a cell but no neigbour cells available to get an estimate of T and S 421 WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 422 tsn(:,:,:,2)= -99._wp ! Special value for closed pool (checking purpose in output.init) 423 tmask(:,:,:) = 0._wp ! set mask to 0 to run 424 umask(:,:,:) = 0._wp 425 vmask(:,:,:) = 0._wp 419 426 END WHERE 420 427 428 ! set mbkt and mikt to 1 in thiese location 421 429 WHERE (SUM(tmask,dim=3) == 0) 422 430 mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1 423 431 mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1 424 432 END WHERE 425 433 ! ------------------------------------------------------------------------------------------- 426 434 ! compute new tn and sn if we close cell 427 435 ! nothing to do
Note: See TracChangeset
for help on using the changeset viewer.