Changeset 4619 for branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

Timestamp:

2014-04-08T11:23:42+02:00 (10 years ago)

Author:

gm

Message:

#1294 : TEOS-10 and Ediag

File:

• branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (modified) (11 diffs)

branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

@@ -269 +269 @@
       zwnd_j(:,:) = 0.e0
 #if defined key_cyclone
-# if defined key_vectopt_loop
-!CDIR COLLAPSE
-# endif
-      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add Manu !
+      CALL wnd_cyc( kt, zwnd_i, zwnd_j )
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vect. opt.
@@ -279 +276 @@
          END DO
       END DO
-#endif
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
 #endif
       DO jj = 2, jpjm1
@@ -292 +286 @@
       CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. )
       ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
          &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
@@ -443 +435 @@
    END SUBROUTINE blk_oce_core
   
+  
    SUBROUTINE blk_bio_meanqsr
       !!---------------------------------------------------------------------
@@ -453 +446 @@
       !! 
       !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr')
-
-      qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1)
-
-      IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr')
-
+      IF( nn_timing == 1 )   CALL timing_start('blk_bio_meanqsr')
+      !
+      qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('blk_bio_meanqsr')
+      !
    END SUBROUTINE blk_bio_meanqsr
  
@@ -604 +597 @@
          !
       CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
-#endif
          DO jj = 2, jpj
             DO ji = fs_2, jpi   ! vect. opt.
@@ -614 +604 @@
             END DO
          END DO
-#if defined key_vectopt_loop
-!CDIR COLLAPSE
-#endif
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vect. opt.
@@ -635 +622 @@
       DO jl = 1, ijpl                       !  Loop over ice categories  !
          !                                  ! ========================== !
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
          DO jj = 1 , jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                ! ----------------------------!
@@ -700 +684 @@
       p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
       CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation 
-      CALL iom_put( 'precip', p_tpr * 86400. )                   ! Total precipitation 
+      CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation 
       !
       IF(ln_ctl) THEN
@@ -810 +794 @@
 
          !! Estimate the Monin-Obukov length :
-         L  = (U_star**2)/( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) )
+         L = U_star*U_star / ( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) )
+!!gm  !lolo  suggestion ......   TO BE TAKEN  ?
+!!         L = U_star*U_star / ( kappa*grav/T_vpot*(T_star*(1. + 0.608*q_a) + 0.608*T_a*q_star) )
+!!gm     !lolo.
 
          !! Stability parameters :
@@ -1034 +1021 @@
       REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit
       !-------------------------------------------------------------------------------
-
+      !
       CALL wrk_alloc( jpi,jpj, X2, X, stabit )
-
+      !
       X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2)
       stabit    = 0.5 + sign(0.5,zta)
-      psi_h = -5.*zta*stabit  &                                       ! Stable
+      psi_h = -5.*zta*stabit   &                                       ! Stable
          &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable
-
+         !
       CALL wrk_dealloc( jpi,jpj, X2, X, stabit )
       !