Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
- Property svn:eol-style deleted
r1152 r2528 2 2 !!============================================================================== 3 3 !! *** MODULE traldf_lap *** 4 !! Ocean activetracers: horizontal component of the lateral tracer mixing trend4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 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 14 !!---------------------------------------------------------------------- 6 15 7 16 !!---------------------------------------------------------------------- … … 9 18 !! using a iso-level harmonic (laplacien) operator. 10 19 !!---------------------------------------------------------------------- 11 !! * Modules used12 20 USE oce ! ocean dynamics and active tracers 13 21 USE dom_oce ! ocean space and time domain 14 22 USE ldftra_oce ! ocean active tracers: lateral physics 15 USE trdmod ! ocean active tracers trends16 USE trdmod_oce ! ocean variables trends17 23 USE in_out_manager ! I/O manager 18 24 USE diaptr ! poleward transport diagnostics 19 USE prtctl ! Print control 20 25 USE trc_oce ! share passive tracers/Ocean variables 21 26 22 27 IMPLICIT NONE 23 28 PRIVATE 24 29 25 !! * Routine accessibility 26 PUBLIC tra_ldf_lap ! routine called by step.F90 30 PUBLIC tra_ldf_lap ! routine called by step.F90 31 32 REAL(wp), DIMENSION(jpi,jpj) :: e1ur, e2vr ! scale factor coefficients 27 33 28 34 !! * Substitutions … … 31 37 # include "vectopt_loop_substitute.h90" 32 38 !!---------------------------------------------------------------------- 33 !! OPA 9.0 , LOCEAN-IPSL (2005)34 !! $Id$ 35 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 40 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 42 !!---------------------------------------------------------------------- 37 38 43 CONTAINS 39 44 40 SUBROUTINE tra_ldf_lap( kt ) 45 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, & 46 & ptb, pta, kjpt ) 41 47 !!---------------------------------------------------------------------- 42 48 !! *** ROUTINE tra_ldf_lap *** … … 47 53 !! ** Method : Second order diffusive operator evaluated using before 48 54 !! fields (forward time scheme). The horizontal diffusive trends of 49 !! t emperature (idem for salinity)is given by:55 !! the tracer is given by: 50 56 !! difft = 1/(e1t*e2t*e3t) { di-1[ aht e2u*e3u/e1u di(tb) ] 51 57 !! + dj-1[ aht e1v*e3v/e2v dj(tb) ] } 52 !! Note: key_zco defined, the e3t=e3u=e3v, the trend becomes: 53 !! difft = 1/(e1t*e2t) { di-1[ aht e2u/e1u di(tb) ] 54 !! + dj-1[ aht e1v/e2v dj(tb) ] } 55 !! Add this trend to the general tracer trend (ta,sa): 56 !! (ta,sa) = (ta,sa) + ( difft , diffs ) 58 !! Add this trend to the general tracer trend pta : 59 !! pta = pta + difft 57 60 !! 58 !! ** Action : - Update (ta,sa)arrays with the before iso-level61 !! ** Action : - Update pta arrays with the before iso-level 59 62 !! harmonic mixing trend. 63 !!---------------------------------------------------------------------- 64 USE oce , ztu => ua ! use ua as workspace 65 USE oce , ztv => va ! use va as workspace 60 66 !! 61 !! History : 62 !! 1.0 ! 87-06 (P. Andrich, D. L Hostis) Original code 63 !! ! 91-11 (G. Madec) 64 !! ! 95-11 (G. Madec) suppress volumetric scale factors 65 !! ! 96-01 (G. Madec) statement function for e3 66 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 67 !! 9.0 ! 04-08 (C. Talandier) New trends organization 68 !! ! 05-11 (G. Madec) add zps case 69 !!---------------------------------------------------------------------- 70 USE oce , ztu => ua, & ! use ua as workspace 71 & zsu => va ! use va as workspace 72 73 !! * Arguments 74 INTEGER, INTENT( in ) :: kt ! ocean time-step index 75 76 !! * Local save 77 REAL(wp), DIMENSION(jpi,jpj), SAVE :: & 78 ze1ur, ze2vr, zbtr2 ! scale factor coefficients 79 80 !! * Local declarations 81 INTEGER :: ji, jj, jk ! dummy loop indices 82 INTEGER :: iku, ikv ! temporary integers 83 REAL(wp) :: & 84 zabe1, zta, & ! temporary scalars 85 zabe2, zsa, zbtr ! " " 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 87 ztv, zsv ! 3D workspace 67 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 71 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 72 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 73 !! 74 INTEGER :: ji, jj, jk, jn ! dummy loop indices 75 INTEGER :: iku, ikv ! local integers 76 REAL(wp) :: zabe1, zabe2, zbtr ! local scalars 88 77 !!---------------------------------------------------------------------- 89 78 90 IF( kt == nit000 ) THEN79 IF( kt == nit000 ) THEN 91 80 IF(lwp) WRITE(numout,*) 92 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion '81 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 93 82 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 94 ze1ur(:,:) = e2u(:,:) / e1u(:,:) 95 ze2vr(:,:) = e1v(:,:) / e2v(:,:) 96 zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 83 e1ur(:,:) = e2u(:,:) / e1u(:,:) 84 e2vr(:,:) = e1v(:,:) / e2v(:,:) 97 85 ENDIF 98 99 ! ! ============= 100 DO jk = 1, jpkm1 ! Vertical slab 101 ! ! ============= 102 ! 1. First derivative (gradient) 103 ! ------------------- 104 DO jj = 1, jpjm1 105 DO ji = 1, fs_jpim1 ! vector opt. 106 #if defined key_zco 107 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) 108 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) 109 #else 110 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk) 111 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk) 112 #endif 113 ztu(ji,jj,jk) = zabe1 * ( tb(ji+1,jj ,jk) - tb(ji,jj,jk) ) 114 zsu(ji,jj,jk) = zabe1 * ( sb(ji+1,jj ,jk) - sb(ji,jj,jk) ) 115 ztv(ji,jj,jk) = zabe2 * ( tb(ji ,jj+1,jk) - tb(ji,jj,jk) ) 116 zsv(ji,jj,jk) = zabe2 * ( sb(ji ,jj+1,jk) - sb(ji,jj,jk) ) 117 END DO 118 END DO 119 IF( ln_zps ) THEN ! set gradient at partial step level 86 87 ! ! =========== ! 88 DO jn = 1, kjpt ! tracer loop ! 89 ! ! =========== ! 90 DO jk = 1, jpkm1 ! slab loop 91 ! 92 ! 1. First derivative (gradient) 93 ! ------------------- 120 94 DO jj = 1, jpjm1 121 95 DO ji = 1, fs_jpim1 ! vector opt. 122 ! last level 123 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj ) ) - 1 124 ikv = MIN ( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1 125 IF( iku == jk ) THEN 126 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * ze1ur(ji,jj) * fse3u(ji,jj,iku) 127 ztu(ji,jj,jk) = zabe1 * gtu(ji,jj) 128 zsu(ji,jj,jk) = zabe1 * gsu(ji,jj) 129 ENDIF 130 IF( ikv == jk ) THEN 131 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * ze2vr(ji,jj) * fse3v(ji,jj,ikv) 132 ztv(ji,jj,jk) = zabe2 * gtv(ji,jj) 133 zsv(ji,jj,jk) = zabe2 * gsv(ji,jj) 134 ENDIF 96 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk) 97 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk) 98 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 99 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 135 100 END DO 136 101 END DO 137 ENDIF 102 IF( ln_zps ) THEN ! set gradient at partial step level 103 DO jj = 1, jpjm1 104 DO ji = 1, fs_jpim1 ! vector opt. 105 ! last level 106 iku = mbku(ji,jj) 107 ikv = mbkv(ji,jj) 108 IF( iku == jk ) THEN 109 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku) 110 ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 111 ENDIF 112 IF( ikv == jk ) THEN 113 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv) 114 ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 115 ENDIF 116 END DO 117 END DO 118 ENDIF 138 119 139 120 140 ! 2. Second derivative (divergence) 141 ! -------------------- 142 DO jj = 2, jpjm1 143 DO ji = fs_2, fs_jpim1 ! vector opt. 144 #if defined key_zco 145 zbtr = zbtr2(ji,jj) 146 #else 147 zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 148 #endif 149 ! horizontal diffusive trends 150 zta = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 151 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 152 zsa = zbtr * ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) & 153 & + zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) 154 ! add it to the general tracer trends 155 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 156 sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 157 END DO 158 END DO 159 ! ! ============= 160 END DO ! End of slab 161 ! ! ============= 162 163 ! "zonal" mean lateral diffusive heat and salt transport 164 IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 165 IF( lk_zco ) THEN ! z-coordinate - full step (1D arrays) 166 DO jk = 1, jpkm1 167 DO jj = 2, jpjm1 168 DO ji = fs_2, fs_jpim1 ! vector opt. 169 ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk) 170 zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk) 171 END DO 121 ! 2. Second derivative (divergence) added to the general tracer trends 122 ! --------------------------------------------------------------------- 123 DO jj = 2, jpjm1 124 DO ji = fs_2, fs_jpim1 ! vector opt. 125 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 126 ! horizontal diffusive trends added to the general tracer trends 127 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 128 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 172 129 END DO 173 130 END DO 131 ! 132 END DO ! End of slab 133 ! 134 ! "Poleward" diffusive heat or salt transports 135 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 136 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 137 IF( jn == jp_sal) str_ldf(:) = ptr_vj( ztv(:,:,:) ) 174 138 ENDIF 175 pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 176 pst_ldf(:) = ptr_vj( zsv(:,:,:) ) 177 ENDIF 178 139 ! ! ================== 140 END DO ! end of tracer loop 141 ! ! ================== 179 142 END SUBROUTINE tra_ldf_lap 180 143
Note: See TracChangeset
for help on using the changeset viewer.
