New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2748 – NEMO

Changeset 2748


Ignore:
Timestamp:
2011-04-19T09:04:38+02:00 (13 years ago)
Author:
cbricaud
Message:

cbricaud: bugfix for sbcblk_core.F90: see ticket 814

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r2715 r2748  
    755755      !!---------------------------------------------------------------------- 
    756756      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    757       USE wrk_nemo, ONLY: dU10 => wrk_2d_1        ! dU                             [m/s] 
    758       USE wrk_nemo, ONLY: dT => wrk_2d_2          ! air/sea temperature difference   [K] 
    759       USE wrk_nemo, ONLY: dq => wrk_2d_3          ! air/sea humidity difference      [K] 
    760       USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_4      ! 10m neutral drag coefficient 
    761       USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_5      ! 10m neutral latent coefficient 
    762       USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_6      ! 10m neutral sensible coefficient 
    763       USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_7 ! root square of Cd_n10 
    764       USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_8     ! root square of Cd 
    765       USE wrk_nemo, ONLY: T_vpot => wrk_2d_9      ! virtual potential temperature    [K] 
    766       USE wrk_nemo, ONLY: T_star => wrk_2d_10     ! turbulent scale of tem. fluct. 
    767       USE wrk_nemo, ONLY: q_star => wrk_2d_11     ! turbulent humidity of temp. fluct. 
    768       USE wrk_nemo, ONLY: U_star => wrk_2d_12     ! turb. scale of velocity fluct. 
    769       USE wrk_nemo, ONLY: L => wrk_2d_13          ! Monin-Obukov length              [m] 
    770       USE wrk_nemo, ONLY: zeta_u => wrk_2d_14     ! stability parameter at height zu 
    771       USE wrk_nemo, ONLY: zeta_t => wrk_2d_15     ! stability parameter at height zt 
    772       USE wrk_nemo, ONLY: U_n10 => wrk_2d_16      ! neutral wind velocity at 10m     [m] 
    773       USE wrk_nemo, ONLY: xlogt => wrk_2d_17, xct => wrk_2d_18, zpsi_hu => wrk_2d_19, zpsi_ht => wrk_2d_20, zpsi_m => wrk_2d_21 
     757      USE wrk_nemo, ONLY: dU10 => wrk_2d_14        ! dU                             [m/s] 
     758      USE wrk_nemo, ONLY: dT => wrk_2d_15          ! air/sea temperature difference   [K] 
     759      USE wrk_nemo, ONLY: dq => wrk_2d_16          ! air/sea humidity difference      [K] 
     760      USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_17      ! 10m neutral drag coefficient 
     761      USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_18      ! 10m neutral latent coefficient 
     762      USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_19      ! 10m neutral sensible coefficient 
     763      USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_20 ! root square of Cd_n10 
     764      USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_21     ! root square of Cd 
     765      USE wrk_nemo, ONLY: T_vpot => wrk_2d_22      ! virtual potential temperature    [K] 
     766      USE wrk_nemo, ONLY: T_star => wrk_2d_23     ! turbulent scale of tem. fluct. 
     767      USE wrk_nemo, ONLY: q_star => wrk_2d_24     ! turbulent humidity of temp. fluct. 
     768      USE wrk_nemo, ONLY: U_star => wrk_2d_25     ! turb. scale of velocity fluct. 
     769      USE wrk_nemo, ONLY: L => wrk_2d_26          ! Monin-Obukov length              [m] 
     770      USE wrk_nemo, ONLY: zeta_u => wrk_2d_27     ! stability parameter at height zu 
     771      USE wrk_nemo, ONLY: zeta_t => wrk_2d_28     ! stability parameter at height zt 
     772      USE wrk_nemo, ONLY: U_n10 => wrk_2d_29      ! neutral wind velocity at 10m     [m] 
     773      USE wrk_nemo, ONLY: xlogt => wrk_2d_30, xct => wrk_2d_31, zpsi_hu => wrk_2d_32, zpsi_ht => wrk_2d_33, zpsi_m => wrk_2d_34 
    774774      USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
    775775      !! 
     
    798798      !!  * Start 
    799799 
    800       IF(  wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR. & 
    801           iwrk_in_use(2, 1) ) THEN 
     800      IF(  wrk_in_use(2,             14,15,16,17,18,19,        & 
     801                         20,21,22,23,24,25,26,27,28,29,        &          
     802                         30,31,32,33,34)                .OR.   & 
     803          iwrk_in_use(2, 1)                               ) THEN 
    802804         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable')   ;   RETURN 
    803       END IF 
     805      ENDIF 
    804806 
    805807      !! Initial air/sea differences 
     
    876878      END DO 
    877879      !! 
    878       IF(  wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR.   & 
    879           iwrk_not_released(2, 1)    )   CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable') 
     880     IF( wrk_not_released(2,              14,15,16,17,18,19,          & 
     881         &                    20,21,22,23,24,25,26,27,28,29,          & 
     882         &                    30,31,32,33,34                )   .OR.  &   
     883         iwrk_not_released(2, 1)                                  )   & 
     884         CALL ctl_stop('TURB_CORE_1Z: failed to release workspace arrays') 
    880885      ! 
    881886    END SUBROUTINE TURB_CORE_2Z 
     
    885890      !------------------------------------------------------------------------------- 
    886891      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    887       USE wrk_nemo, ONLY:     X2 => wrk_2d_33 
    888       USE wrk_nemo, ONLY:     X  => wrk_2d_34 
    889       USE wrk_nemo, ONLY: stabit => wrk_2d_35 
     892      USE wrk_nemo, ONLY:     X2 => wrk_2d_35 
     893      USE wrk_nemo, ONLY:     X  => wrk_2d_36 
     894      USE wrk_nemo, ONLY: stabit => wrk_2d_37 
    890895      !! 
    891896      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
     
    895900      !------------------------------------------------------------------------------- 
    896901 
    897       IF( wrk_in_use(2, 33,34,35) ) THEN 
     902      IF( wrk_in_use(2, 35,36,37) ) THEN 
    898903         CALL ctl_stop('psi_m: requested workspace arrays unavailable')   ;   RETURN 
    899904      ENDIF 
     
    904909         &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
    905910 
    906       IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_m: failed to release workspace arrays') 
     911      IF( wrk_not_released(2, 35,36,37) )   CALL ctl_stop('psi_m: failed to release workspace arrays') 
    907912      ! 
    908913    END FUNCTION psi_m 
     
    912917      !------------------------------------------------------------------------------- 
    913918      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    914       USE wrk_nemo, ONLY:     X2 => wrk_2d_33 
    915       USE wrk_nemo, ONLY:     X  => wrk_2d_34 
    916       USE wrk_nemo, ONLY: stabit => wrk_2d_35 
     919      USE wrk_nemo, ONLY:     X2 => wrk_2d_35 
     920      USE wrk_nemo, ONLY:     X  => wrk_2d_36 
     921      USE wrk_nemo, ONLY: stabit => wrk_2d_37 
    917922      ! 
    918923      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta 
     
    921926      !------------------------------------------------------------------------------- 
    922927 
    923       IF( wrk_in_use(2, 33,34,35) ) THEN 
     928      IF( wrk_in_use(2, 35,36,37) ) THEN 
    924929         CALL ctl_stop('psi_h: requested workspace arrays unavailable')   ;   RETURN 
    925930      ENDIF 
     
    930935         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
    931936 
    932       IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_h: failed to release workspace arrays') 
     937      IF( wrk_not_released(2, 35,36,37) )   CALL ctl_stop('psi_h: failed to release workspace arrays') 
    933938      ! 
    934939    END FUNCTION psi_h 
Note: See TracChangeset for help on using the changeset viewer.