Changeset 2148 for branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traqsr.F90

Timestamp:

2010-10-04T15:53:42+02:00 (14 years ago)

Author:

cetlod

Message:

merge LOCEAN 2010 developments branches

File:

• branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (9 diffs)

branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traqsr.F90

@@ -27 +27 @@
    USE iom             ! I/O manager
    USE fldread         ! read input fields
+   USE restart         ! ocean restart
 
    IMPLICIT NONE
@@ -47 +48 @@
    ! Module variables
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
-   INTEGER ::   nksr   ! levels below which the light cannot penetrate ( depth larger than 391 m)
+   INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m)
    REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption
 
@@ -95 +96 @@
       REAL(wp) ::   zchl, zcoef, zsi0r   ! temporary scalars
       REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
+      REAL(wp) ::   z1_e3t, zfact        !    -         -
       REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace
@@ -111 +113 @@
          ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = 0.
       ENDIF
+
+      !                                        Set before qsr tracer content field
+      !                                        ***********************************
+      IF( kt == nit000 ) THEN                     ! Set the forcing field at nit000 - 1
+         !                                        ! -----------------------------------
+         IF( ln_rstart .AND.    &                    ! Restart: read in restart file
+              & iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field red in the restart file'
+            zfact = 0.5e0
+            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
+         ELSE                                           ! No restart or restart not found: Euler forward time stepping
+            zfact = 1.e0
+            qsr_hc_b(:,:,:) = 0.e0
+         ENDIF
+      ELSE                                        ! Swap of forcing field
+         !                                        ! ---------------------
+         zfact = 0.5e0
+         qsr_hc_b(:,:,:) = qsr_hc_n(:,:,:)
+      ENDIF
+      !                                        Compute now qsr tracer content field
+      !                                        ************************************
       
       !                                           ! ============================================== !
@@ -118 +141 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ta(ji,jj,jk) = ta(ji,jj,jk) + ro0cpr * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
+                  qsr_hc_n(ji,jj,jk) =  ro0cpr * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
                END DO
             END DO
@@ -175 +198 @@
                !
                DO jk = 1, nksr                                        ! compute and add qsr trend to ta
-                  tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk)
+                  qsr_hc_n(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )
                END DO
                zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero
@@ -182 +205 @@
             ELSE                                                 !*  Constant Chlorophyll
                DO jk = 1, nksr
-                  tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + etot3(:,:,jk) * qsr(:,:)
+                  qsr_hc_n(:,:,jk) =  etot3(:,:,jk) * qsr(:,:)
                END DO
             ENDIF
@@ -194 +217 @@
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + etot3(ji,jj,jk) * qsr(ji,jj)
+                     qsr_hc_n(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj)
                   END DO
                END DO
@@ -200 +223 @@
             !
          ENDIF
+         !
+      ENDIF
+      !                                        Add to the general trend
+      !                                        ************************
+      DO jk = 1, nksr
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z1_e3t = zfact / fse3t(ji,jj,jk)
+               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc_n(ji,jj,jk) ) * z1_e3t
+            END DO
+         END DO
+      END DO
+      !
+      IF( lrst_oce ) THEN   !                  Write in the ocean restart file
+         !                                     *******************************
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'qsr tracer content forcing field written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc_n )
          !
       ENDIF