Changeset 13899 for NEMO/branches/2020/tickets_icb_1900/src/OCE/TRA/traqsr.F90

Timestamp:

2020-11-27T17:26:33+01:00 (4 years ago)

Author:

mathiot

Message:

ticket #1900: update branch to trunk and add ICB test case

Location:

NEMO/branches/2020/tickets_icb_1900

Files:

• . (modified) (1 prop)
• src/OCE/TRA/traqsr.F90 (modified) (12 diffs)

NEMO/branches/2020/tickets_icb_1900

@@ -2 +2 @@
 ^/utils/build/makenemo@HEAD   makenemo
 ^/utils/build/mk@HEAD         mk
-^/utils/tools/@HEAD           tools
+^/utils/tools@HEAD            tools
 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
@@ -8 +8 @@
 
 # SETTE
-^/utils/CI/sette@12931        sette
+^/utils/CI/sette@13559        sette

@@ -2 +2 @@
 ^/utils/build/makenemo@HEAD   makenemo
 ^/utils/build/mk@HEAD         mk
-^/utils/tools/@HEAD           tools
+^/utils/tools@HEAD            tools
 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
@@ -8 +8 @@
 
 # SETTE
-^/utils/CI/sette@12931        sette
+^/utils/CI/sette@13559        sette

NEMO/branches/2020/tickets_icb_1900/src/OCE/TRA/traqsr.F90

@@ -63 +63 @@
    REAL(wp) ::   xsi1r   ! inverse of rn_si1
    !
-   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
+   REAL(wp) , PUBLIC, DIMENSION(3,61)   ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
 
@@ -138 +138 @@
             IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
             z1_2 = 0.5_wp
-            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux
+            CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux
          ELSE                                           ! No restart or restart not found: Euler forward time stepping
             z1_2 = 1._wp
@@ -172 +172 @@
             ! most expensive calculations)
             !
-            DO_2D_00_00
+            DO_2D( 0, 0, 0, 0 )
                        ! zlogc = log(zchl)
                zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) )     
@@ -191 +191 @@
             
 !
-            DO_3D_00_00 ( 1, nksr + 1 )
+            DO_3D( 0, 0, 0, 0, 1, nksr + 1 )
                ! zchl    = ALOG( ze0(ji,jj) )
                zlogc = ze0(ji,jj)
@@ -221 +221 @@
          !
          zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
-         DO_2D_00_00
+         DO_2D( 0, 0, 0, 0 )
             ze0(ji,jj) = rn_abs * qsr(ji,jj)
             ze1(ji,jj) = zcoef  * qsr(ji,jj)
@@ -231 +231 @@
          END_2D
          !
-         !* interior equi-partition in R-G-B depending on vertical profile of Chl
-         DO_3D_00_00 ( 2, nksr + 1 )
+         !                                    !* interior equi-partition in R-G-B depending on vertical profile of Chl
+         DO_3D( 0, 0, 0, 0, 2, nksr + 1 )
             ze3t = e3t(ji,jj,jk-1,Kmm)
             irgb = NINT( ztmp3d(ji,jj,jk) )
@@ -246 +246 @@
          END_3D
          !
-         DO_3D_00_00( 1, nksr )
+         DO_3D( 0, 0, 0, 0, 1, nksr )          !* now qsr induced heat content
             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) )
          END_3D
@@ -256 +256 @@
          zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands
          zz1 = ( 1. - rn_abs ) * r1_rho0_rcp
-         DO_3D_00_00( 1, nksr )
+         DO_3D( 0, 0, 0, 0, 1, nksr )             ! solar heat absorbed at T-point in the top 400m 
             zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r )
             zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r )
@@ -265 +265 @@
       !
       !                          !-----------------------------!
-      DO_3D_00_00( 1, nksr )
+      !                          !  update to the temp. trend  !
+      !                          !-----------------------------!
+      DO_3D( 0, 0, 0, 0, 1, nksr )
          pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   &
             &                      + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) )   &
@@ -272 +274 @@
       !
       ! sea-ice: store the 1st ocean level attenuation coefficient
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
          IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) )
          ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
@@ -417 +419 @@
          IF( .NOT.lk_top )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
          !
+         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
+         !                                   
+         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
+         !
+         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+         !
       END SELECT
       !
@@ -423 +431 @@
       ! 1st ocean level attenuation coefficient (used in sbcssm)
       IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev, ldxios = lrxios  )
+         CALL iom_get( numror, jpdom_auto, 'fraqsr_1lev'  , fraqsr_1lev, ldxios = lrxios  )
       ELSE
          fraqsr_1lev(:,:) = 1._wp   ! default : no penetration

@@ -2 +2 @@
 ^/utils/build/makenemo@HEAD   makenemo
 ^/utils/build/mk@HEAD         mk
-^/utils/tools/@HEAD           tools
+^/utils/tools@HEAD            tools
 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
@@ -8 +8 @@
 
 # SETTE
-^/utils/CI/sette@12931        sette
+^/utils/CI/sette@13559        sette