- Timestamp:
- 2017-05-30T10:13:14+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7831 r8093 28 28 USE sbc_oce ! surface boundary condition: ocean 29 29 USE zdf_oce ! Bottom friction coefts 30 !!gm new 31 USE zdfdrg ! vertical physics: top/bottom drag coef. 32 !!gm 30 33 USE sbcisf ! ice shelf variable (fwfisf) 31 34 USE sbcapr ! surface boundary condition: atmospheric pressure … … 146 149 REAL(wp) :: zraur, z1_2dt_b, z2dt_bf ! local scalars 147 150 REAL(wp) :: zx1, zy1, zx2, zy2 ! - - 148 REAL(wp) :: z1_12, z1_8, z1_4, z1_2 ! - -151 REAL(wp) :: z1_12, z1_8, z1_4, z1_2 ! - - 149 152 REAL(wp) :: zu_spg, zv_spg ! - - 150 REAL(wp) :: zhura, zhvra ! - - 151 REAL(wp) :: za0, za1, za2, za3 ! - - 152 ! 153 REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e 154 REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 155 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv 156 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 157 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 158 REAL(wp), POINTER, DIMENSION(:,:) :: zhf 159 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy ! Wetting/Dying gravity filter coef. 153 REAL(wp) :: zhura, zhvra ! - - 154 REAL(wp) :: za0, za1, za2, za3 ! - - 155 REAL(wp) :: zztmp ! - - 156 REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e 157 REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 158 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zhdiv 159 REAL(wp), DIMENSION(jpi,jpj) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 160 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zsshv_a 161 REAL(wp), DIMENSION(jpi,jpj) :: zhf 162 REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points 163 ! 164 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zcpx, zcpy ! Wetting/Dying gravity filter coef. 160 165 !!---------------------------------------------------------------------- 161 166 ! 162 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_ts') 163 ! 164 ! !* Allocate temporary arrays 165 CALL wrk_alloc( jpi,jpj, zsshp2_e, zhdiv ) 166 CALL wrk_alloc( jpi,jpj, zu_trd, zv_trd) 167 CALL wrk_alloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc) 168 CALL wrk_alloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 169 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a ) 170 CALL wrk_alloc( jpi,jpj, zhf ) 171 IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy ) 167 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_ts') 168 ! 169 IF( ln_wd ) ALLOCATE( zcpx(jpi,jpj), zcpy(jpi,jpj) ) 172 170 ! 173 171 zmdi=1.e+20 ! missing data indicator for masking … … 211 209 ! 212 210 ENDIF 211 ! 212 !!gm old/new 213 IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities) 214 zCdU_u(:,:) = bfrua(:,:) + tfrua(:,:) 215 zCdU_v(:,:) = bfrva(:,:) + tfrva(:,:) 216 ELSE ! bottom friction only 217 zCdU_u(:,:) = bfrua(:,:) 218 zCdU_v(:,:) = bfrva(:,:) 219 ENDIF 220 !!gm new 221 ! IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities) 222 ! DO jj = 2, jpjm1 223 ! DO ji = fs_2, fs_jpim1 ! vector opt. 224 ! zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 225 ! zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 226 ! END DO 227 ! END DO 228 ! ELSE ! bottom friction only 229 ! DO jj = 2, jpjm1 230 ! DO ji = fs_2, fs_jpim1 ! vector opt. 231 ! zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 232 ! zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) 233 ! END DO 234 ! END DO 235 ! ENDIF 236 !!gm 213 237 ! 214 238 ! Set arrays to remove/compute coriolis trend. … … 415 439 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 416 440 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 417 &/ (sshn(ji+1,jj) - sshn(ji ,jj)) )441 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 418 442 ELSE 419 443 zcpx(ji,jj) = 0._wp … … 491 515 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 492 516 IF( ln_wd ) THEN 493 zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 494 zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 517 zztmp = - 1._wp / rdtbt 518 DO jj = 2, jpjm1 519 DO ji = fs_2, fs_jpim1 ! vector opt. 520 !!gm old 521 zu_frc(ji,jj) = zu_frc(ji,jj) + MAX( r1_hu_n(ji,jj) * bfrua(ji,jj) , zztmp ) * zwx(ji,jj) 522 zv_frc(ji,jj) = zv_frc(ji,jj) + MAX( r1_hv_n(ji,jj) * bfrva(ji,jj) , zztmp ) * zwy(ji,jj) 523 !!gm new 524 ! zu_frc(ji,jj) = zu_frc(ji,jj) + MAX( r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp ) * zwx(ji,jj) 525 ! zv_frc(ji,jj) = zv_frc(ji,jj) + MAX( r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp ) * zwy(ji,jj) 526 !!gm 527 END DO 528 END DO 495 529 ELSE 496 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 497 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 530 DO jj = 2, jpjm1 531 DO ji = fs_2, fs_jpim1 ! vector opt. 532 !!gm old 533 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * bfrua(ji,jj) * zwx(ji,jj) 534 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * bfrva(ji,jj) * zwy(ji,jj) 535 !!gm new 536 ! zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj) 537 ! zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj) 538 !!gm 539 END DO 540 END DO 498 541 END IF 499 542 ! … … 520 563 ! 521 564 ! Note that the "unclipped" top friction parameter is used even with explicit drag 522 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 523 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 565 DO jj = 2, jpjm1 566 DO ji = fs_2, fs_jpim1 ! vector opt. 567 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * tfrua(ji,jj) * zwx(ji,jj) 568 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * tfrva(ji,jj) * zwy(ji,jj) 569 END DO 570 END DO 524 571 ! 525 572 IF (ln_bt_fw) THEN ! Add wind forcing 526 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 527 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 573 DO jj = 2, jpjm1 574 DO ji = fs_2, fs_jpim1 ! vector opt. 575 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * utau(ji,jj) * r1_hu_n(ji,jj) 576 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * vtau(ji,jj) * r1_hv_n(ji,jj) 577 END DO 578 END DO 528 579 ELSE 529 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 530 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 580 DO jj = 2, jpjm1 581 DO ji = fs_2, fs_jpim1 ! vector opt. 582 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * z1_2 * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 583 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * z1_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 584 END DO 585 END DO 531 586 ENDIF 532 587 ! … … 885 940 ENDIF 886 941 ! 887 ! Add bottom stresses: 888 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 889 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 890 ! 891 ! Add top stresses: 892 zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 893 zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 942 DO jj = 2, jpjm1 943 DO ji = fs_2, fs_jpim1 ! vector opt. 944 ! Add top/bottom stresses: 945 !!gm old/new 946 zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 947 zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 948 !!gm 949 END DO 950 END DO 894 951 ! 895 952 ! Surface pressure trend: … … 1091 1148 IF( lrst_oce .AND.ln_bt_fw ) CALL ts_rst( kt, 'WRITE' ) 1092 1149 ! 1093 CALL wrk_dealloc( jpi,jpj, zsshp2_e, zhdiv ) 1094 CALL wrk_dealloc( jpi,jpj, zu_trd, zv_trd ) 1095 CALL wrk_dealloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc ) 1096 CALL wrk_dealloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 1097 CALL wrk_dealloc( jpi,jpj, zsshu_a, zsshv_a ) 1098 CALL wrk_dealloc( jpi,jpj, zhf ) 1099 IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy ) 1150 IF( ln_wd ) DEALLOCATE( zcpx, zcpy ) 1100 1151 ! 1101 1152 IF ( ln_diatmb ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
