- Timestamp:
- 2020-09-24T20:42:25+02:00 (5 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tranpc.F90
r13295 r13517 17 17 USE oce ! ocean dynamics and active tracers 18 18 USE dom_oce ! ocean space and time domain 19 ! TEMP: This change not necessary after trd_tra is tiled and extra haloes development (lbc_lnk removed) 20 USE domain, ONLY : dom_tile 19 21 USE phycst ! physical constants 20 22 USE zdf_oce ! ocean vertical physics … … 32 34 33 35 PUBLIC tra_npc ! routine called by step.F90 36 37 INTEGER :: nnpcc ! number of statically instable water column 34 38 35 39 !! * Substitutions … … 64 68 ! 65 69 INTEGER :: ji, jj, jk ! dummy loop indices 66 INTEGER :: inpcc ! number of statically instable water column67 70 INTEGER :: jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low ! local integers 68 71 LOGICAL :: l_bottom_reached, l_column_treated … … 70 73 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_rDt 71 74 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0) 72 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... 73 REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point 74 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^2 75 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zab ! alpha and beta 76 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 75 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... 76 REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point 77 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk ) :: zn2 ! N^2 78 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,jpts) :: zab ! alpha and beta 79 ! TEMP: This change not necessary after trd_tra is tiled 80 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 77 81 ! 78 82 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is … … 82 86 ! 83 87 IF( ln_timing ) CALL timing_start('tra_npc') 88 89 IF( l_trdtra ) THEN 90 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 91 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 92 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 93 ENDIF 94 ENDIF 84 95 ! 85 96 IF( MOD( kt, nn_npc ) == 0 ) THEN 86 97 ! 87 98 IF( l_trdtra ) THEN !* Save initial after fields 88 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 89 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa) 90 ztrds(:,:,:) = pts(:,:,:,jp_sal,Kaa) 91 ENDIF 92 ! 99 DO_3D( 0, 0, 0, 0, 1, jpk ) 100 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Kaa) 101 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Kaa) 102 END_3D 103 ENDIF 104 ! 105 ! TODO: NOT TESTED- requires ORCA2 93 106 IF( l_LB_debug ) THEN 94 107 ! Location of 1 known convection site to follow what's happening in the water column … … 101 114 CALL bn2 ( pts(:,:,:,:,Kaa), zab, zn2, Kmm ) ! after Brunt-Vaisala (given on W-points) 102 115 ! 103 inpcc = 0116 IF( ntile == 0 .OR. ntile == 1 ) nnpcc = 0 ! Do only on the first tile 104 117 ! 105 118 DO_2D( 0, 0, 0, 0 ) … … 160 173 ENDIF 161 174 ! 162 IF( jiter == 1 ) inpcc = inpcc + 1175 IF( jiter == 1 ) nnpcc = nnpcc + 1 163 176 ! 164 177 IF( lp_monitor_point ) WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer … … 301 314 END_2D 302 315 ! 303 IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic 316 ! TEMP: These changes not necessary after trd_tra is tiled and extra haloes development (lbc_lnk removed) 317 IF( l_trdtra ) THEN 304 318 z1_rDt = 1._wp / (2._wp * rn_Dt) 305 ztrdt(:,:,:) = ( pts(:,:,:,jp_tem,Kaa) - ztrdt(:,:,:) ) * z1_rDt 306 ztrds(:,:,:) = ( pts(:,:,:,jp_sal,Kaa) - ztrds(:,:,:) ) * z1_rDt 307 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt ) 308 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds ) 309 DEALLOCATE( ztrdt, ztrds ) 310 ENDIF 311 ! 312 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 313 ! 314 IF( lwp .AND. l_LB_debug ) THEN 315 WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc 316 WRITE(numout,*) 319 320 DO_3D( 0, 0, 0, 0, 1, jpk ) 321 ztrdt(ji,jj,jk) = ( pts(ji,jj,jk,jp_tem,Kaa) - ztrdt(ji,jj,jk) ) * z1_rDt 322 ztrds(ji,jj,jk) = ( pts(ji,jj,jk,jp_sal,Kaa) - ztrds(ji,jj,jk) ) * z1_rDt 323 END_3D 324 ENDIF 325 326 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 327 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 328 329 IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic 330 ! TODO: TO BE TILED- trd_tra 331 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt ) 332 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds ) 333 DEALLOCATE( ztrdt, ztrds ) 334 ENDIF 335 336 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 337 ! 338 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 339 ! 340 IF( lwp .AND. l_LB_debug ) THEN 341 WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', nnpcc 342 WRITE(numout,*) 343 ENDIF 317 344 ENDIF 318 345 !
Note: See TracChangeset
for help on using the changeset viewer.