Changeset 13830 for NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ice_an05.F90

Timestamp:

2020-11-19T13:31:18+01:00 (4 years ago)

Author:

laurent

Message:

Sea-ice bulk algorithm "AN05" (Andreas et al. 2005) now operational!

File:

• NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ice_an05.F90 (modified) (7 diffs)

NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ice_an05.F90

@@ -19 +19 @@
    !!----------------------------------------------------------------------
    USE par_kind, ONLY: wp
-   USE par_oce,  ONLY: jpi, jpj
+   USE par_oce,  ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls
+   USE lib_mpp,  ONLY: ctl_stop         ! distribued memory computing library
    USE phycst          ! physical constants
    USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer
-   !USE sbcblk_algo_ice_cdn
 
    IMPLICIT NONE
@@ -31 +31 @@
    INTEGER , PARAMETER ::   nbit = 8        ! number of itterations
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE turb_ice_an05( zt, zu, Ts_i, t_zt, qs_i, q_zt, U_zu,         &
-      &                      Cd_i, Ch_i, Ce_i, t_zu_i, q_zu_i,             &
+   SUBROUTINE turb_ice_an05( zt, zu, Ts_i, t_zt, qs_i, q_zt, U_zu,        &
+      &                      Cd_i, Ch_i, Ce_i, t_zu_i, q_zu_i,            &
       &                      CdN, ChN, CeN, xz0, xu_star, xL, xUN10 )
       !!----------------------------------------------------------------------
@@ -100 +102 @@
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp0, ztmp1, ztmp2      ! temporary stuff
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z0, dt_zu, dq_zu
       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: u_star, t_star, q_star
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dt_zu, dq_zu
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: znu_a !: Nu_air = kinematic viscosity of air
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z0
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: znu_a                    !: Nu_air = kinematic viscosity of air
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_u, zeta_t           ! stability parameter at height zu
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: z0tq
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_u        ! stability parameter at height zu
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t        ! stability parameter at height zt
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp0, ztmp1, ztmp2
       !!
       INTEGER :: jit
@@ -117 +117 @@
       CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_an05@sbcblk_algo_ice_an05.f90'
       !!----------------------------------------------------------------------------------
-      ALLOCATE ( Ubzu(jpi,jpj), u_star(jpi,jpj), t_star(jpi,jpj),  q_star(jpi,jpj),  &
-         &       zeta_u(jpi,jpj),  dt_zu(jpi,jpj),   dq_zu(jpi,jpj),  &
-         &        znu_a(jpi,jpj),  ztmp1(jpi,jpj),   ztmp2(jpi,jpj),  &
-         &           z0(jpi,jpj),   z0tq(jpi,jpj,2), ztmp0(jpi,jpj)   )
-
-      IF( PRESENT(CdN) )     lreturn_cdn   = .TRUE.
-      IF( PRESENT(ChN) )     lreturn_chn   = .TRUE.
-      IF( PRESENT(CeN) )     lreturn_cen   = .TRUE.
-      IF( PRESENT(xz0) )     lreturn_z0    = .TRUE.
-      IF( PRESENT(xu_star) ) lreturn_ustar = .TRUE.
-      IF( PRESENT(xL) )      lreturn_L     = .TRUE.
-      IF( PRESENT(xUN10) )   lreturn_UN10  = .TRUE.
+      ALLOCATE (  Ubzu(jpi,jpj), u_star(jpi,jpj),  t_star(jpi,jpj),  q_star(jpi,jpj),  &
+         &      zeta_u(jpi,jpj),  dt_zu(jpi,jpj),   dq_zu(jpi,jpj),  &
+         &       znu_a(jpi,jpj),  ztmp1(jpi,jpj),   ztmp2(jpi,jpj),  &
+         &          z0(jpi,jpj),   z0tq(jpi,jpj,2), ztmp0(jpi,jpj)   )
+
+      lreturn_cdn   = PRESENT(CdN)
+      lreturn_chn   = PRESENT(ChN)
+      lreturn_cen   = PRESENT(CeN)
+      lreturn_z0    = PRESENT(xz0)
+      lreturn_ustar = PRESENT(xu_star)
+      lreturn_L     = PRESENT(xL)
+      lreturn_UN10  = PRESENT(xUN10)
 
       l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp )
       IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) )
-
 
       !! Scalar wind speed cannot be below 0.2 m/s
@@ -162 +161 @@
       t_star = dt_zu*vkarmn/(LOG(zu/z0tq(:,:,1)))
       q_star = dq_zu*vkarmn/(LOG(zu/z0tq(:,:,2)))
-
-
-
+      
+      
       !! ITERATION BLOCK
       DO jit = 1, nbit
@@ -217 +215 @@
       IF( lreturn_UN10 )  xUN10   = u_star/vkarmn*LOG(10./z0)
 
-      DEALLOCATE ( u_star, t_star, q_star, zeta_u, dt_zu, dq_zu, z0, z0tq, znu_a, ztmp0, ztmp1, ztmp2 )
+      DEALLOCATE ( Ubzu, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu, z0, z0tq, znu_a, ztmp0, ztmp1, ztmp2 )
       IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t )
 
@@ -243 +241 @@
 
             rough_leng_m(ji,jj) = 0.135*pnua(ji,jj)/zus + 0.035*zus*zus/grav*( 5.*EXP(-zz*zz) + 1._wp ) ! Eq.(19) Andreas et al., 2005
-
       END_2D
       !!