- Timestamp:
- 2015-10-22T17:18:18+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.
