Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
- Timestamp:
- 2015-12-03T09:10:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5260 r5989 2 2 !!============================================================================== 3 3 !! *** MODULE traldf_lap *** 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend4 !! Ocean tracers: lateral diffusivity trend (laplacian and bilaplacian) 5 5 !!============================================================================== 6 !! History : OPA ! 87-06 (P. Andrich, D. L Hostis) Original code 7 !! ! 91-11 (G. Madec) 8 !! ! 95-11 (G. Madec) suppress volumetric scale factors 9 !! ! 96-01 (G. Madec) statement function for e3 10 !! NEMO ! 02-06 (G. Madec) F90: Free form and module 11 !! 1.0 ! 04-08 (C. Talandier) New trends organization 12 !! ! 05-11 (G. Madec) add zps case 13 !! 3.0 ! 10-06 (C. Ethe, G. Madec) Merge TRA-TRC 6 !! History : OPA ! 1987-06 (P. Andrich, D. L Hostis) Original code 7 !! ! 1991-11 (G. Madec) 8 !! ! 1995-11 (G. Madec) suppress volumetric scale factors 9 !! ! 1996-01 (G. Madec) statement function for e3 10 !! NEMO ! 2002-06 (G. Madec) F90: Free form and module 11 !! 1.0 ! 2004-08 (C. Talandier) New trends organization 12 !! ! 2005-11 (G. Madec) add zps case 13 !! 3.0 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC 14 !! 3.7 ! 2014-01 (G. Madec, S. Masson) re-entrant laplacian 14 15 !!---------------------------------------------------------------------- 15 16 16 17 !!---------------------------------------------------------------------- 17 !! tra_ldf_lap : update the tracer trend with the horizontal diffusion18 !! using a iso-level harmonic (laplacien) operator.18 !! tra_ldf_lap : update the tracer trend with the lateral diffusion : iso-level laplacian operator 19 !! tra_ldf_blp : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator 19 20 !!---------------------------------------------------------------------- 20 21 USE oce ! ocean dynamics and active tracers 21 22 USE dom_oce ! ocean space and time domain 22 USE ldftra_oce ! ocean active tracers: lateral physics 23 USE in_out_manager ! I/O manager 23 USE ldftra ! lateral physics: eddy diffusivity 24 24 USE diaptr ! poleward transport diagnostics 25 25 USE trc_oce ! share passive tracers/Ocean variables 26 USE lib_mpp ! MPP library 26 USE zpshde ! partial step: hor. derivative (zps_hde routine) 27 ! 28 USE in_out_manager ! I/O manager 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE lib_mpp ! distribued memory computing library 27 31 USE timing ! Timing 32 USE wrk_nemo ! Memory allocation 28 33 29 34 IMPLICIT NONE 30 35 PRIVATE 31 36 32 PUBLIC tra_ldf_lap ! routine called by step.F9037 PUBLIC tra_ldf_lap ! routine called by traldf.F90 33 38 34 39 !! * Substitutions 35 40 # include "domzgr_substitute.h90" 36 # include "ldftra_substitute.h90"37 41 # include "vectopt_loop_substitute.h90" 38 42 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)43 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 40 44 !! $Id$ 41 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 47 CONTAINS 44 48 45 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, p gu , pgv ,&46 & pgui, pgvi,&47 & ptb, pta, kjpt)49 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv , & 50 & pgui, pgvi, & 51 & ptb , pta , kjpt, kpass ) 48 52 !!---------------------------------------------------------------------- 49 53 !! *** ROUTINE tra_ldf_lap *** … … 55 59 !! fields (forward time scheme). The horizontal diffusive trends of 56 60 !! the tracer is given by: 57 !! difft = 1/(e1 t*e2t*e3t) { di-1[ ahte2u*e3u/e1u di(tb) ]58 !! + dj-1[ ahte1v*e3v/e2v dj(tb) ] }61 !! difft = 1/(e1e2t*e3t) { di-1[ pahu e2u*e3u/e1u di(tb) ] 62 !! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 59 63 !! Add this trend to the general tracer trend pta : 60 64 !! pta = pta + difft … … 63 67 !! harmonic mixing trend. 64 68 !!---------------------------------------------------------------------- 65 USE oce, ONLY: ztu => ua , ztv => va ! (ua,va) used as workspace66 !67 69 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 INTEGER , INTENT(in ) :: kit000 70 INTEGER , INTENT(in ) :: kit000 ! first time step index 69 71 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 70 72 INTEGER , INTENT(in ) :: kjpt ! number of tracers 73 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 74 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 71 75 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 72 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels76 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 73 77 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 74 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 75 79 ! 76 INTEGER :: ji, jj, jk, jn 77 INTEGER :: iku, ikv, ierr ! local integers78 REAL(wp) :: zabe1, zabe2, zbtr ! local scalars80 INTEGER :: ji, jj, jk, jn ! dummy loop indices 81 REAL(wp) :: zsign ! local scalars 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zaheeu, zaheev 79 83 !!---------------------------------------------------------------------- 80 84 ! 81 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap')85 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap') 82 86 ! 83 IF( kt == kit000) THEN84 IF(lwp)WRITE(numout,*)85 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype86 IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '87 IF( kt == nit000 .AND. lwp ) THEN 88 WRITE(numout,*) 89 WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 90 WRITE(numout,*) '~~~~~~~~~~~ ' 87 91 ENDIF 88 89 ! ! =========== ! 90 DO jn = 1, kjpt ! tracer loop ! 91 ! ! =========== ! 92 DO jk = 1, jpkm1 ! slab loop 93 ! 94 ! 1. First derivative (gradient) 95 ! ------------------- 92 ! 93 CALL wrk_alloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev ) 94 ! 95 ! !== Initialization of metric arrays used for all tracers ==! 96 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) 97 ELSE ; zsign = -1._wp 98 ENDIF 99 DO jk = 1, jpkm1 100 DO jj = 1, jpjm1 101 DO ji = 1, fs_jpim1 ! vector opt. 102 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) !!gm * umask(ji,jj,jk) pah masked! 103 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) !!gm * vmask(ji,jj,jk) 104 END DO 105 END DO 106 END DO 107 ! 108 ! ! =========== ! 109 DO jn = 1, kjpt ! tracer loop ! 110 ! ! =========== ! 111 ! 112 DO jk = 1, jpkm1 !== First derivative (gradient) ==! 96 113 DO jj = 1, jpjm1 97 DO ji = 1, fs_jpim1 ! vector opt. 98 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 99 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 100 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 101 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 114 DO ji = 1, fs_jpim1 115 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 116 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 102 117 END DO 103 118 END DO 104 IF( ln_zps ) THEN ! set gradient at partial step level for the last ocean cell 119 END DO 120 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 121 DO jj = 1, jpjm1 ! bottom 122 DO ji = 1, fs_jpim1 123 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 124 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 125 END DO 126 END DO 127 IF( ln_isfcav ) THEN ! top in ocean cavities only 105 128 DO jj = 1, jpjm1 106 129 DO ji = 1, fs_jpim1 ! vector opt. 107 ! last level 108 iku = mbku(ji,jj) 109 ikv = mbkv(ji,jj) 110 IF( iku == jk ) THEN 111 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 112 ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 113 ENDIF 114 IF( ikv == jk ) THEN 115 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 116 ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 117 ENDIF 130 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 131 IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 118 132 END DO 119 133 END DO 120 134 ENDIF 121 ! (ISH) 122 IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level for the first ocean cell 123 ! into a cavity 124 DO jj = 1, jpjm1 125 DO ji = 1, fs_jpim1 ! vector opt. 126 ! ice shelf level level MAX(2,jk) => only where ice shelf 127 iku = miku(ji,jj) 128 ikv = mikv(ji,jj) 129 IF( iku == MAX(2,jk) ) THEN 130 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 131 ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn) 132 ENDIF 133 IF( ikv == MAX(2,jk) ) THEN 134 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 135 ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn) 136 END IF 137 END DO 138 END DO 139 ENDIF 140 141 142 ! 2. Second derivative (divergence) added to the general tracer trends 143 ! --------------------------------------------------------------------- 135 ENDIF 136 ! 137 DO jk = 1, jpkm1 !== Second derivative (divergence) added to the general tracer trends ==! 144 138 DO jj = 2, jpjm1 145 DO ji = fs_2, fs_jpim1 ! vector opt. 146 zbtr = 1._wp / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 147 ! horizontal diffusive trends added to the general tracer trends 148 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 149 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 139 DO ji = fs_2, fs_jpim1 140 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 141 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 142 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 150 143 END DO 151 144 END DO 152 ! 153 END DO ! End of slab 145 END DO 154 146 ! 155 ! "Poleward" diffusive heat or salt transports 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 157 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 158 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 147 ! !== "Poleward" diffusive heat or salt transports ==! 148 IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==! 149 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==! 150 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 151 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -ztv(:,:,:) ) 152 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -ztv(:,:,:) ) 153 ENDIF 159 154 ENDIF 160 ! ! ================== 161 END DO ! end of tracer loop 162 ! ! ================== 163 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 155 ! ! ================== 156 END DO ! end of tracer loop 157 ! ! ================== 158 ! 159 CALL wrk_dealloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev ) 160 ! 161 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 164 162 ! 165 163 END SUBROUTINE tra_ldf_lap 166 164 167 165 !!============================================================================== 168 166 END MODULE traldf_lap
Note: See TracChangeset
for help on using the changeset viewer.
