Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

Timestamp:

2015-12-03T09:10:32+01:00 (9 years ago)

Author:

deazer

Message:

Merging TMB and 25h diagnostics to head of trunk
added brief documentation

File:

• branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (15 diffs)

branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

@@ -32 +32 @@
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
-   USE sbc_ice, ONLY : lk_lim3
 
    IMPLICIT NONE
@@ -38 +37 @@
 
    PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
-   PUBLIC   tra_qsr_init  ! routine called by opa.F90
+   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90
 
    !                                 !!* Namelist namtra_qsr: penetrative solar radiation
@@ -50 +49 @@
    REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
    REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
-   
+ 
    ! Module variables
    REAL(wp) ::   xsi0r                           !: inverse of rn_si0
@@ -165 +164 @@
          CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution
          ! clem: store attenuation coefficient of the first ocean level
-         IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+         IF ( ln_qsr_ice ) THEN
             DO jj = 1, jpj
                DO ji = 1, jpi
                   IF ( qsr(ji,jj) /= 0._wp ) THEN
                      fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) )
+                  ELSE
+                     fraqsr_1lev(ji,jj) = 1.
                   ENDIF
                END DO
@@ -188 +189 @@
                   CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step
                   !         
-!CDIR COLLAPSE
-!CDIR NOVERRCHK
                   DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl
-!CDIR NOVERRCHK
                      DO ji = 1, jpi
                         zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
@@ -216 +214 @@
                !
                DO jk = 2, nksr+1
-!CDIR NOVERRCHK
                   DO jj = 1, jpj
-!CDIR NOVERRCHK   
                      DO ji = 1, jpi
                         zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
@@ -233 +229 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   DO jj = 1, jpj
                      DO ji = 1, jpi
@@ -256 +252 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
                ENDIF
@@ -279 +275 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   DO jj = 1, jpj
                      DO ji = 1, jpi
@@ -298 +294 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
                ENDIF
@@ -324 +320 @@
             &                    'at it= ', kt,' date= ', ndastp
          IF(lwp) WRITE(numout,*) '~~~~'
-         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc )
+         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
+         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm 
          !
       ENDIF
@@ -379 +376 @@
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init')
-      !
-      ! Default value for fraqsr_1lev
-      IF( .NOT. ln_rstart ) THEN
-         fraqsr_1lev(:,:) = 1._wp
-      ENDIF
       !
       CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
@@ -412 +404 @@
          WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0
          WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1
-         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice    
       ENDIF
 
@@ -499 +490 @@
                
                   DO jk = 2, nksr+1
-!CDIR NOVERRCHK
                      DO jj = 1, jpj
-!CDIR NOVERRCHK   
                         DO ji = 1, jpi
                            zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r     )
@@ -564 +553 @@
       ENDIF
       !
+      ! initialisation of fraqsr_1lev used in sbcssm
+      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
+      ELSE
+         fraqsr_1lev(:,:) = 1._wp   ! default definition
+      ENDIF
+      !
       CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
       CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )