- Timestamp:
- 2015-11-29T20:44:49+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r5920 r5945 30 30 31 31 PUBLIC iscpl_stp ! step management 32 PUBLIC iscpl_rst_interpol ! routine to wet and dry 32 PUBLIC iscpl_rst_interpol ! routine to wet and dry ! JMM: why PUBLIC, it is only called 33 ! from this module from iscpl_stp, called from istate ?? 33 34 !! 34 35 !! * Substitutions … … 51 52 !! 52 53 !!---------------------------------------------------------------------- 54 INTEGER :: inum0 53 55 REAL(wp), DIMENSION(:,: ), POINTER :: zsmask_b 54 56 REAL(wp), DIMENSION(:,:,:), POINTER :: ztmask_b, zumask_b, zvmask_b 55 57 REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b , ze3u_b , ze3v_b 56 58 REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b 59 CHARACTER(20) :: cfile 57 60 !!---------------------------------------------------------------------- 58 INTEGER :: inum059 CHARACTER(20) :: cfile60 61 61 62 CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before … … 118 119 fse3u_b (:,:,:) = fse3u_n (:,:,:) 119 120 fse3v_b (:,:,:) = fse3v_n (:,:,:) 121 120 122 IF ( lk_vvl ) THEN 121 123 fse3uw_b(:,:,:) = fse3uw_n(:,:,:) … … 154 156 REAL(wp), DIMENSION(:,: ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t 155 157 REAL(wp), DIMENSION(:,: ), POINTER :: zbub , zbvb , zbun , zbvn 156 REAL(wp), DIMENSION(:,: ), POINTER :: zssh0 , zssh1, hu1,hv1158 REAL(wp), DIMENSION(:,: ), POINTER :: zssh0 , zssh1, zhu1, zhv1 157 159 REAL(wp), DIMENSION(:,: ), POINTER :: zsmask0, zsmask1 158 160 REAL(wp), DIMENSION(:,:,: ), POINTER :: ztmask0, ztmask1, ztrp 159 161 REAL(wp), DIMENSION(:,:,: ), POINTER :: zwmaskn, zwmaskb, ztmp3d 160 162 REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 163 !!---------------------------------------------------------------------- 161 164 162 165 !! allocate variables … … 167 170 CALL wrk_alloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t) 168 171 CALL wrk_alloc(jpi,jpj, zbub , zbvb , zbun , zbvn ) 169 CALL wrk_alloc(jpi,jpj, zssh0 , zssh1, hu1, hv1)172 CALL wrk_alloc(jpi,jpj, zssh0 , zssh1, zhu1, zhv1 ) 170 173 171 174 !! mask value to be sure … … 193 196 jjp1=jj+1; jjm1=jj-1; 194 197 summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1)) 195 IF (zdsmask(ji,jj) ==1._wp .AND. summsk .NE.0._wp) THEN198 IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 196 199 sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj) & 197 200 & + zssh0(jim1,jj)*zsmask0(jim1,jj) & … … 247 250 fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 248 251 END DO 249 IF (mikt(ji,jj) .GT.1) THEN252 IF (mikt(ji,jj) > 1) THEN 250 253 jk = mikt(ji,jj) 251 254 fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk) … … 301 304 302 305 ! new water column 303 hu1=0.0_wp ;304 hv1=0.0_wp ;306 zhu1=0.0_wp ; 307 zhv1=0.0_wp ; 305 308 DO jk = 1,jpk 306 hu1(:,:) =hu1(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)307 hv1(:,:) =hv1(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)309 zhu1(:,:) = zhu1(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 310 zhv1(:,:) = zhv1(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 308 311 END DO 309 312 … … 313 316 DO jj = 1,jpj 314 317 DO ji = 1,jpi 315 IF (zbun(ji,jj) .NE. zbub(ji,jj) .AND. hu1(ji,jj) .NE.0._wp ) THEN316 zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/ hu1(ji,jj)318 IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN 319 zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj) 317 320 END IF 318 IF (zbvn(ji,jj) .NE. zbvb(ji,jj) .AND. hv1(ji,jj) .NE.0._wp ) THEN319 zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/ hv1(ji,jj)321 IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN 322 zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj) 320 323 END IF 321 324 END DO … … 343 346 jjp1=jj+1; jjm1=jj-1; 344 347 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) THEN348 IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 346 349 !! horizontal basic extrapolation 347 350 tsn(ji,jj,jk,1)=( zts0(jip1,jj ,jk,1)*ztmask0(jip1,jj ,jk) & … … 354 357 & +zts0(ji ,jjm1,jk,2)*ztmask0(ji ,jjm1,jk) ) / summsk 355 358 ztmask1(ji,jj,jk)=1 356 ELSEIF (zdmask(ji,jj) ==1._wp .AND. summsk==0._wp) THEN359 ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN 357 360 !! vertical extrapolation if horizontal extrapolation failed 358 361 jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1) 359 362 summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1)) 360 IF (zdmask(ji,jj) ==1._wp .AND. summsk .NE.0._wp ) THEN363 IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN 361 364 tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1) & 362 365 & +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk … … 372 375 CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp) 373 376 CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp) 374 CALL lbc_lnk(ztmask1, 'T',1._wp)377 CALL lbc_lnk(ztmask1, 'T',1._wp) 375 378 376 379 ! update … … 393 396 zdzp1 = MAX(0._wp,fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1)) 394 397 zdz = fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk ) 395 zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk ) - fsdepw_n(ji,jj,jk ))398 zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk ) - fsdepw_n(ji,jj,jk )) 396 399 IF (zdz .LT. 0._wp) THEN 400 !!!!JMM : numout must not be used without IF (lwp) 401 IF ( lwp ) THEN 397 402 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) 398 403 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) … … 405 410 WRITE(numout,*) 'ERROR dz b = ', zwmaskb(ji,jj,jk+1), zwmaskb(ji,jj,jk), zwmaskb(ji,jj,jk-1) 406 411 WRITE(numout,*) 'ERROR dz b = ', gdepw_0(ji,jj,jk+1), gdepw_0(ji,jj,jk), gdepw_0(ji,jj,jk-1) 412 ENDIF 407 413 CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' ) 408 414 END IF … … 423 429 ! case we open a cell but no neigbour cells available to get an estimate of T and S 424 430 WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 425 tsn(:,:,:,2) =-99._wp ! Special value for closed pool (checking purpose in output.init)431 tsn(:,:,:,2) = -99._wp ! Special value for closed pool (checking purpose in output.init) 426 432 tmask(:,:,:) = 0._wp ! set mask to 0 to run 427 433 umask(:,:,:) = 0._wp … … 445 451 CALL wrk_dealloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t) 446 452 CALL wrk_dealloc(jpi,jpj, zbub , zbvb , zbun , zbvn ) 447 CALL wrk_dealloc(jpi,jpj, zssh0 , zssh1 , hu1 , hv1)453 CALL wrk_dealloc(jpi,jpj, zssh0 , zssh1 , zhu1 , zhv1 ) 448 454 449 455 END SUBROUTINE iscpl_rst_interpol
Note: See TracChangeset
for help on using the changeset viewer.
