Changeset 457 for trunk/NEMO/OPA_SRC/TRA/traqsr.F90
- Timestamp:
- 2006-05-10T19:01:19+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/traqsr.F90
r296 r457 4 4 !! Ocean physics: solar radiation penetration in the top ocean levels 5 5 !!====================================================================== 6 6 !! History : 7 !! 6.0 ! 90-10 (B. Blanke) Original code 8 !! 7.0 ! 91-11 (G. Madec) 9 !! ! 96-01 (G. Madec) s-coordinates 10 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 11 !! 9.0 ! 04-08 (C. Talandier) New trends organization 12 !! 9.0 ! 05-11 (G. Madec) zco, zps, sco coordinate 7 13 !!---------------------------------------------------------------------- 8 14 !! tra_qsr : trend due to the solar radiation penetration … … 81 87 !! - save the trend in ttrd ('key_trdtra') 82 88 !! 83 !! History :84 !! 6.0 ! 90-10 (B. Blanke) Original code85 !! 7.0 ! 91-11 (G. Madec)86 !! ! 96-01 (G. Madec) s-coordinates87 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module88 !! 9.0 ! 04-08 (C. Talandier) New trends organization89 89 !!---------------------------------------------------------------------- 90 90 !! * Modules used 91 USE oce, ONLY : zt dta=> ua, & ! use ua as 3D workspace92 zt dsa=> va ! use va as 3D workspace91 USE oce, ONLY : ztrdt => ua, & ! use ua as 3D workspace 92 ztrds => va ! use va as 3D workspace 93 93 94 94 !! * Arguments … … 97 97 !! * Local declarations 98 98 INTEGER :: ji, jj, jk ! dummy loop indexes 99 REAL(wp) :: zc0, zta ! temporary scalars 100 REAL(wp) :: zc1 , zc2 , & ! temporary scalars 101 zdp1, zdp2 ! 99 REAL(wp) :: zc0 , zta ! temporary scalars 102 100 !!---------------------------------------------------------------------- 103 101 … … 106 104 IF ( lwp ) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 107 105 IF ( lwp ) WRITE(numout,*) '~~~~~~~' 106 CALL tra_qsr_init 108 107 ENDIF 109 108 110 109 ! Save ta and sa trends 111 110 IF( l_trdtra ) THEN 112 ztdta(:,:,:) = ta(:,:,:) 113 ztdsa(:,:,:) = 0.e0 114 ENDIF 115 116 IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN ! Biological fluxes ! 117 ! ! =================== ! 118 ! 119 ! ! =============== 120 DO jk = 1, jpkm1 ! Horizontal slab 121 ! ! =============== 111 ztrdt(:,:,:) = ta(:,:,:) 112 ztrds(:,:,:) = 0.e0 113 ENDIF 114 115 ! ---------------------------------------------- ! 116 ! Biological fluxes : all vertical coordinate ! 117 ! ---------------------------------------------- ! 118 IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN 119 ! ! =============== 120 DO jk = 1, jpkm1 ! Horizontal slab 121 ! ! =============== 122 122 DO jj = 2, jpjm1 123 123 DO ji = fs_2, fs_jpim1 ! vector opt. 124 124 125 zc0 = ro0cpr / fse3t(ji,jj,jk) ! compute the qsr trend125 zc0 = ro0cpr / fse3t(ji,jj,jk) ! compute the qsr trend 126 126 zta = zc0 * ( etot3(ji,jj,jk ) * tmask(ji,jj,jk) & 127 127 & - etot3(ji,jj,jk+1) * tmask(ji,jj,jk+1) ) … … 131 131 END DO 132 132 END DO 133 ! ! =============== 134 END DO ! End of slab 135 ! ! =============== 136 ! save the trends for diagnostic 137 ! qsr tracers trends 138 IF( l_trdtra ) THEN 139 ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) 140 CALL trd_mod(ztdta, ztdsa, jpttdqsr, 'TRA', kt) 141 ENDIF 142 133 ! ! =============== 134 END DO ! End of slab 135 ! ! =============== 136 137 ! ---------------------------------------------- ! 138 ! Ocean alone : 139 ! ---------------------------------------------- ! 143 140 ELSE 144 141 ! ! =================== ! 145 IF( lk_sco ) THEN ! s-coordinate ! 142 IF( ln_sco ) THEN ! s-coordinate ! 143 ! ! =================== ! 144 DO jk = 1, jpkm1 145 ta(:,:,jk) = ta(:,:,jk) + etot3(:,:,jk) * qsr(:,:) 146 END DO 147 ENDIF 146 148 ! ! =================== ! 147 ! 148 ! ! =============== 149 DO jk = 1, jpkm1 ! Horizontal slab 150 ! ! =============== 149 IF( ln_zps ) THEN ! partial steps ! 150 ! ! =================== ! 151 DO jk = 1, nksr 151 152 DO jj = 2, jpjm1 152 153 DO ji = fs_2, fs_jpim1 ! vector opt. 153 154 zdp1 = -fsdepw(ji,jj,jk ) ! compute the qsr trend 155 zdp2 = -fsdepw(ji,jj,jk+1) 156 zc0 = qsr(ji,jj) * ro0cpr / fse3t(ji,jj,jk) 157 zc1 = ( rabs * EXP(zdp1/xsi1) + (1.-rabs) * EXP(zdp1/xsi2) ) 158 zc2 = - ( rabs * EXP(zdp2/xsi1) + (1.-rabs) * EXP(zdp2/xsi2) ) 159 zta = zc0 * ( zc1 * tmask(ji,jj,jk) + zc2 * tmask(ji,jj,jk+1) ) 160 161 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 162 154 ! qsr trend from gdsr 155 zc0 = qsr(ji,jj) / fse3t(ji,jj,jk) 156 zta = zc0 * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) ) 157 ! add qsr trend to the temperature trend 158 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 163 159 END DO 164 160 END DO 165 ! ! =============== 166 END DO ! End of slab 167 ! ! =============== 168 ! save the trends for diagnostic 169 ! qsr tracers trends 170 IF( l_trdtra ) THEN 171 ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) 172 CALL trd_mod(ztdta, ztdsa, jpttdqsr, 'TRA', kt) 173 ENDIF 174 ! 161 END DO 175 162 ENDIF 176 163 ! ! =================== ! 177 IF( l k_zps ) THEN ! partial steps!164 IF( ln_zco ) THEN ! z-coordinate ! 178 165 ! ! =================== ! 179 ! 180 ! ! =============== 181 DO jk = 1, nksr ! Horizontal slab 182 ! ! =============== 166 DO jk = 1, nksr 167 zc0 = 1. / e3t_0(jk) 183 168 DO jj = 2, jpjm1 184 169 DO ji = fs_2, fs_jpim1 ! vector opt. 185 186 zc0 = qsr(ji,jj) / fse3t(ji,jj,jk) ! compute the qsr trend 187 zta = zc0 * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) ) 188 189 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 190 170 ! qsr trend 171 zta = qsr(ji,jj) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 172 ! add qsr trend to the temperature trend 173 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 191 174 END DO 192 175 END DO 193 ! ! =============== 194 END DO ! End of slab 195 ! ! =============== 196 ! save the trends for diagnostic 197 ! qsr tracers trends 198 IF( l_trdtra ) THEN 199 ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) 200 CALL trd_mod(ztdta, ztdsa, jpttdqsr, 'TRA', kt) 201 ENDIF 202 ! 203 ENDIF 204 ! ! =================== ! 205 IF( lk_zco ) THEN ! z-coordinate ! 206 ! ! =================== ! 207 ! 208 ! ! =============== 209 DO jk = 1, nksr ! Horizontal slab 210 ! ! =============== 211 zc0 = 1. / fse3t(1,1,jk) 212 DO jj = 2, jpjm1 213 DO ji = fs_2, fs_jpim1 ! vector opt. 214 ! ! compute qsr forcing trend 215 zta = qsr(ji,jj) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 216 217 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 218 219 END DO 220 END DO 221 ! ! =============== 222 END DO ! End of slab 223 ! ! =============== 224 ! save the trends for diagnostic 225 ! qsr tracers trends 226 IF( l_trdtra ) THEN 227 ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) 228 CALL trd_mod(ztdta, ztdsa, jpttdqsr, 'TRA', kt) 229 ENDIF 230 ! 176 END DO 231 177 ENDIF 232 178 ! 233 179 ENDIF 234 180 235 236 IF(ln_ctl) THEN ! print mean trends (used for debugging) 237 CALL prt_ctl(tab3d_1=ta, clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta') 238 ENDIF 181 ! qsr tracers trends saved the trends for diagnostics 182 IF( l_trdtra ) THEN 183 ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 184 CALL trd_mod( ztrdt, ztrds, jpttdqsr, 'TRA', kt ) 185 ENDIF 186 187 ! ! print mean trends (used for debugging) 188 IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 239 189 240 190 END SUBROUTINE tra_qsr … … 258 208 !! Reference : 259 209 !! Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 260 !! 261 !! History : 262 !! 8.5 ! 02-06 (G. Madec) Original code 263 !!---------------------------------------------------------------------- 264 !! * Local declarations 210 !!---------------------------------------------------------------------- 265 211 INTEGER :: ji,jj,jk, & ! dummy loop index 266 212 indic ! temporary integer 267 REAL(wp) :: zdp1 ! temporary scalar 213 REAL(wp) :: zc0 , zc1 , zc2 , & ! temporary scalars 214 & zcst, zdp1, zdp2 ! " " 268 215 269 216 NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2, ln_qsr_sms … … 278 225 ! --------------------------- 279 226 IF( ln_traqsr ) THEN 280 IF ( lwp ) THEN 281 WRITE(numout,*) 282 WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation' 283 WRITE(numout,*) '~~~~~~~~~~~~' 284 WRITE(numout,*) ' Namelist namqsr : set the parameter of penetration' 285 WRITE(numout,*) ' fraction associated with xsi rabs = ',rabs 286 WRITE(numout,*) ' first depth of extinction xsi1 = ',xsi1 287 WRITE(numout,*) ' second depth of extinction xsi2 = ',xsi2 288 IF( lk_qsr_sms ) THEN 289 WRITE(numout,*) ' Biological fluxes for light(Y/N) ln_qsr_sms = ',ln_qsr_sms 290 ENDIF 291 WRITE(numout,*) ' ' 292 END IF 227 IF(lwp) THEN 228 WRITE(numout,*) 229 WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation' 230 WRITE(numout,*) '~~~~~~~~~~~~' 231 WRITE(numout,*) ' Namelist namqsr : set the parameter of penetration' 232 WRITE(numout,*) ' fraction associated with xsi rabs = ',rabs 233 WRITE(numout,*) ' first depth of extinction xsi1 = ',xsi1 234 WRITE(numout,*) ' second depth of extinction xsi2 = ',xsi2 235 IF( lk_qsr_sms ) THEN 236 WRITE(numout,*) ' Biological fluxes for light(Y/N) ln_qsr_sms = ',ln_qsr_sms 237 ENDIF 238 ENDIF 293 239 ELSE 294 IF ( lwp) THEN295 WRITE(numout,*)296 WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'297 WRITE(numout,*) '~~~~~~~~~~~~'298 ENDIF240 IF(lwp) THEN 241 WRITE(numout,*) 242 WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration' 243 WRITE(numout,*) '~~~~~~~~~~~~' 244 ENDIF 299 245 ENDIF 300 246 … … 306 252 307 253 308 ! Initialization 309 ! -------------- 310 IF( .NOT. lk_sco ) THEN 311 ! z-coordinate with or without partial step : same before last ocean w-level everywhere 254 ! Initialization of gdsr 255 ! ---------------------- 256 IF( ln_zco .OR. ln_zps ) THEN 257 258 ! z-coordinate with or without partial step : same w-level everywhere inside the ocean 312 259 gdsr(:) = 0.e0 313 260 DO jk = 1, jpk 314 zdp1 = - fsdepw(1,1,jk)261 zdp1 = -gdepw_0(jk) 315 262 gdsr(jk) = ro0cpr * ( rabs * EXP( zdp1/xsi1 ) + (1.-rabs) * EXP( zdp1/xsi2 ) ) 316 263 IF ( gdsr(jk) <= 1.e-10 ) EXIT … … 321 268 gdsr(jk) = 0.e0 322 269 nksr = jk 323 !!bug Edmee chg res nksr = jk - 1324 270 indic = 1 325 271 ENDIF … … 337 283 IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN 338 284 DO jk = 1, jpkm1 339 DO jj = 1, jpj 340 DO ji = 1, jpi 341 etot3(ji,jj,jk) = qsr(ji,jj) * gdsr(jk) * tmask(ji,jj,jk) / ro0cpr 342 END DO 285 zcst = gdsr(jk) / ro0cpr 286 etot3(:,:,jk) = qsr(:,:) * zcst * tmask(:,:,jk) 287 END DO 288 ENDIF 289 290 ENDIF 291 292 ! Initialisation of etot3 (s-coordinate) 293 ! ----------------------- 294 IF( ln_sco ) THEN 295 etot3(:,:,jpk) = 0.e0 296 DO jk = 1, jpkm1 297 DO jj = 1, jpj 298 DO ji = 1, jpi 299 zdp1 = -fsdepw(ji,jj,jk ) 300 zdp2 = -fsdepw(ji,jj,jk+1) 301 zc0 = ro0cpr / fse3t(ji,jj,jk) 302 zc1 = ( rabs * EXP(zdp1/xsi1) + (1.-rabs) * EXP(zdp1/xsi2) ) 303 zc2 = - ( rabs * EXP(zdp2/xsi1) + (1.-rabs) * EXP(zdp2/xsi2) ) 304 etot3(ji,jj,jk) = zc0 * ( zc1 * tmask(ji,jj,jk) + zc2 * tmask(ji,jj,jk+1) ) 343 305 END DO 344 306 END DO 345 ENDIF 346 347 ENDIF 307 END DO 308 ENDIF 348 309 349 310 END SUBROUTINE tra_qsr_init
Note: See TracChangeset
for help on using the changeset viewer.
