- Timestamp:
- 2011-08-09T13:11:24+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2787_PISCES_improvment/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
r2715 r2823 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) optimisation 9 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improve light availability of nano & diat 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_pisces … … 17 18 USE oce_trc ! tracer-ocean share variables 18 19 USE sms_pisces ! Source Minus Sink of PISCES 19 USE iom 20 USE iom ! I/O manager 20 21 21 22 IMPLICIT NONE … … 53 54 !!--------------------------------------------------------------------- 54 55 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 55 USE wrk_nemo, ONLY: zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 56 USE wrk_nemo, ONLY: zekg => wrk_3d_2 , zekr => wrk_3d_3 , zekb => wrk_3d_4 57 USE wrk_nemo, ONLY: ze0 => wrk_3d_5 , ze1 => wrk_3d_6 58 USE wrk_nemo, ONLY: ze2 => wrk_3d_7 , ze3 => wrk_3d_8 56 USE wrk_nemo, ONLY: zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 57 USE wrk_nemo, ONLY: zetmp1 => wrk_2d_3 , zetmp2 => wrk_2d_4 58 USE wrk_nemo, ONLY: zekg => wrk_3d_2 , zekr => wrk_3d_3 , zekb => wrk_3d_4 59 USE wrk_nemo, ONLY: ze0 => wrk_3d_5 , ze1 => wrk_3d_6 60 USE wrk_nemo, ONLY: ze2 => wrk_3d_7 , ze3 => wrk_3d_8 59 61 ! 60 62 INTEGER, INTENT(in) :: kt, jnt ! ocean time step … … 63 65 INTEGER :: irgb 64 66 REAL(wp) :: zchl, zxsi0r 65 REAL(wp) :: zc0 , zc1 , zc2, zc3 67 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 66 68 !!--------------------------------------------------------------------- 67 69 68 IF( wrk_in_use(2, 1,2 ) .OR. wrk_in_use(3, 2,3,4,5,6,7,8) ) THEN70 IF( wrk_in_use(2, 1,2,3,4) .OR. wrk_in_use(3, 2,3,4,5,6,7,8) ) THEN 69 71 CALL ctl_stop('p4z_opt: requested workspace arrays unavailable') ; RETURN 70 72 ENDIF … … 83 85 DO ji = 1, jpi 84 86 zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 85 zchl = MIN( 10. , MAX( 0.0 3, zchl ) )87 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 86 88 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 87 89 ! … … 92 94 END DO 93 95 END DO 94 95 !!gm Potential BUG must discuss with Olivier about this implementation....96 !!gm the questions are : - PAR at T-point or mean PAR over T-level....97 !!gm - shallow water: no penetration of light through the bottom....98 96 99 97 … … 145 143 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 146 144 ! 147 DO jk = 2, nksrp +1145 DO jk = 2, nksrp + 1 148 146 !CDIR NOVERRCHK 149 147 DO jj = 1, jpj … … 188 186 zdepmoy(:,:) = 0.e0 ! ------------------------------- 189 187 zetmp (:,:) = 0.e0 190 emoy (:,:,:) = 0.e0 188 zetmp1 (:,:) = 0.e0 189 zetmp2 (:,:) = 0.e0 191 190 192 191 DO jk = 1, nksrp … … 196 195 DO ji = 1, jpi 197 196 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 198 zetmp (ji,jj) = zetmp (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) 197 zetmp (ji,jj) = zetmp (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 198 zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 199 zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 199 200 zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 200 201 ENDIF … … 210 211 !CDIR NOVERRCHK 211 212 DO ji = 1, jpi 212 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 213 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 214 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 215 emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 216 enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 217 ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 218 ENDIF 213 219 END DO 214 220 END DO … … 218 224 # if ! defined key_iomput 219 225 ! save for outputs 220 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 226 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 221 227 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 222 228 # else 223 229 ! write diagnostics 224 IF( jnt == nrdttrc ) then 230 IF( jnt == nrdttrc ) then 225 231 CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 226 232 CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation … … 229 235 #endif 230 236 ! 231 IF( wrk_not_released(2, 1,2) .OR. &232 237 IF( wrk_not_released(2, 1,2,3,4) .OR. & 238 wrk_not_released(3, 2,3,4,5,6,7,8) ) CALL ctl_stop('p4z_opt: failed to release workspace arrays') 233 239 ! 234 240 END SUBROUTINE p4z_opt
Note: See TracChangeset
for help on using the changeset viewer.