Changeset 11772 for NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_coare3p0.F90

Timestamp:

2019-10-23T16:04:12+02:00 (4 years ago)

Author:

laurent

Message:

LB: solid updates+improvements of cool-skin/warm-layer capabilty of COARE and ECMWF bulk algorithms!

File:

• NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_coare3p0.F90 (modified) (10 diffs)

NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_coare3p0.F90

@@ -49 +49 @@
    REAL(wp), PARAMETER ::   Beta0   =   1.25_wp   ! gustiness parameter
 
-   INTEGER , PARAMETER ::   nb_itt = 5             ! number of itterations
+   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations
 
    !!----------------------------------------------------------------------
@@ -70 +70 @@
       IF ( l_use_wl ) THEN
          ierr = 0
-         ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), H_wl(jpi,jpj), STAT=ierr )
+         ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), Hz_wl(jpi,jpj), dT_wl(jpi,jpj), STAT=ierr )
          !IF( ierr > 0 ) STOP ' COARE3P0_INIT => allocation of Tau_ac and Qnt_ac failed!'
          Tau_ac(:,:) = 0._wp
-         Qnt_ac(:,:)   = 0._wp
-         H_wl(:,:)    = H_wl_max
+         Qnt_ac(:,:) = 0._wp
+         Hz_wl(:,:)  = Hwl_max
+         dT_wl(:,:)  = 0._wp
       END IF
       !!
       IF ( l_use_cs ) THEN
          ierr = 0
-         ALLOCATE ( delta_vl(jpi,jpj), STAT=ierr )
-         !IF( ierr > 0 ) STOP ' COARE3P0_INIT => allocation of delta_vl and Qnt_ac failed!'
-         delta_vl(:,:) = 0.001_wp      ! First guess of zdelta [m]
+         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+         !IF( ierr > 0 ) STOP ' COARE3P0_INIT => allocation of dT_cs and Qnt_ac failed!'
+         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction
       END IF
    END SUBROUTINE coare3p0_init
@@ -91 +92 @@
       &                      Cdn, Chn, Cen,                                              &
       &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer)
-      &                      pdT_wl, Hwl )                                                 ! optionals for warm-layer only
+      &                      pdT_wl, pHz_wl )                                                 ! optionals for warm-layer only
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  turb_coare3p0  ***
@@ -133 +134 @@
       !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K]
       !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K]
-      !!    * Hwl     : depth of warm layer                                   [m]
+      !!    * pHz_wl  : thickness of warm-layer                               [m]
       !!
       !! OUTPUT :
@@ -171 +172 @@
       !
       REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K]
-      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   Hwl      !             [m]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m]
       !
       INTEGER :: j_itt
@@ -190 +191 @@
          &                pdTw,   &  ! SST increment "dT" for warm layer correction          [K]
          &                zHwl       ! depth of warm-layer [m]
+      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_coare3p0@sbcblk_algo_coare3p0'
       !!----------------------------------------------------------------------------------
 
-      IF ( kt == 1 ) CALL COARE3P0_INIT(l_use_cs, l_use_wl) ! allocation of accumulation arrays
+      IF ( kt == nit000 ) CALL COARE3P0_INIT(l_use_cs, l_use_wl)
 
       l_zt_equal_zu = .FALSE.
@@ -199 +201 @@
 
       !! Initializations for cool skin and warm layer:
+      IF ( l_use_cs ) THEN
+         IF( .NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp)) ) THEN
+            PRINT *, ' * PROBLEM ('//TRIM(crtnm)//'): you need to provide Qsw, rad_lw & slp to use cool-skin param!'; STOP
+         END IF
+      END IF
+
+      IF ( l_use_wl ) THEN
+         IF(.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp) )) THEN
+            PRINT *, ' * PROBLEM ('//TRIM(crtnm)//'): you need to provide Qsw, rad_lw & slp to use warm-layer param!'; STOP
+         END IF
+      END IF
+
       IF ( l_use_cs .OR. l_use_wl ) THEN
-         IF( .NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp)) ) &
-            & CALL ctl_stop( 'turb_coare3p0 => provide Qsw, rad_lw & slp to ', 'use cool-skin and/or warm-layer param' )
          ALLOCATE ( zsst(jpi,jpj) )
          zsst = T_s ! backing up the bulk SST
-         IF( l_use_cs ) T_s = T_s - 0.25   ! First guess of correction
+         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction
          q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s !LOLO WL too!!!
-      END IF
-      IF ( l_use_cs ) THEN
-         ALLOCATE ( pdTc(jpi,jpj) )
-         pdTc(:,:) = -0.25_wp  ! First guess of skin correction
-      END IF
-      IF ( l_use_wl ) THEN
-         ALLOCATE ( pdTw(jpi,jpj) )
-         IF (PRESENT(Hwl)) ALLOCATE ( zHwl(jpi,jpj) )
       END IF
 
@@ -323 +327 @@
             !! Cool-skin contribution
 
-            CALL UPDATE_QNSOL_TAU( T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_blk, slp, rad_lw, &
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
                &                   ztmp1, zeta_u,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> zeta_u
 
-            CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2,  pdTc )  ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
-
-            T_s(:,:) = zsst(:,:) + pdTc(:,:)*tmask(:,:,1)
-            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + pdTw(:,:)*tmask(:,:,1)
+            CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 )  ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
+
+            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
             q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
 
@@ -336 +340 @@
          IF( l_use_wl ) THEN
             !! Warm-layer contribution
-            CALL UPDATE_QNSOL_TAU( T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_blk, slp, rad_lw, &
+            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, &
                &                   ztmp1, zeta_u)  ! Qnsol -> ztmp1 / Tau -> zeta_u
             !! In WL_COARE or , Tau_ac and Qnt_ac must be updated at the final itteration step => add a flag to do this!
-            IF (PRESENT(Hwl)) THEN
-               CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt),  pdTw,  Hwl=zHwl )
-            ELSE
-               CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt),  pdTw )
-            END IF
+            CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt) )
+
             !! Updating T_s and q_s !!!
-            T_s(:,:) = zsst(:,:) + pdTw(:,:)*tmask(:,:,1)
-            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + pdTc(:,:)*tmask(:,:,1)
+            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
             q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
-            !LOLO:
-            !IF ( j_itt == nb_itt) THEN
-            !   WRITE(cf_tmp,'("Qnt_ac_k",i5.5,"_p",i4.4,".nc")') kt, narea
-            !   CALL DUMP_FIELD(REAL( Qnt_ac*tmask(:,:,1) , 4), TRIM(cf_tmp), 'Qnt_ac')
-            !   WRITE(cf_tmp,  '("pdTw_k",i5.5,"_p",i4.4,".nc")') kt, narea
-            !   CALL DUMP_FIELD(REAL( pdTw*tmask(:,:,1) , 4), TRIM(cf_tmp), 'pdTw')
-            !END IF
-            !LOLO.
-         END IF
-
+         END IF
 
          IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN
@@ -379 +371 @@
       IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t )
 
-      IF ( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = pdTc*tmask(:,:,1)
-      IF ( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = pdTw*tmask(:,:,1)
+      IF ( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs
+      IF ( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl
+      IF ( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl
 
       IF ( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst )
-      IF (          l_use_cs      ) DEALLOCATE ( pdTc )
-      IF (          l_use_wl      ) THEN
-         DEALLOCATE ( pdTw )
-         IF (PRESENT(Hwl)) DEALLOCATE ( zHwl )
-      END IF
 
    END SUBROUTINE turb_coare3p0