Changeset 786 for branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf_bilap.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_bilap.F90
r719 r786 4 4 !! Ocean active tracers: horizontal component of the lateral tracer mixing trend 5 5 !!============================================================================== 6 !! History : OPA ! 91-11 (G. Madec) Original code 7 !! ! 93-03 (M. Guyon) symetrical conditions 8 !! ! 95-11 (G. Madec) suppress volumetric scale factors 9 !! ! 96-01 (G. Madec) statement function for e3 10 !! ! 96-01 (M. Imbard) mpp exchange 11 !! ! 97-07 (G. Madec) optimization, and ahtt 12 !! NEMO ! 02-08 (G. Madec) F90: Free form and module 13 !! 1.0 ! 04-08 (C. Talandier) New trends organization 14 !! ! 05-11 (G. Madec) zps or sco as default option 15 !! 2.4 ! 08-01 (G. Madec) Merge TRA-TRC 16 !!---------------------------------------------------------------------- 6 17 7 18 !!---------------------------------------------------------------------- … … 9 20 !! using a iso-level biharmonic operator 10 21 !!---------------------------------------------------------------------- 11 !! * Modules used12 USE oce ! ocean dynamics and active tracers13 22 USE dom_oce ! ocean space and time domain 14 23 USE ldftra_oce ! ocean tracer lateral physics 15 USE trdmod ! ocean active tracers trends16 USE trdmod_oce ! ocean variables trends17 24 USE in_out_manager ! I/O manager 18 USE ldfslp ! iso-neutral slopes19 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 26 USE diaptr ! poleward transport diagnostics … … 24 30 PRIVATE 25 31 26 !! * Routine accessibility27 32 PUBLIC tra_ldf_bilap ! routine called by step.F90 28 33 … … 33 38 # include "vectopt_loop_substitute.h90" 34 39 !!---------------------------------------------------------------------- 35 !! OPA 9.0 , LOCEAN-IPSL (2005)36 !! $ Header$37 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt40 !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008) 41 !! $Id:$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 38 43 !!---------------------------------------------------------------------- 39 44 40 45 CONTAINS 41 46 42 SUBROUTINE tra_ldf_bilap( kt ) 47 SUBROUTINE tra_ldf_bilap( kt, cdtype, ktra, pgtu, pgtv, & 48 & ptb , pta ) 43 49 !!---------------------------------------------------------------------- 44 50 !! *** ROUTINE tra_ldf_bilap *** … … 66 72 !! ** Action : - Update (ta,sa) arrays with the before iso-level 67 73 !! biharmonic mixing trend. 74 !!---------------------------------------------------------------------- 75 INTEGER , INTENT(in ) :: kt ! ocean time-step index 76 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 77 INTEGER , INTENT(in ) :: ktra ! tracer index 78 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj) :: pgtu, pgtv ! tracer gradient at pstep levels 79 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: ptb ! before tracer field 80 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pta ! tracer trend 68 81 !! 69 !! History :70 !! ! 91-11 (G. Madec) Original code71 !! ! 93-03 (M. Guyon) symetrical conditions72 !! ! 95-11 (G. Madec) suppress volumetric scale factors73 !! ! 96-01 (G. Madec) statement function for e374 !! ! 96-01 (M. Imbard) mpp exchange75 !! ! 97-07 (G. Madec) optimization, and ahtt76 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module77 !! 9.0 ! 04-08 (C. Talandier) New trends organization78 !! ! 05-11 (G. Madec) zps or sco as default option79 !!----------------------------------------------------------------------80 !! * Modules used81 USE oce , ztu => ua, & ! use ua as workspace82 & ztv => va ! use va as workspace83 84 !! * Arguments85 INTEGER, INTENT( in ) :: kt ! ocean time-step index86 87 !! * Local declarations88 82 INTEGER :: ji, jj, jk ! dummy loop indices 89 83 INTEGER :: iku, ikv ! temporary integers 90 REAL(wp) :: zta, zsa ! temporary scalars 91 REAL(wp), DIMENSION(jpi,jpj) :: & 92 zeeu, zeev, zbtr, & ! 2D workspace 93 zlt, zls 94 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 95 zsu, zsv ! 3D workspace 84 REAL(wp), DIMENSION(jpi,jpj) :: zeeu, zeev, zbtr, zlt ! 2D workspace 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv ! 3D workspace 96 86 !!---------------------------------------------------------------------- 97 87 … … 110 100 ! ---------------------------------- 111 101 112 IF( lk_zco ) THEN ! z-coordinate (1D arrays): no vertical scale factors 113 DO jj = 1, jpjm1 114 DO ji = 1, fs_jpim1 ! vector opt. 115 zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj) ) 116 zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk) 117 zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk) 118 END DO 102 DO jj = 1, jpjm1 103 DO ji = 1, fs_jpim1 ! vector opt. 104 zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 105 zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 106 zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) 119 107 END DO 120 ELSE ! All coordinates (3D arrays): vertical scale factor are used 121 DO jj = 1, jpjm1 122 DO ji = 1, fs_jpim1 ! vector opt. 123 zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 124 zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 125 zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) 126 END DO 127 END DO 128 ENDIF 108 END DO 129 109 130 110 … … 135 115 DO jj = 1, jpjm1 136 116 DO ji = 1, fs_jpim1 ! vector opt. 137 ztu(ji,jj,jk) = zeeu(ji,jj) * ( tb(ji+1,jj ,jk) - tb(ji,jj,jk) ) 138 zsu(ji,jj,jk) = zeeu(ji,jj) * ( sb(ji+1,jj ,jk) - sb(ji,jj,jk) ) 139 ztv(ji,jj,jk) = zeev(ji,jj) * ( tb(ji ,jj+1,jk) - tb(ji,jj,jk) ) 140 zsv(ji,jj,jk) = zeev(ji,jj) * ( sb(ji ,jj+1,jk) - sb(ji,jj,jk) ) 117 ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj ,jk) - ptb(ji,jj,jk) ) 118 ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji ,jj+1,jk) - ptb(ji,jj,jk) ) 141 119 END DO 142 120 END DO … … 147 125 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj ) ) - 1 148 126 ikv = MIN ( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1 149 IF( iku == jk ) THEN 150 ztu(ji,jj,jk) = zeeu(ji,jj) * gtu(ji,jj) 151 zsu(ji,jj,jk) = zeeu(ji,jj) * gsu(ji,jj) 152 ENDIF 153 IF( ikv == jk ) THEN 154 ztv(ji,jj,jk) = zeev(ji,jj) * gtv(ji,jj) 155 zsv(ji,jj,jk) = zeev(ji,jj) * gsv(ji,jj) 156 ENDIF 127 IF( iku == jk ) ztu(ji,jj,jk) = zeeu(ji,jj) * pgtu(ji,jj) 128 IF( ikv == jk ) ztv(ji,jj,jk) = zeev(ji,jj) * pgtv(ji,jj) 157 129 END DO 158 130 END DO 159 131 ENDIF 160 132 161 ! Second derivative (divergence) 133 ! Second derivative (divergence) multiply by the eddy diffusivity coefficient 162 134 DO jj = 2, jpjm1 163 135 DO ji = fs_2, fs_jpim1 ! vector opt. 164 zlt(ji,jj) = zbtr(ji,jj) * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )165 zls(ji,jj) = zbtr(ji,jj) * ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk) )136 zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr(ji,jj) & 137 & * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 166 138 END DO 167 139 END DO 168 140 169 ! Multiply by the eddy diffusivity coefficient 170 DO jj = 2, jpjm1 171 DO ji = fs_2, fs_jpim1 ! vector opt. 172 zlt(ji,jj) = fsahtt(ji,jj,jk) * zlt(ji,jj) 173 zls(ji,jj) = fsahtt(ji,jj,jk) * zls(ji,jj) 174 END DO 175 END DO 141 !!gm k-loop must be cut here and a 3D lbclnk used 176 142 177 ! Lateral boundary conditions on the laplacian (zlt ,zls) (unchanged sgn)178 CALL lbc_lnk( zlt, 'T', 1. ) ; CALL lbc_lnk( zls, 'T', 1. )143 ! Lateral boundary conditions on the laplacian (zlt) (unchanged sgn) 144 CALL lbc_lnk( zlt, 'T', 1. ) 179 145 180 146 ! 2. Bilaplacian 181 147 ! -------------- 182 148 183 ! third derivative (gradient) 184 DO jj = 1, jpjm1 149 DO jj = 1, jpjm1 ! third derivative (gradient) 185 150 DO ji = 1, fs_jpim1 ! vector opt. 186 151 ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj ) - zlt(ji,jj) ) 187 zsu(ji,jj,jk) = zeeu(ji,jj) * ( zls(ji+1,jj ) - zls(ji,jj) )188 152 ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji ,jj+1) - zlt(ji,jj) ) 189 zsv(ji,jj,jk) = zeev(ji,jj) * ( zls(ji ,jj+1) - zls(ji,jj) )190 153 END DO 191 154 END DO 192 155 193 ! fourth derivative (divergence) and add to the general tracer trend 194 DO jj = 2, jpjm1 156 DO jj = 2, jpjm1 ! 4th derivative (divergence) and add to the general tracer trend 195 157 DO ji = fs_2, fs_jpim1 ! vector opt. 196 ! horizontal diffusive trends 197 zta = zbtr(ji,jj) * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 198 zsa = zbtr(ji,jj) * ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) 199 ! add it to the general tracer trends 200 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 201 sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 158 pta(ji,jj,jk) = pta(ji,jj,jk) + zbtr(ji,jj) & 159 & * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 202 160 END DO 203 161 END DO … … 206 164 ! ! =============== 207 165 208 ! "zonal" mean lateral diffusive heat and salt transport 209 IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 210 IF( lk_zco ) THEN ! z-coordinate (1D arrays): multiply by the vertical scale factor 211 DO jk = 1, jpkm1 212 DO jj = 2, jpjm1 213 DO ji = fs_2, fs_jpim1 ! vector opt. 214 ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk) 215 zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk) 216 END DO 217 END DO 218 END DO 219 ENDIF 220 pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 221 pst_ldf(:) = ptr_vj( zsv(:,:,:) ) 166 167 ! ! "Poleward" lateral diffusive heat or salt transport 168 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 169 IF( ktra == jp_tem) pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 170 IF( ktra == jp_sal) pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 222 171 ENDIF 223 172 173 ! ! control print 174 IF(ln_ctl) CALL prt_ctl( tab3d_1=pta, clinfo1=' ldf - bilap : ', mask1=tmask, clinfo3=cdtype ) 175 ! 224 176 END SUBROUTINE tra_ldf_bilap 225 177
Note: See TracChangeset
for help on using the changeset viewer.
