Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.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/traadv_eiv.F90
- Property svn:eol-style deleted
r1756 r2528 2 2 !!====================================================================== 3 3 !! *** MODULE traadv_eiv *** 4 !! Ocean activetracers: advection trend - eddy induced velocity4 !! Ocean tracers: advection trend - eddy induced velocity 5 5 !!====================================================================== 6 !! History : 9.0 ! 05-11 (G. Madec) Original code, from traldf and zdf _iso 6 !! History : 1.0 ! 2005-11 (G. Madec) Original code, from traldf and zdf _iso 7 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_traldf_eiv || defined key_esopa 9 10 !!---------------------------------------------------------------------- 10 11 !! 'key_traldf_eiv' rotation of the lateral mixing tensor 11 !!----------------------------------------------------------------------12 12 !!---------------------------------------------------------------------- 13 13 !! tra_ldf_iso : update the tracer trend with the horizontal component … … 21 21 USE in_out_manager ! I/O manager 22 22 USE iom 23 USE trc_oce ! share passive tracers/Ocean variables 23 24 # if defined key_diaeiv 24 25 USE phycst ! physical constants … … 38 39 # include "vectopt_loop_substitute.h90" 39 40 !!---------------------------------------------------------------------- 40 !! OPA 9.0 , LOCEAN-IPSL (2006)41 !! $Id$ 42 !! Software governed by the CeCILL licence ( modipsl/doc/NEMO_CeCILL.txt)41 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 42 !! $Id$ 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 44 !!---------------------------------------------------------------------- 44 45 45 46 CONTAINS 46 47 47 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn )48 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype ) 48 49 !!---------------------------------------------------------------------- 49 50 !! *** ROUTINE tra_adv_eiv *** … … 63 64 !! ** Action : - add to p.n the eiv component 64 65 !!---------------------------------------------------------------------- 65 INTEGER , INTENT(in ) :: kt ! ocean time-step index 66 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pun ! in : 3 ocean velocity components 67 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pvn ! out: 3 ocean velocity components 68 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pwn ! increased by the eiv 66 INTEGER , INTENT(in ) :: kt ! ocean time-step index 67 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 68 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pun ! in : 3 ocean velocity components 69 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvn ! out: 3 ocean velocity components 70 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pwn ! increased by the eiv 69 71 !! 70 72 INTEGER :: ji, jj, jk ! dummy loop indices 71 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! temporary scalar72 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! " "73 REAL(wp) :: zu_eiv, zv_eiv, zw_eiv ! " "74 # if defined key_diaeiv 75 REAL(wp) :: zztmp ! " "76 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! " "73 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 74 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 75 REAL(wp), DIMENSION(jpi,jpj) :: zu_eiv, zv_eiv, zw_eiv ! 2D workspace 76 # if defined key_diaeiv 77 REAL(wp) :: zztmp ! local scalar 78 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 77 79 # endif 78 80 !!---------------------------------------------------------------------- 79 81 80 IF( kt == nit000 ) THEN82 IF( kt == nit000 ) THEN 81 83 IF(lwp) WRITE(numout,*) 82 IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection :'84 IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :' 83 85 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ add to velocity fields the eiv component' 84 # if defined key_diaeiv 85 u_eiv(:,:,:) = 0.e0 86 v_eiv(:,:,:) = 0.e0 87 w_eiv(:,:,:) = 0.e0 86 # if defined key_diaeiv 87 IF( cdtype == 'TRA') THEN 88 u_eiv(:,:,:) = 0.e0 89 v_eiv(:,:,:) = 0.e0 90 w_eiv(:,:,:) = 0.e0 91 END IF 88 92 # endif 89 93 ENDIF 90 ! ! ================= 94 95 zu_eiv(:,:) = 0.e0 ; zv_eiv(:,:) = 0.e0 ; zw_eiv(:,:) = 0.e0 96 97 ! ================= 91 98 DO jk = 1, jpkm1 ! Horizontal slab 92 99 ! ! ================= … … 98 105 zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1) 99 106 100 zu_eiv = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) / fse3u(ji,jj,jk)101 zv_eiv = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) / fse3v(ji,jj,jk)107 zu_eiv(ji,jj) = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) 108 zv_eiv(ji,jj) = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) 102 109 103 pun(ji,jj,jk) = pun(ji,jj,jk) + zu_eiv 104 pvn(ji,jj,jk) = pvn(ji,jj,jk) + zv_eiv 105 # if defined key_diaeiv 106 u_eiv(ji,jj,jk) = zu_eiv 107 v_eiv(ji,jj,jk) = zv_eiv 108 # endif 110 pun(ji,jj,jk) = pun(ji,jj,jk) + e2u(ji,jj) * zu_eiv(ji,jj) 111 pvn(ji,jj,jk) = pvn(ji,jj,jk) + e1v(ji,jj) * zv_eiv(ji,jj) 109 112 END DO 110 113 END DO 114 # if defined key_diaeiv 115 IF( cdtype == 'TRA') THEN 116 u_eiv(:,:,jk) = zu_eiv(:,:) / fse3u(:,:,jk) 117 v_eiv(:,:,jk) = zv_eiv(:,:) / fse3v(:,:,jk) 118 END IF 119 # endif 111 120 IF( jk >=2 ) THEN ! jk=1 zw_eiv=0, not computed 112 121 DO jj = 2, jpjm1 … … 118 127 zvwj1 = ( wslpj(ji,jj,jk)+wslpj(ji,jj+1,jk) ) * fsaeiv(ji,jj ,jk) * e1v(ji ,jj) * vmask(ji ,jj,jk) 119 128 120 zw_eiv = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) / ( e1t(ji,jj)*e2t(ji,jj) )129 zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) 121 130 # else 122 131 zuwi = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk) … … 125 134 zvwj1 = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji ,jj) * vmask(ji ,jj,jk) 126 135 127 zw_eiv = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) & 128 & / ( e1t(ji,jj)*e2t(ji,jj) ) 136 zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) 129 137 # endif 130 pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv 131 132 # if defined key_diaeiv 133 w_eiv(ji,jj,jk) = zw_eiv 134 # endif 138 pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv(ji,jj) 135 139 END DO 136 140 END DO 141 # if defined key_diaeiv 142 IF( cdtype == 'TRA') w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) ) 143 # endif 137 144 ENDIF 138 145 ! ! ================= … … 140 147 ! ! ================= 141 148 142 # if defined key_diaeiv 143 CALL iom_put( "uoce_eiv", u_eiv ) ! i-eiv current 144 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 145 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 146 IF( lk_diaar5 ) THEN 147 zztmp = 0.5 * rau0 * rcp 148 z2d(:,:) = 0.e0 149 DO jk = 1, jpkm1 150 DO jj = 2, jpjm1 151 DO ji = fs_2, fs_jpim1 ! vector opt. 152 z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji+1,jj,jk)) * e1u(ji,jj) * fse3u(ji,jj,jk) 149 # if defined key_diaeiv 150 IF( cdtype == 'TRA') THEN 151 CALL iom_put( "uoce_eiv", u_eiv ) ! i-eiv current 152 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 153 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 154 IF( lk_diaar5 ) THEN 155 zztmp = 0.5 * rau0 * rcp 156 z2d(:,:) = 0.e0 157 DO jk = 1, jpkm1 158 DO jj = 2, jpjm1 159 DO ji = fs_2, fs_jpim1 ! vector opt. 160 z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) & 161 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e1u(ji,jj) * fse3u(ji,jj,jk) 162 END DO 153 163 END DO 154 164 END DO 155 END DO 156 CALL lbc_lnk( z2d, 'U', -1. ) 157 CALL iom_put( "ueiv_heattr", z2d ) ! heat transport in i-direction 158 z2d(:,:) = 0.e0 159 DO jk = 1, jpkm1 160 DO jj = 2, jpjm1 161 DO ji = fs_2, fs_jpim1 ! vector opt. 162 z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji,jj+1,jk)) * e2v(ji,jj) * fse3v(ji,jj,jk) 165 CALL lbc_lnk( z2d, 'U', -1. ) 166 CALL iom_put( "ueiv_heattr", z2d ) ! heat transport in i-direction 167 z2d(:,:) = 0.e0 168 DO jk = 1, jpkm1 169 DO jj = 2, jpjm1 170 DO ji = fs_2, fs_jpim1 ! vector opt. 171 z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) & 172 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e2v(ji,jj) * fse3v(ji,jj,jk) 173 END DO 163 174 END DO 164 175 END DO 165 END DO166 CALL lbc_lnk( z2d, 'V', -1. )167 CALL iom_put( "veiv_heattr", z2d ) ! heat transport in i-direction168 ENDIF176 CALL lbc_lnk( z2d, 'V', -1. ) 177 CALL iom_put( "veiv_heattr", z2d ) ! heat transport in i-direction 178 ENDIF 179 END IF 169 180 # endif 170 181 ! … … 176 187 !!---------------------------------------------------------------------- 177 188 CONTAINS 178 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn ) ! Empty routine 189 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype ) ! Empty routine 190 INTEGER :: kt 191 CHARACTER(len=3) :: cdtype 179 192 REAL, DIMENSION(:,:,:) :: pun, pvn, pwn 180 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 193 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype 194 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 181 195 END SUBROUTINE tra_adv_eiv 182 196 #endif
Note: See TracChangeset
for help on using the changeset viewer.
