- Timestamp:
- 2019-11-22T15:29:17+01:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/tranpc.F90
r10425 r11949 42 42 CONTAINS 43 43 44 SUBROUTINE tra_npc( kt )44 SUBROUTINE tra_npc( kt, Kmm, Krhs, pts, Kaa ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE tranpc *** … … 58 58 !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 59 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! ocean time-step index 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kmm, Krhs, Kaa ! time level indices 62 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 61 63 ! 62 64 INTEGER :: ji, jj, jk ! dummy loop indices … … 66 68 REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 67 69 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 68 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0)69 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point...70 REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point71 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^272 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zab ! alpha and beta73 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 70 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0) 71 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... 72 REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point 73 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^2 74 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zab ! alpha and beta 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 74 76 ! 75 77 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is … … 84 86 IF( l_trdtra ) THEN !* Save initial after fields 85 87 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 86 ztrdt(:,:,:) = tsa(:,:,:,jp_tem)87 ztrds(:,:,:) = tsa(:,:,:,jp_sal)88 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa) 89 ztrds(:,:,:) = pts(:,:,:,jp_sal,Kaa) 88 90 ENDIF 89 91 ! … … 95 97 ENDIF 96 98 ! 97 CALL eos_rab( tsa, zab) ! after alpha and beta (given on T-points)98 CALL bn2 ( tsa, zab, zn2) ! after Brunt-Vaisala (given on W-points)99 CALL eos_rab( pts(:,:,:,:,Kaa), zab, Kmm ) ! after alpha and beta (given on T-points) 100 CALL bn2 ( pts(:,:,:,:,Kaa), zab, zn2, Kmm ) ! after Brunt-Vaisala (given on W-points) 99 101 ! 100 102 inpcc = 0 … … 105 107 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points 106 108 ! ! consider one ocean column 107 zvts(:,jp_tem) = tsa(ji,jj,:,jp_tem) ! temperature108 zvts(:,jp_sal) = tsa(ji,jj,:,jp_sal) ! salinity109 zvts(:,jp_tem) = pts(ji,jj,:,jp_tem,Kaa) ! temperature 110 zvts(:,jp_sal) = pts(ji,jj,:,jp_sal,Kaa) ! salinity 109 111 ! 110 112 zvab(:,jp_tem) = zab(ji,jj,:,jp_tem) ! Alpha … … 186 188 DO jk = ikup, ikbot ! Inside the instable (and overlying neutral) portion of the column 187 189 ! 188 zdz = e3t _n(ji,jj,jk)190 zdz = e3t(ji,jj,jk,Kmm) 189 191 zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz 190 192 zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz … … 235 237 236 238 !! Interpolating alfa and beta at W point: 237 zrw = (gdepw _n(ji,jj,jk ) - gdept_n(ji,jj,jk)) &238 & / (gdept _n(ji,jj,jk-1) - gdept_n(ji,jj,jk))239 zrw = (gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm)) & 240 & / (gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm)) 239 241 zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 240 242 zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw … … 243 245 zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) & 244 246 & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) ) & 245 & / e3w _n(ji,jj,jk) * tmask(ji,jj,jk)247 & / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 246 248 247 249 !! OR, faster => just considering the vertical gradient of density … … 286 288 END DO ! DO WHILE ( .NOT. l_column_treated ) 287 289 288 !! Updating tsa:289 tsa(ji,jj,:,jp_tem) = zvts(:,jp_tem)290 tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal)290 !! Updating pts: 291 pts(ji,jj,:,jp_tem,Kaa) = zvts(:,jp_tem) 292 pts(ji,jj,:,jp_sal,Kaa) = zvts(:,jp_sal) 291 293 292 294 !! LB: Potentially some other global variable beside theta and S can be treated here … … 302 304 IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic 303 305 z1_r2dt = 1._wp / (2._wp * rdt) 304 ztrdt(:,:,:) = ( tsa(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt305 ztrds(:,:,:) = ( tsa(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt306 CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt )307 CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds )306 ztrdt(:,:,:) = ( pts(:,:,:,jp_tem,Kaa) - ztrdt(:,:,:) ) * z1_r2dt 307 ztrds(:,:,:) = ( pts(:,:,:,jp_sal,Kaa) - ztrds(:,:,:) ) * z1_r2dt 308 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt ) 309 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds ) 308 310 DEALLOCATE( ztrdt, ztrds ) 309 311 ENDIF 310 312 ! 311 CALL lbc_lnk_multi( 'tranpc', tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )313 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 312 314 ! 313 315 IF( lwp .AND. l_LB_debug ) THEN
Note: See TracChangeset
for help on using the changeset viewer.