Changeset 775 for branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zopt.F90
- Timestamp:
- 2007-12-19T14:45:15+01:00 (16 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zopt.F90
r774 r775 1 2 CCC $Header$ 3 CCC TOP 1.0 , LOCEAN-IPSL (2005) 4 C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 5 C --------------------------------------------------------------------------- 6 CDIR$ LIST 7 SUBROUTINE p4zopt 8 #if defined key_top && defined key_pisces 9 CCC--------------------------------------------------------------------- 10 CCC 11 CCC ROUTINE p4zopt : PISCES MODEL 12 CCC ***************************** 13 CCC 14 CCC PURPOSE : 15 CCC --------- 16 CCC Compute the light availability in the water column 17 CCC depending on the depth and the chlorophyll concentration 18 CCC 19 CC INPUT : 20 CC ----- 21 CC argument 22 CC None 23 CC common 24 CC all the common defined in opa 25 CC 26 CC 27 CC OUTPUT : : no 28 CC ------ 29 CC 30 CC MODIFICATIONS: 31 CC -------------- 32 CC original : O. Aumont (2004) 33 CC---------------------------------------------------------------------- 34 CC parameters and commons 35 CC ====================== 36 CDIR$ NOLIST 37 USE oce_trc 38 USE trp_trc 39 USE sms 40 IMPLICIT NONE 41 #include "domzgr_substitute.h90" 42 CDIR$ LIST 43 CC---------------------------------------------------------------------- 44 CC local declarations 45 CC ================== 46 INTEGER ji, jj, jk, mrgb 47 REAL xchl,ekg(jpi,jpj,jpk),ekr(jpi,jpj,jpk),ekb(jpi,jpj,jpk) 48 REAL parlux,e1(jpi,jpj,jpk),e2(jpi,jpj,jpk),e3(jpi,jpj,jpk) 49 REAL zdepmoy(jpi,jpj),etmp(jpi,jpj) 50 REAL zrlight,zblight,zglight 51 REAL zrlight1,zblight1,zglight1 52 REAL e3lum(jpi,jpj,jpk),e4lum(jpi,jpj,jpk) 53 REAL e5lum(jpi,jpj,jpk),e6lum(jpi,jpj,jpk) 54 C 55 C Initialisation of variables used to compute PAR 56 C ----------------------------------------------- 57 C 58 e1 = 0. 59 e2 = 0. 60 e3 = 0. 61 etot = 0. 62 parlux = 0.43/3. 63 64 IF (ln_qsr_sms) THEN 65 C 66 C IF activated, computation of the qsr for the dynamics 67 C ----------------------------------------------------- 68 C 69 e3lum=0. 70 e4lum=0. 71 e5lum=0. 72 e6lum=0. 73 ENDIF 74 75 DO jk=1,jpkm1 76 DO jj=1,jpj 77 DO ji=1,jpi 78 C 79 C Separation in three light bands: red, green, blue 80 C ------------------------------------------------- 81 C 82 xchl=(trn(ji,jj,jk,jpnch)+trn(ji,jj,jk,jpdch)+rtrn)*1.E6 83 xchl=max(0.03,xchl) 84 xchl=min(10.,xchl) 1 MODULE p4zopt 2 !!====================================================================== 3 !! *** MODULE p4zopt *** 4 !! TOP : PISCES Compute the light availability in the water column 5 !!====================================================================== 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !!---------------------------------------------------------------------- 9 #if defined key_pisces 10 !!---------------------------------------------------------------------- 11 !! 'key_pisces' PISCES bio-model 12 !!---------------------------------------------------------------------- 13 !! p4z_opt : Compute the light availability in the water column 14 !!---------------------------------------------------------------------- 15 USE oce_trc ! 16 USE trp_trc 17 USE sms 18 19 IMPLICIT NONE 20 PRIVATE 21 22 PUBLIC p4z_opt ! called in p4zprg.F90 23 24 !!* Substitution 25 # include "domzgr_substitute.h90" 26 !!---------------------------------------------------------------------- 27 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 28 !! $Header:$ 29 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 30 !!---------------------------------------------------------------------- 31 32 CONTAINS 33 34 SUBROUTINE p4z_opt 35 !!--------------------------------------------------------------------- 36 !! *** ROUTINE p4z_opt *** 37 !! 38 !! ** Purpose : Compute the light availability in the water column 39 !! depending on the depth and the chlorophyll concentration 40 !! 41 !! ** Method : - ??? 42 !!--------------------------------------------------------------------- 43 INTEGER :: ji, jj, jk 44 INTEGER :: irgb 45 REAL(wp) :: zchl, zparlux 46 REAL(wp) :: zrlight , zblight , zglight 47 REAL(wp) :: zrlight1, zblight1, zglight1 48 REAL(wp), DIMENSION(jpi,jpj) :: zdepmoy, zetmp 49 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zekg, zekr, zekb 50 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze1 , ze2 , ze3 51 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3lum, ze4lum 52 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze5lum, ze6lum 53 !!--------------------------------------------------------------------- 54 55 ! Initialisation of variables used to compute PAR 56 ! ----------------------------------------------- 57 ze1 (:,:,:) = 0.e0 58 ze2 (:,:,:) = 0.e0 59 ze3 (:,:,:) = 0.e0 60 etot(:,:,:) = 0.e0 61 62 zparlux = 0.43 / 3. 63 64 ! IF activated, computation of the qsr for the dynamics 65 ! ----------------------------------------------------- 66 IF( ln_qsr_sms ) THEN 67 ze3lum(:,:,:) = 0.e0 68 ze4lum(:,:,:) = 0.e0 69 ze5lum(:,:,:) = 0.e0 70 ze6lum(:,:,:) = 0.e0 71 ENDIF 72 73 DO jk = 1, jpkm1 74 DO jj = 1, jpj 75 DO ji = 1, jpi 76 77 ! Separation in three light bands: red, green, blue 78 ! ------------------------------------------------- 79 zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 80 zchl = MAX( 0.03, zchl ) 81 zchl = MIN( 10. , zchl ) 85 82 86 mrgb = int(41+20.*log10(xchl)+rtrn)83 irgb = INT( 41 + 20.* LOG10( zchl ) + rtrn ) 87 84 88 ekb(ji,jj,jk)=xkrgb(1,mrgb) 89 ekg(ji,jj,jk)=xkrgb(2,mrgb) 90 ekr(ji,jj,jk)=xkrgb(3,mrgb) 91 C 92 END DO 93 END DO 94 END DO 95 C 96 DO jj = 1,jpj 97 DO ji = 1,jpi 98 C 99 C Separation in three light bands: red, green, blue 100 C ------------------------------------------------- 101 C 102 zblight=0.5*ekb(ji,jj,1)*fse3t(ji,jj,1) 103 zglight=0.5*ekg(ji,jj,1)*fse3t(ji,jj,1) 104 zrlight=0.5*ekr(ji,jj,1)*fse3t(ji,jj,1) 105 C 106 e1(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zblight) 107 e2(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zglight) 108 e3(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zrlight) 109 C 110 END DO 111 END DO 112 113 DO jk = 2,jpkm1 114 DO jj = 1,jpj 115 DO ji = 1,jpi 116 C 117 C Separation in three light bands: red, green, blue 118 C ------------------------------------------------- 119 C 120 zblight=0.5*(ekb(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 121 & +ekb(ji,jj,jk)*fse3t(ji,jj,jk)) 122 zglight=0.5*(ekg(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 123 & +ekg(ji,jj,jk)*fse3t(ji,jj,jk)) 124 zrlight=0.5*(ekr(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 125 & +ekr(ji,jj,jk)*fse3t(ji,jj,jk)) 126 C 127 e1(ji,jj,jk) = e1(ji,jj,jk-1)*exp(-zblight) 128 e2(ji,jj,jk) = e2(ji,jj,jk-1)*exp(-zglight) 129 e3(ji,jj,jk) = e3(ji,jj,jk-1)*exp(-zrlight) 130 C 131 END DO 132 END DO 133 END DO 134 C 135 etot(:,:,:) = e1(:,:,:)+e2(:,:,:)+e3(:,:,:) 136 137 IF (ln_qsr_sms) THEN 138 C 139 C In the following, the vertical attenuation of qsr for the 140 C dynamics is computed 141 C --------------------------------------------------------- 142 C 143 DO jj = 1,jpj 144 DO ji = 1,jpi 145 C 146 C Separation in three light bands: red, green, blue 147 C ------------------------------------------------- 148 C 149 zblight=0.5*ekb(ji,jj,1)*fse3t(ji,jj,1) 150 zglight=0.5*ekg(ji,jj,1)*fse3t(ji,jj,1) 151 zrlight=0.5*ekr(ji,jj,1)*fse3t(ji,jj,1) 152 C 153 e3lum(ji,jj,1) = parlux*qsr(ji,jj) 154 e4lum(ji,jj,1) = parlux*qsr(ji,jj) 155 e5lum(ji,jj,1) = parlux*qsr(ji,jj) 156 e6lum(ji,jj,1) = (1.-3.*parlux)*qsr(ji,jj) 157 C 158 END DO 159 END DO 160 161 DO jk = 2,jpkm1 162 DO jj = 1,jpj 163 DO ji = 1,jpi 164 C 165 C Separation in three light bands: red, green, blue 166 C ------------------------------------------------- 167 C 168 zblight1=ekb(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 169 zglight1=ekg(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 170 zrlight1=ekr(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 171 172 e3lum(ji,jj,jk) = e3lum(ji,jj,jk-1)*exp(-zblight) 173 e4lum(ji,jj,jk) = e4lum(ji,jj,jk-1)*exp(-zglight) 174 e5lum(ji,jj,jk) = e5lum(ji,jj,jk-1)*exp(-zrlight) 175 e6lum(ji,jj,jk) = e6lum(ji,jj,jk-1) 176 & *exp(-fse3t(ji,jj,jk-1)/xsi1) 177 C 178 END DO 179 END DO 180 END DO 181 182 etot3(:,:,:)=e3lum(:,:,:)+e4lum(:,:,:)+e5lum(:,:,:) 183 & +e6lum(:,:,:) 184 185 ENDIF 186 C 187 C Computation of the euphotic depth 188 C --------------------------------- 189 C 190 zmeu(:,:) = 300. 191 192 DO jk = 2,jpkm1 193 DO jj = 1,jpj 194 DO ji = 1,jpi 195 IF (etot(ji,jj,jk).GE.0.0043*qsr(ji,jj)) THEN 196 zmeu(ji,jj) = fsdepw(ji,jj,jk+1) 197 ENDIF 198 END DO 199 END DO 200 END DO 201 C 202 zmeu(:,:)=min(300.,zmeu(:,:)) 203 C 204 C Computation of the mean light over the mixed layer depth 205 C -------------------------------------------------------- 206 C 207 zdepmoy = 0 208 etmp = 0. 209 emoy = 0. 210 211 DO jk = 1,jpkm1 212 DO jj = 1,jpj 213 DO ji = 1,jpi 214 if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) then 215 etmp(ji,jj) = etmp(ji,jj)+etot(ji,jj,jk)*fse3t(ji,jj,jk) 216 zdepmoy(ji,jj)=zdepmoy(ji,jj)+fse3t(ji,jj,jk) 217 endif 218 END DO 219 END DO 220 END DO 221 222 emoy(:,:,:) = etot(:,:,:) 223 224 DO jk = 1,jpkm1 225 DO jj = 1,jpj 226 DO ji = 1,jpi 227 IF (fsdepw(ji,jj,jk+1).LE.hmld(ji,jj)) THEN 228 emoy(ji,jj,jk) = etmp(ji,jj)/(zdepmoy(ji,jj)+rtrn) 229 ENDIF 230 END DO 231 END DO 232 END DO 233 234 # if defined key_trc_diaadd 235 trc2d(:,:,11) = zmeu(:,:) 236 # endif 237 C 238 #endif 239 RETURN 240 END 85 zekb(ji,jj,jk) = xkrgb(1,irgb) 86 zekg(ji,jj,jk) = xkrgb(2,irgb) 87 zekr(ji,jj,jk) = xkrgb(3,irgb) 88 89 END DO 90 END DO 91 END DO 92 93 DO jj = 1,jpj 94 DO ji = 1,jpi 95 96 ! Separation in three light bands: red, green, blue 97 ! ------------------------------------------------- 98 99 zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) 100 zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) 101 zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) 102 103 ze1(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zblight) 104 ze2(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zglight) 105 ze3(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zrlight) 106 107 END DO 108 END DO 109 110 DO jk = 2, jpkm1 111 DO jj = 1, jpj 112 DO ji = 1, jpi 113 114 ! Separation in three light bands: red, green, blue 115 ! ------------------------------------------------- 116 117 zblight = 0.5 * ( zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & 118 & + zekb(ji,jj,jk ) * fse3t(ji,jj,jk ) ) 119 zglight = 0.5 * ( zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & 120 & + zekg(ji,jj,jk ) * fse3t(ji,jj,jk ) ) 121 zrlight = 0.5 * ( zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & 122 & + zekr(ji,jj,jk ) * fse3t(ji,jj,jk ) ) 123 124 ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP(-zblight) 125 ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP(-zglight) 126 ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP(-zrlight) 127 128 END DO 129 END DO 130 END DO 131 132 etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:) 133 134 IF( ln_qsr_sms ) THEN 135 136 ! In the following, the vertical attenuation of qsr for the dynamics is computed 137 ! ------------------------------------------------------------------------------ 138 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 142 ! Separation in three light bands: red, green, blue 143 ! ------------------------------------------------- 144 145 zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) 146 zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) 147 zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) 148 149 ze3lum(ji,jj,1) = zparlux * qsr(ji,jj) 150 ze4lum(ji,jj,1) = zparlux * qsr(ji,jj) 151 ze5lum(ji,jj,1) = zparlux * qsr(ji,jj) 152 ze6lum(ji,jj,1) = (1.-3. * zparlux) * qsr(ji,jj) 153 154 END DO 155 END DO 156 157 DO jk = 2, jpkm1 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 161 ! Separation in three light bands: red, green, blue 162 ! ------------------------------------------------- 163 164 zblight1 = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 165 zglight1 = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 166 zrlight1 = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 167 168 ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight ) 169 ze4lum(ji,jj,jk) = ze4lum(ji,jj,jk-1) * EXP( -zglight ) 170 ze5lum(ji,jj,jk) = ze5lum(ji,jj,jk-1) * EXP( -zrlight ) 171 ze6lum(ji,jj,jk) = ze6lum(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) / xsi1 ) 172 173 END DO 174 END DO 175 END DO 176 177 etot3(:,:,:) = ze3lum(:,:,:) + ze4lum(:,:,:) + ze5lum(:,:,:) + ze6lum(:,:,:) 178 179 ENDIF 180 181 ! Computation of the euphotic depth 182 ! --------------------------------- 183 184 zmeu(:,:) = 300.e0 185 186 DO jk = 2, jpkm1 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) zmeu(ji,jj) = fsdepw(ji,jj,jk+1) 190 END DO 191 END DO 192 END DO 193 194 zmeu(:,:) = MIN( 300., zmeu(:,:) ) 195 196 ! Computation of the mean light over the mixed layer depth 197 ! -------------------------------------------------------- 198 199 zdepmoy(:,:) = 0.e0 200 zetmp (:,:) = 0.e0 201 emoy (:,:,:) = 0.e0 202 203 DO jk = 1, jpkm1 204 DO jj = 1, jpj 205 DO ji = 1, jpi 206 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 207 zetmp (ji,jj) = zetmp (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) 208 zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 209 ENDIF 210 END DO 211 END DO 212 END DO 213 214 emoy(:,:,:) = etot(:,:,:) 215 216 DO jk = 1, jpkm1 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 220 emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 221 ENDIF 222 END DO 223 END DO 224 END DO 225 226 # if defined key_trc_diaadd 227 trc2d(:,:,11) = zmeu(:,:) 228 # endif 229 ! 230 END SUBROUTINE p4z_opt 231 232 #else 233 !!====================================================================== 234 !! Dummy module : No PISCES bio-model 235 !!====================================================================== 236 CONTAINS 237 SUBROUTINE p4z_opt ! Empty routine 238 END SUBROUTINE p4z_opt 239 #endif 240 241 !!====================================================================== 242 END MODULE p4zopt
Note: See TracChangeset
for help on using the changeset viewer.
