Changeset 786 for branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf_lap.F90
- Timestamp:
- 2008-01-10T18:11:23+01:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r719 r786 4 4 !! Ocean active 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 !! 2.4 ! 08-01 (G. Madec) Merge TRA-TRC 14 !!---------------------------------------------------------------------- 6 15 7 16 !!---------------------------------------------------------------------- … … 9 18 !! using a iso-level harmonic (laplacien) operator. 10 19 !!---------------------------------------------------------------------- 11 !! * Modules used12 USE oce ! ocean dynamics and active tracers13 20 USE dom_oce ! ocean space and time domain 14 21 USE ldftra_oce ! ocean active tracers: lateral physics 15 USE trdmod ! ocean active tracers trends16 USE trdmod_oce ! ocean variables trends17 22 USE in_out_manager ! I/O manager 18 23 USE diaptr ! poleward transport diagnostics … … 23 28 PRIVATE 24 29 25 !! * Routine accessibility26 30 PUBLIC tra_ldf_lap ! routine called by step.F90 31 32 REAL(wp), DIMENSION(jpi,jpj), SAVE :: e1ur, e2vr, btr2 ! 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 !! $ Header$35 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt39 !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008) 40 !! $Id:$ 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 36 42 !!---------------------------------------------------------------------- 37 43 38 44 CONTAINS 39 45 40 SUBROUTINE tra_ldf_lap( kt ) 46 SUBROUTINE tra_ldf_lap( kt, cdtype, ktra, pgtu, pgtv, & 47 & ptb , pta ) 41 48 !!---------------------------------------------------------------------- 42 49 !! *** ROUTINE tra_ldf_lap *** 43 50 !! 44 !! ** Purpose : Compute the before horizontal tracer (t & s)diffusive51 !! ** Purpose : Compute the before horizontal tracer diffusive 45 52 !! trend and add it to the general trend of tracer equation. 46 53 !! … … 48 55 !! fields (forward time scheme). The horizontal diffusive trends of 49 56 !! temperature (idem for salinity) is given by: 50 !! difft = 1/(e1t*e2t*e3t) { di-1[ aht e2u*e3u/e1u di( tb) ]51 !! + dj-1[ aht e1v*e3v/e2v dj( tb) ] }57 !! difft = 1/(e1t*e2t*e3t) { di-1[ aht e2u*e3u/e1u di(ptb) ] 58 !! + dj-1[ aht e1v*e3v/e2v dj(ptb) ] } 52 59 !! 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 )60 !! difft = 1/(e1t*e2t) { di-1[ aht e2u/e1u di(ptb) ] 61 !! + dj-1[ aht e1v/e2v dj(ptb) ] } 62 !! Add this trend to the general tracer trend (pta): 63 !! pta = pta + difft 57 64 !! 58 !! ** Action : - Update (ta,sa) arrays with the before iso-level 59 !! harmonic mixing trend. 65 !! ** Action : - Update pta with the before iso-level harmonic mixing trend. 66 !!---------------------------------------------------------------------- 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 ) :: ktra ! tracer index 70 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj) :: pgtu, pgtv ! tracer gradient at pstep levels 71 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: ptb ! before tracer field 72 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pta ! tracer trend 60 73 !! 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 74 INTEGER :: ji, jj, jk ! dummy loop indices 75 INTEGER :: iku, ikv ! temporary integers 76 REAL(wp) :: zabe1, zabe2 ! temporary scalars 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv ! 3D workspace 88 78 !!---------------------------------------------------------------------- 89 79 … … 92 82 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion' 93 83 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 94 ze1ur(:,:) = e2u(:,:) / e1u(:,:)95 ze2vr(:,:) = e1v(:,:) / e2v(:,:)96 zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )84 e1ur(:,:) = e2u(:,:) / e1u(:,:) 85 e2vr(:,:) = e1v(:,:) / e2v(:,:) 86 btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 97 87 ENDIF 88 98 89 99 90 ! ! ============= … … 104 95 DO jj = 1, jpjm1 105 96 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) ) 97 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk) 98 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk) 99 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk) - ptb(ji,jj,jk) ) 100 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk) - ptb(ji,jj,jk) ) 117 101 END DO 118 102 END DO … … 124 108 ikv = MIN ( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1 125 109 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) 110 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku) 111 ztu(ji,jj,jk) = zabe1 * pgtu(ji,jj) 129 112 ENDIF 130 113 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) 114 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv) 115 ztv(ji,jj,jk) = zabe2 * pgtv(ji,jj) 134 116 ENDIF 135 117 END DO … … 138 120 139 121 140 ! 2. Second derivative (divergence) 122 ! 2. Second derivative (divergence) added to the general tracer trends 141 123 ! -------------------- 142 124 DO jj = 2, jpjm1 143 125 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 126 pta(ji,jj,jk) = pta(ji,jj,jk) + btr2(ji,jj) / fse3t(ji,jj,jk) & 127 & * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 128 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 157 129 END DO 158 130 END DO … … 161 133 ! ! ============= 162 134 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 172 END DO 173 END DO 174 ENDIF 175 pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 176 pst_ldf(:) = ptr_vj( zsv(:,:,:) ) 135 136 ! "Poleward" lateral diffusive heat or salt transport 137 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 138 IF( ktra == jp_tem) pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 139 IF( ktra == jp_sal) pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 177 140 ENDIF 178 141 142 IF(ln_ctl) CALL prt_ctl( tab3d_1=pta, clinfo1=' ldf - lap : ', mask1=tmask, clinfo3=cdtype ) 143 ! 179 144 END SUBROUTINE tra_ldf_lap 180 145
Note: See TracChangeset
for help on using the changeset viewer.
