Changeset 2326 for branches/nemo_v3_3_beta/NEMOGCM/NEMO
- Timestamp:
- 2010-10-28T11:06:10+02:00 (14 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM/NEMO
- Files:
-
- 3 edited
-
OPA_SRC/TRA/traqsr.F90 (modified) (8 diffs)
-
OPA_SRC/trc_oce.F90 (modified) (2 diffs)
-
TOP_SRC/PISCES/p4zopt.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r2317 r2326 103 103 REAL(wp), DIMENSION(jpi,jpj) :: zekb, zekg, zekr ! 2D workspace 104 104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze0, ze1 , ze2, ze3, zea ! 3D workspace 105 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt , ztrds105 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt 106 106 !!---------------------------------------------------------------------- 107 107 … … 115 115 IF( l_trdtra ) THEN ! Save ta and sa trends 116 116 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 117 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = 0.118 117 ENDIF 119 118 … … 143 142 ! ! ============================================== ! 144 143 DO jk = 1, jpkm1 145 DO jj = 2, jpjm1 144 qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 145 END DO 146 ! Add to the general trend 147 DO jk = 1, jpkm1 148 DO jj = 2, jpjm1 146 149 DO ji = fs_2, fs_jpim1 ! vector opt. 147 qsr_hc(ji,jj,jk) = ro0cpr * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 150 z1_e3t = zfact / fse3t(ji,jj,jk) 151 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 148 152 END DO 149 153 END DO … … 234 238 zc0 = zz0 * EXP( -fsdepw(ji,jj,jk )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r ) 235 239 zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 236 qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) / fse3t(ji,jj,jk)240 qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 237 241 END DO 238 242 END DO … … 251 255 ENDIF 252 256 ! 253 ENDIF 254 ! Add to the general trend 255 ! ************************ 256 DO jk = 1, nksr 257 DO jj = 2, jpjm1 258 DO ji = fs_2, fs_jpim1 ! vector opt. 259 z1_e3t = zfact / fse3t(ji,jj,jk) 260 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 257 ! Add to the general trend 258 DO jk = 1, nksr 259 DO jj = 2, jpjm1 260 DO ji = fs_2, fs_jpim1 ! vector opt. 261 z1_e3t = zfact / fse3t(ji,jj,jk) 262 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 263 END DO 261 264 END DO 262 265 END DO 263 END DO 266 ! 267 ENDIF 264 268 ! 265 269 IF( lrst_oce ) THEN ! Write in the ocean restart file … … 276 280 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 277 281 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt ) 278 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_qsr, ztrds ) 279 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 282 DEALLOCATE( ztrdt ) 280 283 ENDIF 281 284 ! ! print mean trends (used for debugging) … … 443 446 ! 444 447 DO jk = 1, nksr 445 etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t_0(:,:,jk)448 etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) 446 449 END DO 447 450 etot3(:,:,nksr+1:jpk) = 0.e0 ! below 400m set to zero … … 471 474 zc0 = zz0 * EXP( -fsdepw(ji,jj,jk )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r ) 472 475 zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 473 etot3(ji,jj,jk) = ( zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1) ) / fse3t_0(ji,jj,jk)476 etot3(ji,jj,jk) = ( zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1) ) 474 477 END DO 475 478 END DO -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r2317 r2326 168 168 REAL(wp), DIMENSION(3,61), INTENT(out) :: prgb ! tabulated attenuation coefficient 169 169 !! 170 INTEGER :: jchl, jband ! dummy loop indices 170 INTEGER :: jc, jb ! dummy loop indice 171 INTEGER :: irgb ! temporary integer 172 REAL(wp) :: zchl ! temporary scalar 171 173 INTEGER :: numlight 172 REAL(wp) :: zchl 173 !!---------------------------------------------------------------------- 174 ! 175 CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 176 DO jchl = 1, 61 177 READ(numlight,*) zchl, ( prgb(jband,jchl), jband=1,3 ) 178 END DO 179 CLOSE( numlight ) 174 !!---------------------------------------------------------------------- 180 175 ! 181 176 IF(lwp) THEN ! control print … … 183 178 WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file' 184 179 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~' 180 WRITE(numout,*) 185 181 ENDIF 182 ! 183 CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 184 DO jc = 1, 61 185 READ(numlight,*) zchl, ( prgb(jb,jc), jb = 1, 3 ) 186 irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 ) 187 IF(lwp) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' irgb = ', irgb 188 IF( irgb /= jc ) THEN 189 IF(lwp) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' Chl class = ', irgb 190 CALL ctl_stop( 'trc_oce_rgb_read : inconsistency in Chl tabulated attenuation coeff.' ) 191 ENDIF 192 END DO 193 CLOSE( numlight ) 194 ! 195 r_si2 = 1.e0 / prgb(1, 1) ! blue with the smallest chlorophyll concentration) 196 IF(lwp) WRITE(numout,*) ' RGB longest depth of extinction r_si2 = ', r_si2 186 197 ! 187 198 END SUBROUTINE trc_oce_rgb_read -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
r2317 r2326 234 234 !!---------------------------------------------------------------------- 235 235 236 !!CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients237 CALL trc_oce_rgb_read( xkrgb ) ! tabulated attenuation coefficients236 CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients 237 !! CALL trc_oce_rgb_read( xkrgb ) ! tabulated attenuation coefficients 238 238 nksrp = trc_oce_ext_lev( r_si2, 0.33e2 ) ! max level of light extinction (Blue Chl=0.01) 239 239 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 240 240 ! 241 etot (:,:,:) = 0.e0242 enano(:,:,:) = 0.e0243 ediat(:,:,:) = 0.e0241 etot (:,:,:) = 0.e0 242 enano(:,:,:) = 0.e0 243 ediat(:,:,:) = 0.e0 244 244 IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 245 246 245 ! 247 246 END SUBROUTINE p4z_opt_init
Note: See TracChangeset
for help on using the changeset viewer.
