Changeset 1445 for trunk/NEMO/TOP_SRC
- Timestamp:
- 2009-05-13T16:35:02+02:00 (15 years ago)
- Location:
- trunk/NEMO/TOP_SRC
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r1176 r1445 8 8 !! - ! 1999-11 (C. Menkes, M.-A. Foujols) itabe initial 9 9 !! - ! 2000-02 (M.A. Foujols) change x**y par exp(y*log(x)) 10 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 10 !! NEMO 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 11 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) minor optimisation + style 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_lobster … … 45 46 !! ** Method : local par is computed in w layers using light propagation 46 47 !! mean par in t layers are computed by integration 48 !! 49 !!gm please remplace the '???' by true comments 50 !! ** Action : xpar ??? 51 !! neln ??? 52 !! xze ??? 47 53 !!--------------------------------------------------------------------- 48 54 INTEGER, INTENT( in ) :: kt ! index of the time stepping 49 INTEGER :: ji, jj, jk 50 REAL(wp) :: zpig ! total pigment 51 REAL(wp) :: zkr ! total absorption coefficient in red 52 REAL(wp) :: zkg ! total absorption coefficient in green 55 !! 56 INTEGER :: ji, jj, jk ! dummy loop indices 57 CHARACTER (len=25) :: charout ! temporary character 58 REAL(wp) :: zpig ! log of the total pigment 59 REAL(wp) :: zkr, zkg ! total absorption coefficient in red and green 60 REAL(wp) :: zcoef ! temporary scalar 53 61 REAL(wp), DIMENSION(jpi,jpj) :: zpar100 ! irradiance at euphotic layer depth 54 62 REAL(wp), DIMENSION(jpi,jpj) :: zpar0m ! irradiance just below the surface 55 63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg ! red and green compound of par 56 64 57 CHARACTER (len=25) :: charout58 65 !!--------------------------------------------------------------------- 59 66 60 67 IF( kt == nit000 ) THEN 61 68 IF(lwp) WRITE(numout,*) 62 IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model'63 IF(lwp) WRITE(numout,*) ' ~~~~~~~ '69 IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' 70 IF(lwp) WRITE(numout,*) ' ~~~~~~~ ' 64 71 ENDIF 65 72 66 ! determination of surface irradiance 67 ! ----------------------------------- 68 zpar0m (:,:) = qsr (:,:) * 0.43 73 ! ! surface irradiance 74 zpar0m (:,:) = qsr (:,:) * 0.43 ! ------------------ 69 75 zpar100(:,:) = zpar0m(:,:) * 0.01 70 76 xpar (:,:,1) = zpar0m(:,:) 71 zparr (:,:,1) = 0.5 * zpar0m(:,:)72 zparg (:,:,1) = 0.5 * zpar0m(:,:)77 zparr (:,:,1) = zpar0m(:,:) * 0.5 78 zparg (:,:,1) = zpar0m(:,:) * 0.5 73 79 80 !!gm optimisation : introduce zcoef and LOG computed once for all 74 81 75 ! determination of xpar 76 ! --------------------- 77 78 DO jk = 2, jpk ! determination of local par in w levels 82 ! ! Photosynthetically Available Radiation (PAR) 83 zcoef = 12 * redf / rcchl / rpig ! -------------------------------------- 84 DO jk = 2, jpk ! local par at w-levels 79 85 DO jj = 1, jpj 80 86 DO ji = 1, jpi 81 zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * 12 * redf / rcchl / rpig 82 zkr = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 83 zkg = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 87 !!gm zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef 88 !!gm zkr = xkr0 + xkrp * EXP( xlr * LOG(zpig) ) 89 !!gm zkg = xkg0 + xkgp * EXP( xlg * LOG(zpig) ) 90 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef ) 91 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 92 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 84 93 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) ) 85 94 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) ) … … 87 96 END DO 88 97 END DO 89 90 DO jk = 1, jpkm1 ! mean par in tlevels98 !!gm optimisation : suppress one division 99 DO jk = 1, jpkm1 ! mean par at t-levels 91 100 DO jj = 1, jpj 92 101 DO ji = 1, jpi 93 zpig = MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * 12 * redf / rcchl / rpig 94 zkr = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 95 zkg = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 96 zparr(ji,jj,jk) = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) ) 97 zparg(ji,jj,jk) = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) ) 102 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef ) 103 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 104 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 105 !!gm zparr(ji,jj,jk) = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 106 !!gm zparg(ji,jj,jk) = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 107 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 108 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 98 109 xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 99 110 END DO … … 101 112 END DO 102 113 103 ! 3. Determination of euphotic layer depth 104 ! ---------------------------------------- 105 106 ! Euphotic layer bottom level 107 neln(:,:) = 1 ! initialisation of EL level 108 DO jk = 1, jpk 114 ! ! Euphotic layer 115 ! ! -------------- 116 neln(:,:) = 1 ! euphotic layer level 117 DO jk = 1, jpk ! (i.e. 1rst T-level strictly below EL bottom) 109 118 DO jj = 1, jpj 110 119 DO ji = 1, jpi 111 IF( xpar(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk +1 ! 1rst T-level strictly below EL bottom112 ! 113 ! 120 IF( xpar(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 121 ! ! nb. this is to ensure compatibility with 122 ! ! nmld_trc definition in trd_mld_trc_zint 114 123 END DO 115 124 END DO 116 ENDDO 117 118 ! Euphotic layer depth 125 END DO 126 ! ! Euphotic layer depth 119 127 DO jj = 1, jpj 120 128 DO ji = 1, jpi 121 xze(ji,jj) = fsdepw( ji, jj, neln(ji,jj) ) ! exact EL depth129 xze(ji,jj) = fsdepw(ji,jj,neln(ji,jj)) 122 130 END DO 123 END DO131 END DO 124 132 125 133 126 IF(ln_ctl) THEN! print mean trends (used for debugging)134 IF(ln_ctl) THEN ! print mean trends (used for debugging) 127 135 WRITE(charout, FMT="('opt')") 128 CALL prt_ctl_trc_info( charout)136 CALL prt_ctl_trc_info( charout ) 129 137 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 130 138 ENDIF 131 139 ! 132 140 END SUBROUTINE trc_opt 133 141 -
trunk/NEMO/TOP_SRC/PISCES/p4zopt.F90
r1329 r1445 2 2 !!====================================================================== 3 3 !! *** MODULE p4zopt *** 4 !! TOP : PISCESCompute the light availability in the water column4 !! TOP - PISCES : Compute the light availability in the water column 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !!---------------------------------------------------------------------- 9 #if defined key_pisces 8 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) optimisaion 9 !!---------------------------------------------------------------------- 10 #if defined key_pisces 10 11 !!---------------------------------------------------------------------- 11 12 !! 'key_pisces' PISCES bio-model 12 13 !!---------------------------------------------------------------------- 13 !! p4z_opt : Compute thelight availability in the water column14 !!---------------------------------------------------------------------- 15 USE trc 16 USE oce_trc !17 USE trc 18 USE sms_pisces 14 !! p4z_opt : light availability in the water column 15 !!---------------------------------------------------------------------- 16 USE trc ! tracer variables 17 USE oce_trc ! tracer-ocean share variables 18 USE trc_oce ! ocean-tracer share variables 19 USE sms_pisces ! Source Minus Sink of PISCES 19 20 20 21 IMPLICIT NONE 21 22 PRIVATE 22 23 23 PUBLIC p4z_opt 24 25 !! * Shared module variables26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !:27 etot, enano, ediat, & !: PAR for phyto, nano and diat 28 emoy !: averaged PAR in the mixed layer29 30 !! * Module variables31 REAL(wp), DIMENSION(3,61) :: & !: 32 xkrgb !: ???33 24 PUBLIC p4z_opt ! called in p4zbio.F90 module 25 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: etot, enano, ediat !: PAR for phyto, nano and diat 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: emoy !: averaged PAR in the mixed layer 28 29 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 30 REAL(wp) :: & 31 parlux = 0.43 / 3.e0 32 33 REAL(wp), DIMENSION(3,61), PUBLIC :: xkrgb !: tabulated attenuation coefficients for RGB absorption 34 34 35 !!* Substitution 35 36 # include "domzgr_substitute.h90" … … 52 53 !!--------------------------------------------------------------------- 53 54 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 54 INTEGER :: ji, jj, jk 55 INTEGER :: ji, jj, jk, jc 55 56 INTEGER :: irgb 56 REAL(wp) :: zchl, z parlux57 REAL(wp) :: z rlight , zblight , zglight57 REAL(wp) :: zchl, zxsi0r 58 REAL(wp) :: zc0 , zc1 , zc2, zc3 58 59 REAL(wp), DIMENSION(jpi,jpj) :: zdepmoy, zetmp 59 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zekg, zekr, zekb 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze1 , ze2 , ze3 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3lum, ze4lum 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze5lum, ze6lum 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze1 , ze2 , ze3, ze0 63 62 !!--------------------------------------------------------------------- 64 63 65 64 66 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_opt_init ! Initialization (first time-step only) 65 ! !* tabulated attenuation coef. 66 IF( kt * jnt == nittrc000 ) THEN 67 ! ! level of light extinction 68 nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 69 IF(lwp) THEN 70 WRITE(numout,*) 71 WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 72 ENDIF 73 !! CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients 74 CALL trc_oce_rgb_read( xkrgb ) ! tabulated attenuation coefficients 75 etot (:,:,:) = 0.e0 76 enano(:,:,:) = 0.e0 77 ediat(:,:,:) = 0.e0 78 IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 79 ENDIF 67 80 68 81 69 82 ! Initialisation of variables used to compute PAR 70 83 ! ----------------------------------------------- 71 ze1 (:,:,:) = 0.e0 72 ze2 (:,:,:) = 0.e0 73 ze3 (:,:,:) = 0.e0 74 etot(:,:,:) = 0.e0 75 76 zparlux = 0.43 / 3. 77 78 ! IF activated, computation of the qsr for the dynamics 79 ! ----------------------------------------------------- 80 IF( ln_qsr_sms ) THEN 81 ze3lum(:,:,:) = 0.e0 82 ze4lum(:,:,:) = 0.e0 83 ze5lum(:,:,:) = 0.e0 84 ze6lum(:,:,:) = 0.e0 84 ze1 (:,:,jpk) = 0.e0 85 ze2 (:,:,jpk) = 0.e0 86 ze3 (:,:,jpk) = 0.e0 87 88 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 89 DO jk = 1, jpkm1 ! -------------------------------------------------------- 90 !CDIR NOVERRCHK 91 DO jj = 1, jpj 92 !CDIR NOVERRCHK 93 DO ji = 1, jpi 94 zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 95 zchl = MIN( 10. , MAX( 0.03, zchl ) ) 96 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 97 ! 98 zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 99 zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 100 zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 101 END DO 102 END DO 103 END DO 104 105 !!gm Potential BUG must discuss with Olivier about this implementation.... 106 !!gm the questions are : - PAR at T-point or mean PAR over T-level.... 107 !!gm - shallow water: no penetration of light through the bottom.... 108 109 110 ! !* Photosynthetically Available Radiation (PAR) 111 ! ! -------------------------------------- 112 !CDIR NOVERRCHK 113 DO jj = 1, jpj 114 !CDIR NOVERRCHK 115 DO ji = 1, jpi 116 zc1 = parlux * qsr(ji,jj) * EXP( -0.5 * zekb(ji,jj,1) ) 117 zc2 = parlux * qsr(ji,jj) * EXP( -0.5 * zekg(ji,jj,1) ) 118 zc3 = parlux * qsr(ji,jj) * EXP( -0.5 * zekr(ji,jj,1) ) 119 ze1 (ji,jj,1) = zc1 120 ze2 (ji,jj,1) = zc2 121 ze3 (ji,jj,1) = zc3 122 etot (ji,jj,1) = ( zc1 + zc2 + zc3 ) 123 enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 124 ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 125 END DO 126 END DO 127 128 129 DO jk = 2, nksrp 130 !CDIR NOVERRCHK 131 DO jj = 1, jpj 132 !CDIR NOVERRCHK 133 DO ji = 1, jpi 134 zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) ) 135 zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) ) 136 zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) ) 137 ze1 (ji,jj,jk) = zc1 138 ze2 (ji,jj,jk) = zc2 139 ze3 (ji,jj,jk) = zc3 140 etot (ji,jj,jk) = ( zc1 + zc2 + zc3 ) 141 enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 142 ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 143 END DO 144 END DO 145 END DO 146 147 IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics) 148 ! ! ------------------------ 149 zxsi0r = 1.e0 / rn_si0 150 ! 151 ze0 (:,:,1) = rn_abs * qsr(:,:) 152 ze1 (:,:,1) = parlux * qsr(:,:) ! surface value : separation in R-G-B + near surface 153 ze2 (:,:,1) = parlux * qsr(:,:) 154 ze3 (:,:,1) = parlux * qsr(:,:) 155 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 156 ! 157 DO jk = 2, nksrp+1 158 !CDIR NOVERRCHK 159 DO jj = 1, jpj 160 !CDIR NOVERRCHK 161 DO ji = 1, jpi 162 zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r ) 163 zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) ) 164 zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) ) 165 zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) ) 166 ze0(ji,jj,jk) = zc0 167 ze1(ji,jj,jk) = zc1 168 ze2(ji,jj,jk) = zc2 169 ze3(ji,jj,jk) = zc3 170 etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk) 171 END DO 172 ! 173 END DO 174 ! 175 END DO 176 ! 85 177 ENDIF 86 178 87 DO jk = 1, jpkm1 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 91 ! Separation in three light bands: red, green, blue 92 ! ------------------------------------------------- 93 zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 94 zchl = MAX( 0.03, zchl ) 95 zchl = MIN( 10. , zchl ) 96 97 irgb = INT( 41 + 20.* LOG10( zchl ) + rtrn ) 98 99 zekb(ji,jj,jk) = xkrgb(1,irgb) 100 zekg(ji,jj,jk) = xkrgb(2,irgb) 101 zekr(ji,jj,jk) = xkrgb(3,irgb) 102 103 END DO 104 END DO 105 END DO 106 107 !CDIR NOVERRCHK 108 DO jj = 1,jpj 109 !CDIR NOVERRCHK 110 DO ji = 1,jpi 111 112 ! Separation in three light bands: red, green, blue 113 ! ------------------------------------------------- 114 115 zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) 116 zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) 117 zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) 118 119 ze1(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zblight) 120 ze2(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zglight) 121 ze3(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zrlight) 122 123 END DO 124 END DO 125 126 !CDIR NOVERRCHK 127 DO jk = 2, jpkm1 128 !CDIR NOVERRCHK 129 DO jj = 1, jpj 130 !CDIR NOVERRCHK 131 DO ji = 1, jpi 132 133 ! Separation in three light bands: red, green, blue 134 ! ------------------------------------------------- 135 136 zblight = 0.5 * ( zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & 137 & + zekb(ji,jj,jk ) * fse3t(ji,jj,jk ) ) 138 zglight = 0.5 * ( zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & 139 & + zekg(ji,jj,jk ) * fse3t(ji,jj,jk ) ) 140 zrlight = 0.5 * ( zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & 141 & + zekr(ji,jj,jk ) * fse3t(ji,jj,jk ) ) 142 143 ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP(-zblight) 144 ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP(-zglight) 145 ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP(-zrlight) 146 147 END DO 148 END DO 149 END DO 150 151 etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:) 152 enano(:,:,:) = 2.1 * ze1(:,:,:) + 0.42 * ze2(:,:,:) + 0.4 * ze3(:,:,:) 153 ediat(:,:,:) = 1.6 * ze1(:,:,:) + 0.69 * ze2(:,:,:) + 0.7 * ze3(:,:,:) 154 155 156 IF( ln_qsr_sms ) THEN 157 158 ! In the following, the vertical attenuation of qsr for the dynamics is computed 159 ! ------------------------------------------------------------------------------ 160 161 !CDIR NOVERRCHK 162 DO jj = 1, jpj 163 !CDIR NOVERRCHK 164 DO ji = 1, jpi 165 166 ! Separation in three light bands: red, green, blue 167 ! ------------------------------------------------- 168 169 zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) 170 zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) 171 zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) 172 173 ze3lum(ji,jj,1) = zparlux * qsr(ji,jj) 174 ze4lum(ji,jj,1) = zparlux * qsr(ji,jj) 175 ze5lum(ji,jj,1) = zparlux * qsr(ji,jj) 176 ze6lum(ji,jj,1) = (1.-3. * zparlux) * qsr(ji,jj) 177 178 END DO 179 END DO 180 181 !CDIR NOVERRCHK 182 DO jk = 2, jpkm1 183 !CDIR NOVERRCHK 184 DO jj = 1, jpj 185 !CDIR NOVERRCHK 186 DO ji = 1, jpi 187 188 ! Separation in three light bands: red, green, blue 189 ! ------------------------------------------------- 190 191 zblight = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 192 zglight = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 193 zrlight = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 194 195 ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight ) 196 ze4lum(ji,jj,jk) = ze4lum(ji,jj,jk-1) * EXP( -zglight ) 197 ze5lum(ji,jj,jk) = ze5lum(ji,jj,jk-1) * EXP( -zrlight ) 198 ze6lum(ji,jj,jk) = ze6lum(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) / xsi1 ) 199 200 END DO 201 END DO 202 END DO 203 204 etot3(:,:,:) = ze3lum(:,:,:) + ze4lum(:,:,:) + ze5lum(:,:,:) + ze6lum(:,:,:) 205 206 ENDIF 207 208 ! Computation of the euphotic depth 209 ! --------------------------------- 210 ! Euphotic layer bottom level 211 neln(:,:) = 1 ! initialisation of EL level 179 ! !* Euphotic depth and level 180 neln(:,:) = 1 ! ------------------------ 212 181 heup(:,:) = 300. 213 182 214 DO jk = 2, jpkm1183 DO jk = 2, nksrp 215 184 DO jj = 1, jpj 216 185 DO ji = 1, jpi 217 186 IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) THEN 218 neln(ji,jj) = jk+1 ! 1rst T-level strictly below EL bottom 219 ! ! nb. this is to ensure compatibility with 220 ! ! nmld_trc definition in trd_mld_trc_zint 221 heup(ji,jj) = fsdepw(ji,jj,jk+1) ! Euphotic layer depth 222 ENDIF 223 END DO 187 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 188 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 189 heup(ji,jj) = fsdepw(ji,jj,jk+1) ! Euphotic layer depth 190 ENDIF 191 END DO 224 192 END DO 225 ENDDO193 END DO 226 194 227 heup(:,:) = MIN( 300., heup(:,:) ) 228 229 ! Computation of the mean light over the mixed layer depth 230 ! -------------------------------------------------------- 231 232 zdepmoy(:,:) = 0.e0 195 heup(:,:) = MIN( 300., heup(:,:) ) 196 197 ! !* mean light over the mixed layer 198 zdepmoy(:,:) = 0.e0 ! ------------------------------- 233 199 zetmp (:,:) = 0.e0 234 200 emoy (:,:,:) = 0.e0 235 201 236 DO jk = 1, jpkm1 237 DO jj = 1, jpj 202 DO jk = 1, nksrp 203 !CDIR NOVERRCHK 204 DO jj = 1, jpj 205 !CDIR NOVERRCHK 238 206 DO ji = 1, jpi 239 207 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN … … 244 212 END DO 245 213 END DO 246 214 ! 247 215 emoy(:,:,:) = etot(:,:,:) 248 249 DO jk = 1, jpkm1250 DO jj = 1, jpj 251 DO ji = 1, jpi252 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 253 emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn )254 ENDIF255 END DO256 END DO257 END DO258 216 ! 217 DO jk = 1, nksrp 218 !CDIR NOVERRCHK 219 DO jj = 1, jpj 220 !CDIR NOVERRCHK 221 DO ji = 1, jpi 222 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) & 223 & emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 224 END DO 225 END DO 226 END DO 259 227 260 228 # if defined key_trc_diaadd 261 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,:) * tmask(:,:,1)229 trc2d(:,:, jp_pcs0_2d + 10) = heup (:,:) * tmask(:,:,1) ! save for outputs 262 230 # endif 263 231 ! 264 232 END SUBROUTINE p4z_opt 265 233 266 SUBROUTINE p4z_opt_init267 268 !!----------------------------------------------------------------------269 !! *** ROUTINE p4z_opt_init ***270 !!271 !! ** Purpose : Initialization of of the optical scheme272 !!273 !! ** Method : read the look up table for the optical coefficients274 !!275 !! ** input : xKRGB61276 !!277 !!----------------------------------------------------------------------278 279 INTEGER :: ichl, iband280 INTEGER :: numlight281 REAL(wp) :: ztoto282 CHARACTER(LEN=20) :: clname283 284 ! FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE285 ! A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT286 287 clname = 'kRGB61.txt'288 CALL ctlopn( numlight, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', &289 & 1, numout, .TRUE., 1 )290 291 DO ichl = 1,61292 READ(numlight,*) ztoto, ( xkrgb(iband,ichl), iband = 1,3 )293 END DO294 295 CLOSE(numlight)296 297 IF(lwp) THEN ! control print298 WRITE(numout,*) ' '299 WRITE(numout,*) ' Initialization of the optical look-up table done'300 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'301 ENDIF302 303 END SUBROUTINE p4z_opt_init304 305 306 234 #else 307 !! ======================================================================235 !!---------------------------------------------------------------------- 308 236 !! Dummy module : No PISCES bio-model 309 !! ======================================================================237 !!---------------------------------------------------------------------- 310 238 CONTAINS 311 239 SUBROUTINE p4z_opt ! Empty routine -
trunk/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r1288 r1445 5 5 !!---------------------------------------------------------------------- 6 6 !! History : 1.0 ! 2000-02 (O. Aumont) original code 7 !! 3.2 ! 2009-04 (C. Ethe & NEMO team) style 7 8 !!---------------------------------------------------------------------- 8 9 … … 17 18 PUBLIC 18 19 19 !! ----------------------------------------------------------------------20 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)21 !! $Id$22 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)23 !!----------------------------------------------------------------------20 !!* Time variables 21 INTEGER :: nrdttrc !: ??? 22 INTEGER :: ndayflxtr !: ??? 23 REAL(wp) :: rfact , rfactr !: ??? 24 REAL(wp) :: rfact2, rfact2r !: ??? 24 25 25 !!---------------------------------------------------------------------- 26 !! Variable for chemistry of the CO2 cycle 27 !! --------------------------------------------------------------------- 28 ! 29 REAL(wp), DIMENSION(jpi,jpj,jpk) :: akb3, ak13, ak23, aksp, akw3 !: ??? 30 REAL(wp), DIMENSION(jpi,jpj,jpk) :: hi, borat !: ??? 26 !!* Biological parameters 27 REAL(wp) :: part !: ??? 28 REAL(wp) :: rno3 !: ??? 29 REAL(wp) :: o2ut !: ??? 30 REAL(wp) :: po4r !: ??? 31 REAL(wp) :: rdenit !: ??? 32 REAL(wp) :: o2nit !: ??? 33 REAL(wp) :: wsbio, wsbio2 !: ??? 34 REAL(wp) :: xkmort !: ??? 35 REAL(wp) :: ferat3 !: ??? 31 36 32 !!---------------------------------------------------------------------- 33 !! Time variables 34 !! --------------------------------------------------------------------- 35 INTEGER :: nrdttrc, ndayflxtr !: ??? 36 REAL(wp) :: rfact, rfactr, rfact2, rfact2r !: ??? 37 !!* Damping 38 LOGICAL :: ln_pisdmp !: relaxation or not of nutrients to a mean value 39 !: when initialize from a restart file 37 40 38 !!--------------------------------------- 39 !! Biological parameters 40 !! -------------------------------------- 41 ! 42 REAL(wp) :: part, rno3, o2ut, po4r, rdenit, o2nit !: ??? 43 REAL(wp) :: wsbio, wsbio2, xkmort, ferat3 !: ??? 41 !!* Biological fluxes for light 42 INTEGER , DIMENSION(jpi,jpj) :: neln !: number of T-levels + 1 in the euphotic layer 43 REAL(wp), DIMENSION(jpi,jpj) :: heup !: euphotic layer depth 44 44 45 !!--------------------------------------------- 46 !! Biological fluxes for light 47 !!--------------------------------------------- 48 REAL(wp), DIMENSION(jpi,jpj,jpk) :: etot3 !: ??? 49 INTEGER , DIMENSION(jpi,jpj) :: neln !: number of levels in the euphotic layer 50 REAL(wp), DIMENSION(jpi,jpj) :: heup !: euphotic layer depth 45 !!* Biological fluxes for primary production 46 REAL(wp), DIMENSION(jpi,jpj) :: xksi !: ??? 47 REAL(wp), DIMENSION(jpi,jpj) :: xksimax !: ??? 48 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xnanono3 !: ??? 49 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xdiatno3 !: ??? 50 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xnanonh4 !: ??? 51 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xdiatnh4 !: ??? 52 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimphy !: ??? 53 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimdia !: ??? 54 REAL(wp), DIMENSION(jpi,jpj,jpk) :: concdfe !: ??? 55 REAL(wp), DIMENSION(jpi,jpj,jpk) :: concnfe !: ??? 51 56 52 !!---------------------------------------------------------- 53 !! Biological fluxes for primary production 54 !!---------------------------------------------------------- 55 REAL(wp), DIMENSION(jpi,jpj) :: xksi, xksimax 56 ! 57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xnanono3, xdiatno3, xnanonh4, xdiatnh4 !: ??? 58 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimphy, xlimdia, concdfe, concnfe !: ??? 57 !!* SMS for the organic matter 58 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xfracal !: ?? 59 REAL(wp), DIMENSION(jpi,jpj,jpk) :: nitrfac !: ?? 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimbac !: ?? 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xdiss !: ?? 59 62 60 !!--------------------------------------------- 61 !! SMS for the organic matter 62 !!--------------------------------------------- 63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xfracal, nitrfac, xlimbac, xdiss !: ?? 64 65 !!--------------------------------------------- 66 !! Damping 67 !!--------------------------------------------- 68 LOGICAL :: ln_pisdmp 63 !!* Variable for chemistry of the CO2 cycle 64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: akb3 !: ??? 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ak13 !: ??? 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ak23 !: ??? 67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: aksp !: ??? 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: akw3 !: ??? 69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: borat !: ??? 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: hi !: ??? 69 71 70 72 #if defined key_kriest 71 !! ---------------------------------------------------------72 !! Kriest parameter for aggregation73 !!---------------------------------------------------------74 REAL(wp) :: xkr_eta, xkr_zeta75 REAL(wp) :: xkr_mass_min, xkr_mass_max, xkr_massp73 !!* Kriest parameter for aggregation 74 REAL(wp) :: xkr_eta !: ??? 75 REAL(wp) :: xkr_zeta !: ??? 76 REAL(wp) :: xkr_massp !: ??? 77 REAL(wp) :: xkr_mass_min, xkr_mass_max !: ??? 76 78 #endif 77 79 … … 82 84 #endif 83 85 86 !!---------------------------------------------------------------------- 87 !! NEMO/TOP 3.2 , LOCEAN-IPSL (2009) 88 !! $Id$ 89 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 84 90 !!====================================================================== 85 91 END MODULE sms_pisces -
trunk/NEMO/TOP_SRC/TRP/trctrp.F90
r1271 r1445 128 128 & CALL zps_hde_trc( kt, trb, gtru, gtrv ) ! tracers at the bottom ocean level 129 129 ! 130 IF(ln_ctl) THEN ! print mean trends (used for debugging)131 WRITE(charout, FMT="('TRP')")132 CALL prt_ctl_trc_info( charout )133 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm )134 ENDIF135 !136 130 END SUBROUTINE trc_trp 137 131 -
trunk/NEMO/TOP_SRC/oce_trc.F90
r1329 r1445 180 180 USE sbc_oce , ONLY : emps => emps !: evaporation minus precipitation (kg m-2 s-2) 181 181 USE sbc_oce , ONLY : fr_i => fr_i !: ice fraction (between 0 to 1) 182 USE traqsr , ONLY : xsi1 => xsi1 !: first depth of extinction 183 USE traqsr , ONLY : ln_qsr_sms => ln_qsr_sms !: flag to use or not the biological fluxes for light 182 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface 183 USE traqsr , ONLY : rn_si0 => rn_si0 !: very near surface depth of extinction 184 USE traqsr , ONLY : rn_si2 => rn_si2 !: deepest depth of extinction (blue & 0.01 mg.m-3) (RGB) 185 USE traqsr , ONLY : ln_qsr_bio => ln_qsr_bio !: flag to use or not the biological fluxes for light 184 186 USE sbcrnf , ONLY : rnfmsk => rnfmsk !: mixed adv scheme in runoffs vicinity (hori.) 185 187 USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.)
Note: See TracChangeset
for help on using the changeset viewer.