- Timestamp:
- 2015-10-06T13:40:42+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5737 r5777 12 12 !! 3.6 ! 2013-11 (A. Coward) Update for z-tilde compatibility 13 13 !!--------------------------------------------------------------------- 14 #if defined key_dynspg_ts || defined key_esopa14 #if defined key_dynspg_ts 15 15 !!---------------------------------------------------------------------- 16 16 !! 'key_dynspg_ts' split explicit free surface … … 98 98 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 99 99 100 IF( ln_dynvor_een .or. ln_dynvor_een_old) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &101 &ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )100 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 101 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 102 102 103 103 dyn_spg_ts_alloc = MAXVAL(ierr(:)) … … 220 220 ! 221 221 IF ( kt == nit000 .OR. lk_vvl ) THEN 222 IF ( ln_dynvor_een_old ) THEN 223 DO jj = 1, jpjm1 224 DO ji = 1, jpim1 225 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 226 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 227 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 228 END DO 229 END DO 222 IF ( ln_dynvor_een ) THEN !== EEN scheme ==! 223 SELECT CASE( nn_een_e3f ) !* ff/e3 at F-point 224 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 225 DO jj = 1, jpjm1 226 DO ji = 1, jpim1 227 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 228 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 229 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 230 END DO 231 END DO 232 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 233 DO jj = 1, jpjm1 234 DO ji = 1, jpim1 235 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 236 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 237 & / ( MAX( 1._wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 238 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 239 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 240 END DO 241 END DO 242 END SELECT 230 243 CALL lbc_lnk( zwz, 'F', 1._wp ) 231 zwz(:,:) = ff(:,:) * zwz(:,:) 232 244 ! 233 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 234 246 DO jj = 2, jpj 235 DO ji = fs_2, jpi ! vector opt.247 DO ji = 2, jpi 236 248 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 237 249 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) … … 240 252 END DO 241 253 END DO 242 ELSE IF ( ln_dynvor_een ) THEN 243 DO jj = 1, jpjm1 244 DO ji = 1, jpim1 245 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 246 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 247 & / ( MAX( 1.0_wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 248 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 249 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 250 END DO 251 END DO 252 CALL lbc_lnk( zwz, 'F', 1._wp ) 253 zwz(:,:) = ff(:,:) * zwz(:,:) 254 255 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 256 DO jj = 2, jpj 257 DO ji = fs_2, jpi ! vector opt. 258 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 259 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) 260 ftse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) 261 ftsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 262 END DO 263 END DO 264 ELSE 254 ! 255 ELSE !== all other schemes (ENE, ENS, MIX) 265 256 zwz(:,:) = 0._wp 266 zhf(:,:) = 0. 257 zhf(:,:) = 0._wp 267 258 IF ( .not. ln_sco ) THEN 259 260 !!gm agree the JC comment : this should be done in a much clear way 261 268 262 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 269 263 ! Set it to zero for the time being … … 277 271 278 272 DO jj = 1, jpjm1 279 zhf(:,jj) = zhf(:,jj) *(1._wp- umask(:,jj,1) * umask(:,jj+1,1))273 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 280 274 END DO 281 275 … … 298 292 ! If forward start at previous time step, and centered integration, 299 293 ! then update averaging weights: 300 IF ( (.NOT.ln_bt_fw).AND.((neuler==0).AND.(kt==nit000+1))) THEN294 IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 301 295 ll_fw_start=.FALSE. 302 296 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) … … 361 355 END DO 362 356 ! 363 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN ! enstrophy and energy conserving scheme357 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 364 358 DO jj = 2, jpjm1 365 359 DO ji = fs_2, fs_jpim1 ! vector opt. … … 710 704 END DO 711 705 ! 712 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN !== energy and enstrophy conserving scheme ==!706 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 713 707 DO jj = 2, jpjm1 714 708 DO ji = fs_2, fs_jpim1 ! vector opt.
Note: See TracChangeset
for help on using the changeset viewer.
