Changeset 5236 for branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
- Timestamp:
- 2015-04-24T14:08:11+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r5230 r5236 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 46 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue) 47 48 48 49 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) … … 76 77 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 77 78 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze kg, zekr, zekb, ze0, ze1, ze2, ze379 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 79 80 !!--------------------------------------------------------------------- 80 81 ! … … 83 84 ! Allocate temporary workspace 84 85 CALL wrk_alloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 85 CALL wrk_alloc( jpi, jpj, jpk, zpar, ze kg, zekr, zekb, ze0, ze1, ze2, ze3 )86 CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 86 87 87 88 IF( jnt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) … … 102 103 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 103 104 ! 104 zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)105 zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)106 zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)105 ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 106 ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 107 ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 107 108 END DO 108 109 END DO … … 110 111 ! !* Photosynthetically Available Radiation (PAR) 111 112 ! ! -------------------------------------- 112 IF( l n_dm2dc ) THEN ! diurnal cycle113 IF( l_trcdm2dc ) THEN ! diurnal cycle 113 114 ! 1% of qsr to compute euphotic layer 114 115 zqsr100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr 115 116 ! 116 CALL p4z_opt_par( kt, qsr_mean, ze kb, zekg, zekr, ze1, ze2, ze3 )117 CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 ) 117 118 ! 118 119 DO jk = 1, nksrp … … 122 123 END DO 123 124 ! 124 CALL p4z_opt_par( kt, qsr, ze kb, zekg, zekr, ze1, ze2, ze3 )125 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 125 126 ! 126 127 DO jk = 1, nksrp … … 132 133 zqsr100(:,:) = 0.01 * qsr(:,:) 133 134 ! 134 CALL p4z_opt_par( kt, qsr, ze kb, zekg, zekr, ze1, ze2, ze3 )135 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 135 136 ! 136 137 DO jk = 1, nksrp … … 145 146 IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics) 146 147 ! ! ------------------------ 147 CALL p4z_opt_par( kt, qsr, ze kb, zekg, zekr, ze1, ze2, ze3, pe0=ze0 )148 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 148 149 ! 149 150 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) … … 214 215 IF( lk_iomput ) THEN 215 216 IF( jnt == nrdttrc ) THEN 216 IF( iom_use( "Heup" ) ) CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 217 IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 217 IF( iom_use( "Heup" ) ) CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 218 IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 219 IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 218 220 ENDIF 219 221 ELSE … … 225 227 ! 226 228 CALL wrk_dealloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 227 CALL wrk_dealloc( jpi, jpj, jpk, zpar, zekg, zekr, zekb,ze0, ze1, ze2, ze3 )229 CALL wrk_dealloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 228 230 ! 229 231 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') … … 231 233 END SUBROUTINE p4z_opt 232 234 233 SUBROUTINE p4z_opt_par( kt, pqsr, pe kb, pekg, pekr, pe1, pe2, pe3, pe0 )235 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 ) 234 236 !!---------------------------------------------------------------------- 235 237 !! *** routine p4z_opt_par *** … … 242 244 INTEGER, INTENT(in) :: kt ! ocean time-step 243 245 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 244 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pekb, pekg, pekr ! wavelength (Red-Green-Blue)245 246 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 246 247 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 … … 268 269 DO ji = 1, jpi 269 270 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) 270 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( - pekb(ji,jj,jk-1 ) )271 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( - pekg(ji,jj,jk-1 ) )272 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( - pekr(ji,jj,jk-1 ) )271 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 272 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) 273 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) ) 273 274 END DO 274 275 ! … … 279 280 ELSE ! T- level 280 281 ! 281 pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * pekb(:,:,1) )282 pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * pekg(:,:,1) )283 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * pekr(:,:,1) )282 pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) ) 283 pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) 284 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 284 285 ! 285 286 DO jk = 2, nksrp … … 288 289 !CDIR NOVERRCHK 289 290 DO ji = 1, jpi 290 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( pekb(ji,jj,jk-1) + pekb(ji,jj,jk) ) )291 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( pekg(ji,jj,jk-1) + pekg(ji,jj,jk) ) )292 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( pekr(ji,jj,jk-1) + pekr(ji,jj,jk) ) )291 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 292 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 293 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 293 294 END DO 294 295 END DO … … 402 403 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 403 404 ! 405 ekr (:,:,:) = 0._wp 406 ekb (:,:,:) = 0._wp 407 ekg (:,:,:) = 0._wp 404 408 etot (:,:,:) = 0._wp 405 409 etot_ndcy(:,:,:) = 0._wp … … 417 421 !! *** ROUTINE p4z_opt_alloc *** 418 422 !!---------------------------------------------------------------------- 419 ALLOCATE( enano (jpi,jpj,jpk), ediat(jpi,jpj,jpk), & 423 ALLOCATE( ekb(jpi,jpj,jpk) , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk), & 424 & enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk), & 420 425 & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 421 426 !
Note: See TracChangeset
for help on using the changeset viewer.
