Changeset 1829 for branches/CMIP5_IPSL
- Timestamp:
- 2010-04-12T14:53:52+02:00 (14 years ago)
- Location:
- branches/CMIP5_IPSL/NEMO/OPA_SRC
- Files:
-
- 1 added
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/CMIP5_IPSL/NEMO/OPA_SRC/TRA/traqsr.F90
r1756 r1829 27 27 USE iom ! I/O manager 28 28 USE fldread ! read input fields 29 USE dtachl 29 30 30 31 IMPLICIT NONE … … 38 39 LOGICAL , PUBLIC :: ln_qsr_2bd = .TRUE. !: 2 band light absorption flag 39 40 LOGICAL , PUBLIC :: ln_qsr_bio = .FALSE. !: bio-model light absorption flag 40 INTEGER , PUBLIC :: nn_chldta = 0 !: use Chlorophyll data (=1) or not (=0)41 INTEGER , PUBLIC :: nn_chldta = 0 !: use Chlorophyll 2D data (=1) 3D data (=2) or not (=0) 41 42 REAL(wp), PUBLIC :: rn_abs = 0.58_wp !: fraction absorbed in the very near surface (RGB & 2 bands) 42 43 REAL(wp), PUBLIC :: rn_si0 = 0.35_wp !: very near surface depth of extinction (RGB & 2 bands) 43 44 REAL(wp), PUBLIC :: rn_si1 = 23.0_wp !: deepest depth of extinction (water type I) (2 bands) 44 45 REAL(wp), PUBLIC :: rn_si2 = 61.8_wp !: deepest depth of extinction (blue & 0.01 mg.m-3) (RGB) 45 46 46 47 ! Module variables 47 48 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) … … 96 97 REAL(wp) :: zchl, zcoef, zsi0r ! temporary scalars 97 98 REAL(wp) :: zc0, zc1, zc2, zc3 ! - - 98 REAL(wp), DIMENSION(jpi,jpj) :: zekb, zekg, zekr ! 2D workspace 99 REAL(wp), DIMENSION(jpi,jpj) :: zekb2, zekg2, zekr2 ! 2D workspace 100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zekb3, zekg3, zekr3 ! 3D workspace 99 101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze0, ze1 , ze2, ze3, zea ! 3D workspace 100 102 !!---------------------------------------------------------------------- … … 133 135 ! ! ------------------------- ! 134 136 ! Set chlorophyl concentration 135 IF( nn_chldta == 1 ) THEN !*Variable Chlorophyll137 IF( nn_chldta == 1 ) THEN !* 2D Variable Chlorophyll 136 138 ! 137 139 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 138 140 ! 139 !CDIR COLLAPSE 141 !CDIR COLLAPSE 140 142 !CDIR NOVERRCHK 141 143 DO jj = 1, jpj ! Separation in R-G-B depending of the surface Chl … … 144 146 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj) ) ) 145 147 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 146 zekb (ji,jj) = rkrgb(1,irgb)147 zekg (ji,jj) = rkrgb(2,irgb)148 zekr (ji,jj) = rkrgb(3,irgb)148 zekb2(ji,jj) = rkrgb(1,irgb) 149 zekg2(ji,jj) = rkrgb(2,irgb) 150 zekr2(ji,jj) = rkrgb(3,irgb) 149 151 END DO 150 152 END DO … … 161 163 !CDIR NOVERRCHK 162 164 DO jj = 1, jpj 165 !CDIR NOVERRCHK 166 DO ji = 1, jpi 167 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zsi0r ) 168 zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb2(ji,jj) ) 169 zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg2(ji,jj) ) 170 zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr2(ji,jj) ) 171 ze0(ji,jj,jk) = zc0 172 ze1(ji,jj,jk) = zc1 173 ze2(ji,jj,jk) = zc2 174 ze3(ji,jj,jk) = zc3 175 zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk) 176 END DO 177 END DO 178 END DO 179 ! 180 DO jk = 1, nksr ! compute and add qsr trend to ta 181 ta(:,:,jk) = ta(:,:,jk) + ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk) 182 END DO 183 zea(:,:,nksr+1:jpk) = 0.e0 ! below 400m set to zero 184 CALL iom_put( 'qsr3d', zea ) ! Shortwave Radiation 3D distribution 185 ! 186 ! Set chlorophyl concentration 187 ELSE IF( nn_chldta == 2) THEN !* 3D Variable Chlorophyll 188 ! 189 CALL dta_chl( kt ) 190 ! 191 DO jk = 1, jpkm1 ! Separation in R-G-B depending of the surface Chl 192 !CDIR NOVERRCHK 193 DO jj = 1, jpj ! Separation in R-G-B depending of the surface Chl 194 !CDIR NOVERRCHK 195 DO ji = 1, jpi 196 zchl = MIN( 10. , MAX( 0.03, chl_dta(ji,jj,jk) ) ) 197 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 198 zekb3(ji,jj,jk) = rkrgb(1,irgb) * fse3t(ji,jj,jk) 199 zekg3(ji,jj,jk) = rkrgb(2,irgb) * fse3t(ji,jj,jk) 200 zekr3(ji,jj,jk) = rkrgb(3,irgb) * fse3t(ji,jj,jk) 201 END DO 202 END DO 203 ENDDO 204 ! 205 zsi0r = 1.e0 / rn_si0 206 zcoef = ( 1. - rn_abs ) / 3.e0 ! equi-partition in R-G-B 207 ze0(:,:,1) = rn_abs * qsr(:,:) 208 ze1(:,:,1) = zcoef * qsr(:,:) 209 ze2(:,:,1) = zcoef * qsr(:,:) 210 ze3(:,:,1) = zcoef * qsr(:,:) 211 zea(:,:,1) = qsr(:,:) 212 ! 213 DO jk = 2, nksr+1 214 !CDIR NOVERRCHK 215 DO jj = 1, jpj 163 216 !CDIR NOVERRCHK 164 217 DO ji = 1, jpi 165 218 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zsi0r ) 166 zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )167 zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )168 zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) )219 zc1 = ze1(ji,jj,jk-1) * EXP( - zekb3(ji,jj,jk-1) ) 220 zc2 = ze2(ji,jj,jk-1) * EXP( - zekg3(ji,jj,jk-1) ) 221 zc3 = ze3(ji,jj,jk-1) * EXP( - zekr3(ji,jj,jk-1) ) 169 222 ze0(ji,jj,jk) = zc0 170 223 ze1(ji,jj,jk) = zc1 … … 261 314 WRITE(numout,*) '~~~~~~~~~~~~' 262 315 WRITE(numout,*) ' Namelist namtra_qsr : set the parameter of penetration' 263 WRITE(numout,*) ' Light penetration (T) or not (F) ln_traqsr = ', ln_traqsr264 WRITE(numout,*) ' RGB (Red-Green-Blue) light penetration ln_qsr_rgb = ', ln_qsr_rgb265 WRITE(numout,*) ' 2 band light penetration ln_qsr_2bd = ', ln_qsr_2bd266 WRITE(numout,*) ' bio-model light penetration ln_qsr_bio = ', ln_qsr_bio267 WRITE(numout,*) ' RGB : Chl data (=1) or cst value (=0) nn_chldta = ', nn_chldta268 WRITE(numout,*) ' RGB & 2 bands: fraction of light (rn_si1) rn_abs = ', rn_abs269 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0270 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1271 WRITE(numout,*) ' 3 bands: longest depth of extinction rn_si2 = ', rn_si2316 WRITE(numout,*) ' Light penetration (T) or not (F) ln_traqsr = ', ln_traqsr 317 WRITE(numout,*) ' RGB (Red-Green-Blue) light penetration ln_qsr_rgb = ', ln_qsr_rgb 318 WRITE(numout,*) ' 2 band light penetration ln_qsr_2bd = ', ln_qsr_2bd 319 WRITE(numout,*) ' bio-model light penetration ln_qsr_bio = ', ln_qsr_bio 320 WRITE(numout,*) ' RGB : Chl 2D/3D data (=1/2) or cst value (=0) nn_chldta = ', nn_chldta 321 WRITE(numout,*) ' RGB & 2 bands: fraction of light (rn_si1) rn_abs = ', rn_abs 322 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 323 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1 324 WRITE(numout,*) ' 3 bands: longest depth of extinction rn_si2 = ', rn_si2 272 325 ENDIF 273 326 … … 278 331 ln_qsr_bio = .FALSE. 279 332 ENDIF 333 IF( .NOT.lk_dtachl .AND. ln_qsr_rgb .AND. nn_chldta == 2 ) THEN 334 CALL ctl_stop( 'You want to use a Chl 3D data to force your light penetration', & 335 & 'key_dtachl is required in compilation ' ) 336 ENDIF 280 337 ! 281 338 ioptio = 0 ! Parameter control … … 284 341 IF( ln_qsr_bio ) ioptio = ioptio + 1 285 342 ! 286 IF( ioptio /= 1 ) THEN 287 ln_qsr_rgb = .TRUE. 288 nn_chldta = 0 289 ln_qsr_2bd = .FALSE. 290 ln_qsr_bio = .FALSE. 291 CALL ctl_warn( ' Choose ONE type of light penetration in namelist namtra_qsr', & 292 & ' otherwise, we force the model to run with RGB light penetration' ) 293 ENDIF 343 IF( ioptio /= 1 ) & 344 CALL ctl_stop( ' Choose ONE type of light penetration in namelist namtra_qsr' ) 294 345 ! 295 346 IF( ln_qsr_rgb .AND. nn_chldta == 0 ) nqsr = 1 296 347 IF( ln_qsr_rgb .AND. nn_chldta == 1 ) nqsr = 2 297 IF( ln_qsr_2bd ) nqsr = 3 298 IF( ln_qsr_bio ) nqsr = 4 348 IF( ln_qsr_rgb .AND. nn_chldta == 2 ) nqsr = 3 349 IF( ln_qsr_2bd ) nqsr = 4 350 IF( ln_qsr_bio ) nqsr = 5 299 351 ! 300 352 IF(lwp) THEN ! Print the choice 301 353 WRITE(numout,*) 302 354 IF( nqsr == 1 ) WRITE(numout,*) ' R-G-B light penetration - Constant Chlorophyll' 303 IF( nqsr == 2 ) WRITE(numout,*) ' R-G-B light penetration - Chl data ' 304 IF( nqsr == 3 ) WRITE(numout,*) ' 2 band light penetration' 305 IF( nqsr == 4 ) WRITE(numout,*) ' bio-model light penetration' 355 IF( nqsr == 2 ) WRITE(numout,*) ' R-G-B light penetration - 2D Chl data ' 356 IF( nqsr == 3 ) WRITE(numout,*) ' R-G-B light penetration - 3D Chl data ' 357 IF( nqsr == 4 ) WRITE(numout,*) ' 2 band light penetration' 358 IF( nqsr == 5 ) WRITE(numout,*) ' bio-model light penetration' 306 359 ENDIF 307 360 ! … … 328 381 ! 329 382 IF( nn_chldta == 1 ) THEN !* Chl data : set sf_chl structure 330 383 IF(lwp) WRITE(numout,*) 331 384 IF(lwp) WRITE(numout,*) ' Chlorophyll read in a file' 332 385 ALLOCATE( sf_chl(1), STAT=ierror ) … … 339 392 CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', & 340 393 & 'Solar penetration function of read chlorophyll', 'namtra_qsr' ) 341 ! 394 ! 342 395 ELSE !* constant Chl : compute once for all the distribution of light (etot3) 343 396 IF(lwp) WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.