Changeset 187 for trunk/NEMO/OPA_SRC/TRA/traqsr.F90
- Timestamp:
- 2004-11-30T11:16:22+01:00 (19 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/traqsr.F90
r106 r187 12 12 USE oce ! ocean dynamics and active tracers 13 13 USE dom_oce ! ocean space and time domain 14 USE trdtra_oce ! ocean active tracer trends14 USE trdtra_oce ! ocean active tracer trends 15 15 USE in_out_manager ! I/O manager 16 17 USE trc_oce ! share SMS/Ocean variables 16 18 17 19 USE ocesbc ! thermohaline fluxes … … 29 31 30 32 !! * Module variables 31 REAL(wp) ::& !!! * penetrative solar radiation namelist *33 REAL(wp), PUBLIC :: & !!! * penetrative solar radiation namelist * 32 34 rabs = 0.58_wp, & ! fraction associated with xsi1 33 35 xsi1 = 0.35_wp, & ! first depth of extinction 34 36 xsi2 = 23.0_wp ! second depth of extinction 35 37 ! ! (default values: water type Ib) 38 LOGICAL :: & 39 ln_qsr_sms = .false. ! flag to use or not the biological 40 ! ! fluxes for light 41 36 42 INTEGER :: & 37 43 nksr ! number of levels … … 95 101 ENDIF 96 102 97 ! ! =================== ! 98 IF( lk_sco ) THEN ! s-coordinate ! 99 ! ! =================== ! 100 ! 101 ! ! =============== 102 DO jk = 1, jpkm1 ! Horizontal slab 103 ! ! =============== 104 DO jj = 2, jpjm1 105 DO ji = fs_2, fs_jpim1 ! vector opt. 106 107 zdp1 = -fsdepw(ji,jj,jk ) ! compute the qsr trend 108 zdp2 = -fsdepw(ji,jj,jk+1) 109 zc0 = qsr(ji,jj) * ro0cpr / fse3t(ji,jj,jk) 110 zc1 = ( rabs * EXP(zdp1/xsi1) + (1.-rabs) * EXP(zdp1/xsi2) ) 111 zc2 = - ( rabs * EXP(zdp2/xsi1) + (1.-rabs) * EXP(zdp2/xsi2) ) 112 zta = zc0 * ( zc1 * tmask(ji,jj,jk) + zc2 * tmask(ji,jj,jk+1) ) 113 114 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 115 116 # if defined key_trdtra || defined key_trdmld 117 ttrd(ji,jj,jk,7) = zta ! save the qsr trend 118 # endif 119 END DO 120 END DO 121 ! ! =============== 122 END DO ! End of slab 123 ! ! =============== 124 ENDIF 125 ! ! =================== ! 126 IF( lk_zps ) THEN ! partial steps ! 127 ! ! =================== ! 103 IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN ! Biological fluxes ! 104 ! ! =================== ! 128 105 ! 129 106 ! ! =============== 130 DO jk = 1, nksr! Horizontal slab107 DO jk = 1, jpkm1 ! Horizontal slab 131 108 ! ! =============== 132 109 DO jj = 2, jpjm1 133 110 DO ji = fs_2, fs_jpim1 ! vector opt. 134 135 zc0 = qsr(ji,jj) / fse3t(ji,jj,jk) ! compute the qsr trend 136 zta = zc0 * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) ) 137 111 112 zc0 = ro0cpr / fse3t(ji,jj,jk) ! compute the qsr trend 113 zta = zc0 * ( etot3(ji,jj,jk ) * tmask(ji,jj,jk) & 114 & - etot3(ji,jj,jk+1) * tmask(ji,jj,jk+1) ) 115 138 116 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 139 117 140 118 # if defined key_trdtra || defined key_trdmld 141 119 ttrd(ji,jj,jk,7) = zta ! save the qsr trend … … 146 124 END DO ! End of slab 147 125 ! ! =============== 148 E NDIF126 ELSE 149 127 ! ! =================== ! 150 IF( lk_zco ) THEN ! z-coordinate !128 IF( lk_sco ) THEN ! s-coordinate ! 151 129 ! ! =================== ! 152 130 ! 153 ! ! =============== 154 DO jk = 1, nksr ! Horizontal slab 155 ! ! =============== 156 zc0 = 1. / fse3t(1,1,jk) 157 DO jj = 2, jpjm1 158 DO ji = fs_2, fs_jpim1 ! vector opt. 159 ! ! compute qsr forcing trend 160 zta = qsr(ji,jj) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 161 162 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 163 131 ! ! =============== 132 DO jk = 1, jpkm1 ! Horizontal slab 133 ! ! =============== 134 DO jj = 2, jpjm1 135 DO ji = fs_2, fs_jpim1 ! vector opt. 136 137 zdp1 = -fsdepw(ji,jj,jk ) ! compute the qsr trend 138 zdp2 = -fsdepw(ji,jj,jk+1) 139 zc0 = qsr(ji,jj) * ro0cpr / fse3t(ji,jj,jk) 140 zc1 = ( rabs * EXP(zdp1/xsi1) + (1.-rabs) * EXP(zdp1/xsi2) ) 141 zc2 = - ( rabs * EXP(zdp2/xsi1) + (1.-rabs) * EXP(zdp2/xsi2) ) 142 zta = zc0 * ( zc1 * tmask(ji,jj,jk) + zc2 * tmask(ji,jj,jk+1) ) 143 144 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 145 164 146 # if defined key_trdtra || defined key_trdmld 165 ttrd(ji,jj,jk,7) = zta ! save the qsr forcingtrend147 ttrd(ji,jj,jk,7) = zta ! save the qsr trend 166 148 # endif 167 END DO 168 END DO 169 ! ! =============== 170 END DO ! End of slab 171 ! ! =============== 172 ENDIF 173 174 IF(l_ctl) THEN ! print mean trends (used for debugging) 175 zta = SUM( ta(2:nictl,2:njctl,1:jpkm1) * tmask(2:nictl,2:njctl,1:jpkm1) ) 149 END DO 150 END DO 151 ! ! =============== 152 END DO ! End of slab 153 ! ! =============== 154 ENDIF 155 ! ! =================== ! 156 IF( lk_zps ) THEN ! partial steps ! 157 ! ! =================== ! 158 ! 159 ! ! =============== 160 DO jk = 1, nksr ! Horizontal slab 161 ! ! =============== 162 DO jj = 2, jpjm1 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 165 zc0 = qsr(ji,jj) / fse3t(ji,jj,jk) ! compute the qsr trend 166 zta = zc0 * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) ) 167 168 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 169 170 # if defined key_trdtra || defined key_trdmld 171 ttrd(ji,jj,jk,7) = zta ! save the qsr trend 172 # endif 173 END DO 174 END DO 175 ! ! =============== 176 END DO ! End of slab 177 ! ! =============== 178 ENDIF 179 ! ! =================== ! 180 IF( lk_zco ) THEN ! z-coordinate ! 181 ! ! =================== ! 182 ! 183 ! ! =============== 184 DO jk = 1, nksr ! Horizontal slab 185 ! ! =============== 186 zc0 = 1. / fse3t(1,1,jk) 187 DO jj = 2, jpjm1 188 DO ji = fs_2, fs_jpim1 ! vector opt. 189 ! ! compute qsr forcing trend 190 zta = qsr(ji,jj) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 191 192 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend 193 194 # if defined key_trdtra || defined key_trdmld 195 ttrd(ji,jj,jk,7) = zta ! save the qsr forcing trend 196 # endif 197 END DO 198 END DO 199 ! ! =============== 200 END DO ! End of slab 201 ! ! =============== 202 ENDIF 203 ! 204 ENDIF 205 206 207 IF( l_ctl .AND. lwp ) THEN ! print mean trends (used for debugging) 208 ! zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) ) 209 ! zta = SUM( ta * tmask ) 210 zta = SUM( ta(2:nictl,2:njctl,1:jpkm1) * tmask(2:nictl,2:njctl,1:jpkm1) ) 176 211 WRITE(numout,*) ' qsr - Ta: ', zta-t_ctl 177 212 t_ctl = zta … … 212 247 !!---------------------------------------------------------------------- 213 248 !! * Local declarations 214 INTEGER :: j k,& ! dummy loop index215 indic ! temporary integer216 REAL(wp) :: zdp1 ! temporary scalar217 218 NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2 249 INTEGER :: ji,jj,jk, & ! dummy loop index 250 indic ! temporary integer 251 REAL(wp) :: zdp1 ! temporary scalar 252 253 NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2, ln_qsr_sms 219 254 !!---------------------------------------------------------------------- 220 255 … … 231 266 WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation' 232 267 WRITE(numout,*) '~~~~~~~~~~~~' 233 WRITE(numout,*) ' Namelist namqsr : set the parameter of penetration' 234 WRITE(numout,*) ' fraction associated with xsi rabs = ',rabs 235 WRITE(numout,*) ' first depth of extinction xsi1 = ',xsi1 236 WRITE(numout,*) ' second depth of extinction xsi2 = ',xsi2 237 WRITE(numout,*) 268 WRITE(numout,*) ' Namelist namqsr : set the parameter of penetration' 269 WRITE(numout,*) ' fraction associated with xsi rabs = ',rabs 270 WRITE(numout,*) ' first depth of extinction xsi1 = ',xsi1 271 WRITE(numout,*) ' second depth of extinction xsi2 = ',xsi2 272 IF( lk_qsr_sms ) THEN 273 WRITE(numout,*) ' Biological fluxes for light(Y/N) ln_qsr_sms = ',ln_qsr_sms 274 ENDIF 275 WRITE(numout,*) ' ' 238 276 END IF 239 277 ELSE … … 277 315 WRITE(numout,*) 278 316 ENDIF 317 ! Initialisation of Biological fluxes for light here because 318 ! the optical biological model is call after the dynamical one 319 IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN 320 DO jk = 1, jpkm1 321 DO jj = 1, jpj 322 DO ji = 1, jpi 323 etot3(ji,jj,jk) = qsr(ji,jj) * gdsr(jk) * tmask(ji,jj,jk) / ro0cpr 324 END DO 325 END DO 326 END DO 327 ENDIF 328 279 329 ENDIF 280 330
Note: See TracChangeset
for help on using the changeset viewer.
