New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
2020WP/ENHANCE-10_acc_fix_traqsr (diff) – NEMO

Changes between Version 7 and Version 8 of 2020WP/ENHANCE-10_acc_fix_traqsr


Ignore:
Timestamp:
2020-05-15T16:05:59+02:00 (4 years ago)
Author:
acc
Comment:

--

Legend:

Unmodified
Added
Removed
Modified

  • 2020WP/ENHANCE-10_acc_fix_traqsr

    v7 v8  
    256256 
    257257{{{#!diff 
    258 *** ORG/traqsr.F90      2020-05-13 11:37:57.094258396 +0100 
    259 --- traqsr.F90  2020-05-15 14:48:00.138206859 +0100 
    260 *************** 
    261 *** 109,120 **** 
    262         REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars 
    263         REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         - 
    264         REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
    265 !       REAL(wp) ::   zz0 , zz1                !    -         - 
    266         REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 
    267 !       REAL(wp) ::   zlogc, zlogc2, zlogc3 
    268 !       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr 
    269 !       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
    270 !       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 
    271         !!---------------------------------------------------------------------- 
    272         ! 
    273         IF( ln_timing )   CALL timing_start('tra_qsr') 
    274 --- 109,119 ---- 
    275         REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars 
    276         REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         - 
    277         REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
    278 !       REAL(wp) ::   zz0 , zz1 , ze3t, zlui   !    -         - 
    279         REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 
    280 !       REAL(wp) ::   zlogc 
    281 !       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: ze0, ze1, ze2, ze3 
    282 !       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d 
    283         !!---------------------------------------------------------------------- 
    284         ! 
    285         IF( ln_timing )   CALL timing_start('tra_qsr') 
    286 *************** 
    287 *** 159,235 **** 
    288            ! 
    289         CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==! 
    290            ! 
    291 !          ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , & 
    292 !             &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , & 
    293 !             &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   ) 
    294            ! 
    295            IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    296               CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
    297               DO jk = 1, nksr + 1 
    298 !                DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl 
    299 !                   DO ji = 2, jpim1 
    300 !                      zchl    = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
    301 !                      zCtot   = 40.6  * zchl**0.459 
    302 !                      zze     = 568.2 * zCtot**(-0.746) 
    303 !                      IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 
    304 !                      zpsi    = gdepw(ji,jj,jk,Kmm) / zze 
    305 !                      ! 
    306 !                      zlogc   = LOG( zchl ) 
    307 !                      zlogc2  = zlogc * zlogc 
    308 !                      zlogc3  = zlogc * zlogc * zlogc 
    309 !                      zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 
    310 !                      zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 
    311 !                      zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 
    312 !                      zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 
    313 !                      zCze    = 1.12  * (zchl)**0.803 
    314 !                      ! 
    315 !                      zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) 
    316 !                   END DO 
    317 !                   ! 
    318 !                END DO 
    319               END DO 
    320 -          ELSE                                !* constant chrlorophyll 
    321 -            DO jk = 1, nksr + 1 
    322 -               zchl3d(:,:,jk) = 0.05 
    323 -             ENDDO 
    324            ENDIF 
    325            ! 
    326            zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
    327            DO_2D_00_00 
    328 !             ze0(ji,jj,1) = rn_abs * qsr(ji,jj) 
    329 !             ze1(ji,jj,1) = zcoef  * qsr(ji,jj) 
    330 !             ze2(ji,jj,1) = zcoef  * qsr(ji,jj) 
    331 !             ze3(ji,jj,1) = zcoef  * qsr(ji,jj) 
    332 !             zea(ji,jj,1) =          qsr(ji,jj) 
    333            END_2D 
    334            ! 
    335 !          DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
    336 !             DO_2D_00_00 
    337 !                zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 
    338 !                irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    339 !                zekb(ji,jj) = rkrgb(1,irgb) 
    340 !                zekg(ji,jj) = rkrgb(2,irgb) 
    341 !                zekr(ji,jj) = rkrgb(3,irgb) 
    342 !             END_2D 
    343 ! 
    344 !             DO_2D_00_00 
    345 !                zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r       ) 
    346 !                zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) ) 
    347 !                zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) ) 
    348 !                zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) ) 
    349 !                ze0(ji,jj,jk) = zc0 
    350 !                ze1(ji,jj,jk) = zc1 
    351 !                ze2(ji,jj,jk) = zc2 
    352 !                ze3(ji,jj,jk) = zc3 
    353 !                zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
    354 !             END_2D 
    355 !          END DO 
    356            ! 
    357            DO_3D_00_00( 1, nksr ) 
    358 !             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
    359            END_3D 
    360            ! 
    361 !          DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d ) 
    362            ! 
    363         CASE( np_2BD  )            !==  2-bands fluxes  ==! 
    364            ! 
    365 --- 158,232 ---- 
    366            ! 
    367         CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==! 
    368            ! 
    369 !          ALLOCATE( ze0 (jpi,jpj)           , ze1 (jpi,jpj) ,   & 
    370 !             &      ze2 (jpi,jpj)           , ze3 (jpi,jpj) ,   & 
    371 !             &      ztmp3d(jpi,jpj,nksr + 1)                     ) 
    372            ! 
    373            IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    374               CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
    375 +             ! Separation in R-G-B depending of the surface Chl 
    376 +             DO_3D_00_00 ( 1, nksr + 1 ) 
    377 +                zchl    = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
    378 +                zCze    = 1.12  * (zchl)**0.803 
    379 +                zCtot   = 40.6  * zchl**0.459 
    380 +                zlogc   = LOG( zchl ) 
    381 +                ! 
    382 +                zCb     = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) ) 
    383 +                zCmax   = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 ) 
    384 +                zpsimax = 0.6   - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) ) 
    385 +                zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) 
    386 +                ! 
    387 +                zze     = 568.2 * zCtot**(-0.746) 
    388 +                IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 
    389 +                zpsi    = gdepw(ji,jj,jk,Kmm) / zze 
    390 +                ! 
    391 +                ! NB. make sure zchl value is such that: zchl = MIN( 10. , MAX( 0.03, zchl ) ) 
    392 +                zchl = MIN( 10. , MAX( 0.03, zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) ) ) 
    393 +                ! Convert chlorophyll value to attenuation coefficient look-up table index 
    394 +                ztmp3d(ji,jj,jk) = 41 + 20.*LOG10(zchl) + 1.e-15 
    395 +             END_3D 
    396 +          ELSE                                !* constant chlorophyll 
    397 +             zchl = 0.05 
    398 +             ! NB. make sure constant value is such that: 
    399 +             zchl = MIN( 10. , MAX( 0.03, zchl ) ) 
    400 +             ! Convert chlorophyll value to attenuation coefficient look-up table index 
    401 +             zlui = 41 + 20.*LOG10(zchl) + 1.e-15 
    402               DO jk = 1, nksr + 1 
    403 !                ztmp3d(:,:,jk) = zlui 
    404               END DO 
    405            ENDIF 
    406            ! 
    407            zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
    408            DO_2D_00_00 
    409 !             ze0(ji,jj) = rn_abs * qsr(ji,jj) 
    410 !             ze1(ji,jj) = zcoef  * qsr(ji,jj) 
    411 !             ze2(ji,jj) = zcoef  * qsr(ji,jj) 
    412 !             ze3(ji,jj) = zcoef  * qsr(ji,jj) 
    413 !             ! store the surface SW radiation; re-use the surface ztmp3d array 
    414 !             ! since the surface attenuation coefficient is not used 
    415 !             ztmp3d(ji,jj,1) =       qsr(ji,jj) 
    416            END_2D 
    417            ! 
    418 !          !* interior equi-partition in R-G-B depending of vertical profile of Chl 
    419 !          DO_3D_00_00 ( 2, nksr + 1 ) 
    420 !             ze3t = e3t(ji,jj,jk-1,Kmm) 
    421 !             irgb = NINT( ztmp3d(ji,jj,jk) ) 
    422 !             zc0 = ze0(ji,jj) * EXP( - ze3t * xsi0r ) 
    423 !             zc1 = ze1(ji,jj) * EXP( - ze3t * rkrgb(1,irgb) ) 
    424 !             zc2 = ze2(ji,jj) * EXP( - ze3t * rkrgb(2,irgb) ) 
    425 !             zc3 = ze3(ji,jj) * EXP( - ze3t * rkrgb(3,irgb) ) 
    426 !             ze0(ji,jj) = zc0 
    427 !             ze1(ji,jj) = zc1 
    428 !             ze2(ji,jj) = zc2 
    429 !             ze3(ji,jj) = zc3 
    430 !             ztmp3d(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
    431 !          END_3D 
    432            ! 
    433            DO_3D_00_00( 1, nksr ) 
    434 !             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 
    435            END_3D 
    436            ! 
    437 !          DEALLOCATE( ze0 , ze1 , ze2 , ze3 , ztmp3d ) 
    438            ! 
    439         CASE( np_2BD  )            !==  2-bands fluxes  ==! 
    440            ! 
     258112c112 
     259<       REAL(wp) ::   zz0 , zz1                !    -         - 
     260--- 
     261>       REAL(wp) ::   zz0 , zz1 , ze3t, zlui   !    -         - 
     262114,117c114,116 
     263<       REAL(wp) ::   zlogc, zlogc2, zlogc3 
     264<       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr 
     265<       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
     266<       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 
     267--- 
     268>       REAL(wp) ::   zlogc 
     269>       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: ze0, ze1, ze2, ze3 
     270>       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d 
     271162,164c161,163 
     272<          ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , & 
     273<             &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , & 
     274<             &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   ) 
     275--- 
     276>          ALLOCATE( ze0 (jpi,jpj)           , ze1 (jpi,jpj) ,   & 
     277>             &      ze2 (jpi,jpj)           , ze3 (jpi,jpj) ,   & 
     278>             &      ztmp3d(jpi,jpj,nksr + 1)                     ) 
     279167a167,193 
     280>             ! Separation in R-G-B depending of the surface Chl 
     281>             DO_3D_00_00 ( 1, nksr + 1 ) 
     282>                zchl    = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
     283>                zCze    = 1.12  * (zchl)**0.803 
     284>                zCtot   = 40.6  * zchl**0.459 
     285>                zlogc   = LOG( zchl ) 
     286>                ! 
     287>                zCb     = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) ) 
     288>                zCmax   = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 ) 
     289>                zpsimax = 0.6   - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) ) 
     290>                zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) 
     291>                ! 
     292>                zze     = 568.2 * zCtot**(-0.746) 
     293>                IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 
     294>                zpsi    = gdepw(ji,jj,jk,Kmm) / zze 
     295>                ! 
     296>                ! NB. make sure zchl value is such that: zchl = MIN( 10. , MAX( 0.03, zchl ) ) 
     297>                zchl = MIN( 10. , MAX( 0.03, zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) ) ) 
     298>                ! Convert chlorophyll value to attenuation coefficient look-up table index 
     299>                ztmp3d(ji,jj,jk) = 41 + 20.*LOG10(zchl) + 1.e-15 
     300>             END_3D 
     301>          ELSE                                !* constant chlorophyll 
     302>             zchl = 0.05 
     303>             ! NB. make sure constant value is such that: 
     304>             zchl = MIN( 10. , MAX( 0.03, zchl ) ) 
     305>             ! Convert chlorophyll value to attenuation coefficient look-up table index 
     306>             zlui = 41 + 20.*LOG10(zchl) + 1.e-15 
     307169,189c195 
     308<                DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl 
     309<                   DO ji = 2, jpim1 
     310<                      zchl    = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
     311<                      zCtot   = 40.6  * zchl**0.459 
     312<                      zze     = 568.2 * zCtot**(-0.746) 
     313<                      IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 
     314<                      zpsi    = gdepw(ji,jj,jk,Kmm) / zze 
     315<                      ! 
     316<                      zlogc   = LOG( zchl ) 
     317<                      zlogc2  = zlogc * zlogc 
     318<                      zlogc3  = zlogc * zlogc * zlogc 
     319<                      zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 
     320<                      zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 
     321<                      zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 
     322<                      zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 
     323<                      zCze    = 1.12  * (zchl)**0.803 
     324<                      ! 
     325<                      zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) 
     326<                   END DO 
     327<                   ! 
     328<                END DO 
     329--- 
     330>                ztmp3d(:,:,jk) = zlui 
     331191,194d196 
     332<          ELSE                                !* constant chrlorophyll 
     333<            DO jk = 1, nksr + 1 
     334<               zchl3d(:,:,jk) = 0.05 
     335<             ENDDO 
     336199,203c201,207 
     337<             ze0(ji,jj,1) = rn_abs * qsr(ji,jj) 
     338<             ze1(ji,jj,1) = zcoef  * qsr(ji,jj) 
     339<             ze2(ji,jj,1) = zcoef  * qsr(ji,jj) 
     340<             ze3(ji,jj,1) = zcoef  * qsr(ji,jj) 
     341<             zea(ji,jj,1) =          qsr(ji,jj) 
     342--- 
     343>             ze0(ji,jj) = rn_abs * qsr(ji,jj) 
     344>             ze1(ji,jj) = zcoef  * qsr(ji,jj) 
     345>             ze2(ji,jj) = zcoef  * qsr(ji,jj) 
     346>             ze3(ji,jj) = zcoef  * qsr(ji,jj) 
     347>             ! store the surface SW radiation; re-use the surface ztmp3d array 
     348>             ! since the surface attenuation coefficient is not used 
     349>             ztmp3d(ji,jj,1) =       qsr(ji,jj) 
     350206,226c210,223 
     351<          DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
     352<             DO_2D_00_00 
     353<                zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 
     354<                irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
     355<                zekb(ji,jj) = rkrgb(1,irgb) 
     356<                zekg(ji,jj) = rkrgb(2,irgb) 
     357<                zekr(ji,jj) = rkrgb(3,irgb) 
     358<             END_2D 
     359< 
     360<             DO_2D_00_00 
     361<                zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r       ) 
     362<                zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) ) 
     363<                zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) ) 
     364<                zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) ) 
     365<                ze0(ji,jj,jk) = zc0 
     366<                ze1(ji,jj,jk) = zc1 
     367<                ze2(ji,jj,jk) = zc2 
     368<                ze3(ji,jj,jk) = zc3 
     369<                zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
     370<             END_2D 
     371<          END DO 
     372--- 
     373>          !* interior equi-partition in R-G-B depending of vertical profile of Chl 
     374>          DO_3D_00_00 ( 2, nksr + 1 ) 
     375>             ze3t = e3t(ji,jj,jk-1,Kmm) 
     376>             irgb = NINT( ztmp3d(ji,jj,jk) ) 
     377>             zc0 = ze0(ji,jj) * EXP( - ze3t * xsi0r ) 
     378>             zc1 = ze1(ji,jj) * EXP( - ze3t * rkrgb(1,irgb) ) 
     379>             zc2 = ze2(ji,jj) * EXP( - ze3t * rkrgb(2,irgb) ) 
     380>             zc3 = ze3(ji,jj) * EXP( - ze3t * rkrgb(3,irgb) ) 
     381>             ze0(ji,jj) = zc0 
     382>             ze1(ji,jj) = zc1 
     383>             ze2(ji,jj) = zc2 
     384>             ze3(ji,jj) = zc3 
     385>             ztmp3d(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
     386>          END_3D 
     387229c226 
     388<             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
     389--- 
     390>             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 
     391232c229 
     392<          DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d ) 
     393--- 
     394>          DEALLOCATE( ze0 , ze1 , ze2 , ze3 , ztmp3d ) 
    441395}}} 
    442396[[Image(percent_cpu_qsr.png)]]