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 8 and Version 9 of 2020WP/ENHANCE-10_acc_fix_traqsr


Ignore:
Timestamp:
2020-05-15T16:17:07+02:00 (3 years ago)
Author:
acc
Comment:

--

Legend:

Unmodified
Added
Removed
Modified

  • 2020WP/ENHANCE-10_acc_fix_traqsr

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