 Timestamp:
 20160519T10:50:32+02:00 (8 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/UKMO/dev_5518_shlat2d/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r6567 r6568 31 31 USE wrk_nemo ! Memory allocation 32 32 USE timing ! Timing 33 USE iom ! For shlat2d 34 USE fldread ! for sn_shlat2d 33 35 34 36 IMPLICIT NONE … … 137 139 INTEGER , POINTER, DIMENSION(:,:) :: imsk 138 140 REAL(wp), POINTER, DIMENSION(:,:) :: zwf 139 !! 140 NAMELIST/namlbc/ rn_shlat, ln_vorlat 141 142 INTEGER :: inum ! logical unit for shlat2d 143 REAL(wp) :: zshlat !: locally modified shlat for some strait 144 REAL(wp), POINTER, DIMENSION(:,:) :: zshlat2d 145 LOGICAL :: ln_shlat2d 146 TYPE(FLD_N) :: sn_shlat2d 147 !! 148 NAMELIST/namlbc/ rn_shlat, ln_vorlat, ln_shlat2d, sn_shlat2d 141 149 !! 142 150 ! … … 173 181 ENDIF 174 182 183 IF ( ln_shlat2d ) THEN 184 IF(lwp) WRITE(numout,*) ' READ shlat as a 2D coefficient in a file ' 185 CALL wrk_alloc( jpi, jpj, zshlat2d ) 186 CALL iom_open(sn_shlat2d%clname, inum) 187 CALL iom_get (inum, jpdom_data, sn_shlat2d%clvar, zshlat2d, 1) ! 188 CALL iom_close(inum) 189 ENDIF 190 175 191 ! 1. Ocean/land mask at tpoint (computed from mbathy) 176 192 !  … … 185 201 END DO 186 202 END DO 187 203 188 204 ! (ISF) define barotropic mask and mask the ice shelf point 189 205 ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked … … 349 365 DO jk = 1, jpk 350 366 zwf(:,:) = fmask(:,:,jk) 351 DO jj = 2, jpjm1 352 DO ji = fs_2, fs_jpim1 ! vector opt. 353 IF( fmask(ji,jj,jk) == 0._wp ) THEN 354 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 355 & zwf(ji1,jj), zwf(ji,jj1) ) ) 356 ENDIF 357 END DO 358 END DO 367 IF ( ln_shlat2d ) THEN 368 DO jj = 2, jpjm1 369 DO ji = fs_2, fs_jpim1 ! vector opt. 370 IF( fmask(ji,jj,jk) == 0. ) THEN 371 fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp, MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 372 & zwf(ji1,jj), zwf(ji,jj1) ) ) 373 ENDIF 374 END DO 375 END DO 376 ELSE 377 DO jj = 2, jpjm1 378 DO ji = fs_2, fs_jpim1 ! vector opt. 379 IF( fmask(ji,jj,jk) == 0._wp ) THEN 380 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 381 & zwf(ji1,jj), zwf(ji,jj1) ) ) 382 ENDIF 383 END DO 384 END DO 385 ENDIF 359 386 DO jj = 2, jpjm1 360 387 IF( fmask(1,jj,jk) == 0._wp ) THEN … … 496 523 CALL wrk_dealloc( jpi, jpj, imsk ) 497 524 CALL wrk_dealloc( jpi, jpj, zwf ) 525 IF ( ln_shlat2d ) THEN 526 CALL wrk_dealloc( jpi, jpj, zshlat2d ) 527 ENDIF 498 528 ! 499 529 IF( nn_timing == 1 ) CALL timing_stop('dom_msk')
Note: See TracChangeset
for help on using the changeset viewer.