- Timestamp:
- 2011-03-01T20:04:06+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r2633 r2636 11 11 !! - Implement reading of 6-hourly fields 12 12 !! 3.0 ! 2006-06 (G. Madec) sbc rewritting 13 !! - ! 2006-12 (L. Brodeau) Original code for TURB_CORE_2Z 13 14 !! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put 14 15 !! 3.3 ! 2010-10 (S. Masson) add diurnal cycle … … 208 209 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC 209 210 !!--------------------------------------------------------------------- 210 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 211 USE wrk_nemo, ONLY: zwnd_i => wrk_2d_1, zwnd_j => wrk_2d_2 ! wind speed components at T-point 212 USE wrk_nemo, ONLY: zqsatw => wrk_2d_3 ! specific humidity at pst 213 USE wrk_nemo, ONLY: zqlw => wrk_2d_4, zqsb => wrk_2d_5 ! long wave and sensible heat fluxes 214 USE wrk_nemo, ONLY: zqla => wrk_2d_6, zevap => wrk_2d_7 ! latent heat fluxes and evaporation 215 USE wrk_nemo, ONLY: Cd => wrk_2d_8 ! transfer coefficient for momentum (tau) 216 USE wrk_nemo, ONLY: Ch => wrk_2d_9 ! transfer coefficient for sensible heat (Q_sens) 217 USE wrk_nemo, ONLY: Ce => wrk_2d_10 ! transfer coefficient for evaporation (Q_lat) 218 USE wrk_nemo, ONLY: zst => wrk_2d_11 ! surface temperature in Kelvin 219 USE wrk_nemo, ONLY: zt_zu => wrk_2d_12 ! air temperature at wind speed height 220 USE wrk_nemo, ONLY: zq_zu => wrk_2d_13 ! air spec. hum. at wind speed height 221 !! 222 TYPE(fld), INTENT(in), DIMENSION(:) :: sf ! input data 223 REAL(wp), INTENT(in), DIMENSION(:,:) :: pst ! surface temperature [Celcius] 224 REAL(wp), INTENT(in), DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s] 225 REAL(wp), INTENT(in), DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s] 226 227 INTEGER :: ji, jj ! dummy loop indices 228 REAL(wp) :: zcoef_qsatw 229 REAL(wp) :: zztmp ! temporary variable 211 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 212 USE wrk_nemo, ONLY: zwnd_i => wrk_2d_1 , zwnd_j => wrk_2d_2 ! wind speed components at T-point 213 USE wrk_nemo, ONLY: zqsatw => wrk_2d_3 ! specific humidity at pst 214 USE wrk_nemo, ONLY: zqlw => wrk_2d_4 , zqsb => wrk_2d_5 ! long wave and sensible heat fluxes 215 USE wrk_nemo, ONLY: zqla => wrk_2d_6 , zevap => wrk_2d_7 ! latent heat fluxes and evaporation 216 USE wrk_nemo, ONLY: Cd => wrk_2d_8 ! transfer coefficient for momentum (tau) 217 USE wrk_nemo, ONLY: Ch => wrk_2d_9 ! transfer coefficient for sensible heat (Q_sens) 218 USE wrk_nemo, ONLY: Ce => wrk_2d_10 ! transfer coefficient for evaporation (Q_lat) 219 USE wrk_nemo, ONLY: zst => wrk_2d_11 ! surface temperature in Kelvin 220 USE wrk_nemo, ONLY: zt_zu => wrk_2d_12 ! air temperature at wind speed height 221 USE wrk_nemo, ONLY: zq_zu => wrk_2d_13 ! air spec. hum. at wind speed height 222 ! 223 TYPE(fld), INTENT(in), DIMENSION(:) :: sf ! input data 224 REAL(wp) , INTENT(in), DIMENSION(:,:) :: pst ! surface temperature [Celcius] 225 REAL(wp) , INTENT(in), DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s] 226 REAL(wp) , INTENT(in), DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s] 227 ! 228 INTEGER :: ji, jj ! dummy loop indices 229 REAL(wp) :: zcoef_qsatw, zztmp ! local variable 230 230 !!--------------------------------------------------------------------- 231 231 232 IF(wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13))THEN 233 CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable.') 234 RETURN 235 END IF 232 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) ) THEN 233 CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable.') ; RETURN 234 ENDIF 236 235 ! 237 236 ! local scalars ( place there for vector optimisation purposes) … … 383 382 ENDIF 384 383 ! 385 IF(wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13))THEN 386 CALL ctl_stop('blk_oce_core: failed to release workspace arrays.') 387 END IF 384 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) ) & 385 CALL ctl_stop('blk_oce_core: failed to release workspace arrays') 388 386 ! 389 387 END SUBROUTINE blk_oce_core … … 407 405 !! caution : the net upward water flux has with mm/day unit 408 406 !!--------------------------------------------------------------------- 409 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released410 USE wrk_nemo, ONLY: z_wnds_t => wrk_2d_1 ! wind speed ( = | U10m - U_ice | ) at T-point411 USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5, wrk_3d_6, wrk_3d_7412 !! 413 REAL(wp), DIMENSION(:,:,:) 414 REAL(wp), DIMENSION(:,:) 415 REAL(wp), DIMENSION(:,:) 416 REAL(wp), DIMENSION(:,:,:) 417 REAL(wp), DIMENSION(:,:) 418 REAL(wp), DIMENSION(:,:) 419 REAL(wp), DIMENSION(:,:,:) 420 REAL(wp), DIMENSION(:,:,:) 421 REAL(wp), DIMENSION(:,:,:) 422 REAL(wp), DIMENSION(:,:,:) 423 REAL(wp), DIMENSION(:,:,:) 424 REAL(wp), DIMENSION(:,:) 425 REAL(wp), DIMENSION(:,:) ,INTENT( out) :: p_spr ! solid precipitation (T-point) [Kg/m2/s]426 REAL(wp), DIMENSION(:,:) ,INTENT( out) :: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%]427 REAL(wp), DIMENSION(:,:) ,INTENT( out) :: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%]428 CHARACTER(len=1) 429 INTEGER 407 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 408 USE wrk_nemo, ONLY: z_wnds_t => wrk_2d_1 ! wind speed ( = | U10m - U_ice | ) at T-point 409 USE wrk_nemo, ONLY: wrk_3d_4 , wrk_3d_5 , wrk_3d_6 , wrk_3d_7 410 !! 411 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pst ! ice surface temperature (>0, =rt0 over land) [Kelvin] 412 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pui ! ice surface velocity (i- and i- components [m/s] 413 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvi ! at I-point (B-grid) or U & V-point (C-grid) 414 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%] 415 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_taui ! i- & j-components of surface ice stress [N/m2] 416 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 417 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 418 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 419 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 420 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 421 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 422 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 423 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 424 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%] 425 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%] 426 CHARACTER(len=1) , INTENT(in ) :: cd_grid ! ice grid ( C or B-grid) 427 INTEGER , INTENT(in ) :: pdim ! number of ice categories 430 428 !! 431 429 INTEGER :: ji, jj, jl ! dummy loop indices … … 447 445 448 446 ! Set-up access to workspace arrays 449 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 4,5,6,7) )THEN 450 CALL ctl_stop('blk_ice_core: requested workspace arrays unavailable.') 451 RETURN 452 ELSE IF(ijpl > jpk)THEN 447 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 4,5,6,7) ) THEN 448 CALL ctl_stop('blk_ice_core: requested workspace arrays unavailable') ; RETURN 449 ELSE IF(ijpl > jpk) THEN 453 450 CALL ctl_stop('blk_ice_core: no. of ice categories > jpk so wrk_nemo 3D workspaces cannot be used.') 454 451 RETURN … … 608 605 ENDIF 609 606 610 IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 4,5,6,7) )THEN 611 CALL ctl_stop('blk_ice_core: failed to release workspace arrays.') 612 END IF 613 607 IF( wrk_not_released(2, 1) .OR. & 608 wrk_not_released(3, 4,5,6,7) ) CALL ctl_stop('blk_ice_core: failed to release workspace arrays') 609 ! 614 610 END SUBROUTINE blk_ice_core 615 611 616 612 617 613 SUBROUTINE TURB_CORE_1Z(zu, sst, T_a, q_sat, q_a, & 618 & dU , Cd, Ch, Ce )614 & dU , Cd , Ch , Ce ) 619 615 !!---------------------------------------------------------------------- 620 616 !! *** ROUTINE turb_core *** … … 629 625 !! are provided at the same height 'zzu'! 630 626 !! 631 !! References : 632 !! Large & Yeager, 2004 : ??? 633 !! History : 634 !! ! XX-XX (??? ) Original code 635 !! 9.0 ! 05-08 (L. Brodeau) Rewriting and optimization 627 !! References : Large & Yeager, 2004 : ??? 636 628 !!---------------------------------------------------------------------- 637 629 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released … … 651 643 USE wrk_nemo, ONLY: zeta => wrk_2d_27 ! stability parameter at height zu 652 644 USE wrk_nemo, ONLY: U_n10 => wrk_2d_28 ! neutral wind velocity at 10m [m] 653 USE wrk_nemo, ONLY: xlogt => wrk_2d_29, xct => wrk_2d_30, &654 zpsi_h => wrk_2d_31, zpsi_m => wrk_2d_32645 USE wrk_nemo, ONLY: xlogt => wrk_2d_29, xct => wrk_2d_30, & 646 zpsi_h => wrk_2d_31, zpsi_m => wrk_2d_32 655 647 USE wrk_nemo, ONLY: stab => iwrk_2d_1 ! 1st guess stability test integer 656 !! 657 REAL(wp), INTENT(in) :: zu ! altitude of wind measurement [m] 658 REAL(wp), INTENT(in), DIMENSION(:,:) :: & 659 sst, & ! sea surface temperature [Kelvin] 660 T_a, & ! potential air temperature [Kelvin] 661 q_sat, & ! sea surface specific humidity [kg/kg] 662 q_a, & ! specific air humidity [kg/kg] 663 dU ! wind module |U(zu)-U(0)| [m/s] 664 REAL(wp), intent(out), DIMENSION(:,:) :: & 665 Cd, & ! transfert coefficient for momentum (tau) 666 Ch, & ! transfert coefficient for temperature (Q_sens) 667 Ce ! transfert coefficient for evaporation (Q_lat) 648 ! 649 REAL(wp) , INTENT(in ) :: zu ! altitude of wind measurement [m] 650 REAL(wp), DIMENSION(:,:), INTENT(in ) :: sst ! sea surface temperature [Kelvin] 651 REAL(wp), DIMENSION(:,:), INTENT(in ) :: T_a ! potential air temperature [Kelvin] 652 REAL(wp), DIMENSION(:,:), INTENT(in ) :: q_sat ! sea surface specific humidity [kg/kg] 653 REAL(wp), DIMENSION(:,:), INTENT(in ) :: q_a ! specific air humidity [kg/kg] 654 REAL(wp), DIMENSION(:,:), INTENT(in ) :: dU ! wind module |U(zu)-U(0)| [m/s] 655 REAL(wp), DIMENSION(:,:), INTENT( out) :: Cd ! transfert coefficient for momentum (tau) 656 REAL(wp), DIMENSION(:,:), INTENT( out) :: Ch ! transfert coefficient for temperature (Q_sens) 657 REAL(wp), DIMENSION(:,:), INTENT( out) :: Ce ! transfert coefficient for evaporation (Q_lat) 668 658 !! 669 659 INTEGER :: j_itt 670 INTEGER, PARAMETER :: nb_itt = 3 671 672 REAL(wp), PARAMETER :: & 673 grav = 9.8, & ! gravity 674 kappa = 0.4 ! von Karman s constant 660 INTEGER , PARAMETER :: nb_itt = 3 661 REAL(wp), PARAMETER :: grav = 9.8 ! gravity 662 REAL(wp), PARAMETER :: kappa = 0.4 ! von Karman s constant 675 663 !!---------------------------------------------------------------------- 676 664 677 IF( wrk_in_use(2, 14,15,16,17,18, & 678 19,20,21,22,23,24, & 679 25,26,27,28,29,30, & 680 31,32) .OR. & 681 iwrk_in_use(2, 1) )THEN 682 CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable.') 683 RETURN 684 END IF 665 IF( wrk_in_use(2, 14,15,16,17,18,19, & 666 20,21,22,23,24,25,26,27,28,29, & 667 30,31,32) .OR. & 668 iwrk_in_use(2, 1) ) THEN 669 CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable') ; RETURN 670 ENDIF 685 671 686 672 !! * Start … … 743 729 END DO 744 730 !! 745 IF( wrk_not_released(2, 14,15,16,17,18, & 746 19,20,21,22,23,24, & 747 25,26,27,28,29,30, & 748 31,32) .OR. & 749 iwrk_not_released(2, 1) )THEN 750 CALL ctl_stop('TURB_CORE_1Z: failed to release workspace arrays.') 751 END IF 752 !! 731 IF( wrk_not_released(2, 14,15,16,17,18,19, & 732 & 20,21,22,23,24,25,26,27,28,29, & 733 & 30,31,32 ) .OR. & 734 iwrk_not_released(2, 1) ) & 735 CALL ctl_stop('TURB_CORE_1Z: failed to release workspace arrays') 736 ! 753 737 END SUBROUTINE TURB_CORE_1Z 754 738 … … 767 751 !! whereas wind (dU) is at 10m. 768 752 !! 769 !! References : 770 !! Large & Yeager, 2004 : ??? 771 !! History : 772 !! 9.0 ! 06-12 (L. Brodeau) Original code for 2Z 753 !! References : Large & Yeager, 2004 : ??? 773 754 !!---------------------------------------------------------------------- 774 755 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released … … 899 880 CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.') 900 881 END IF 901 882 ! 902 883 END SUBROUTINE TURB_CORE_2Z 903 884 … … 926 907 & + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2) ! Unstable 927 908 928 IF( wrk_not_released(2, 33,34,35))THEN909 IF( wrk_not_released(2, 33,34,35) ) THEN 929 910 CALL ctl_stop('psi_m: failed to release workspace arrays.') 930 911 RETURN … … 946 927 !------------------------------------------------------------------------------- 947 928 948 IF(wrk_in_use(2, 33,34,35))THEN 949 CALL ctl_stop('psi_h: requested workspace arrays unavailable.') 950 RETURN 951 END IF 929 IF( wrk_in_use(2, 33,34,35) ) THEN 930 CALL ctl_stop('psi_h: requested workspace arrays unavailable') ; RETURN 931 ENDIF 952 932 953 933 X2 = sqrt(abs(1. - 16.*zta)) ; X2 = max(X2 , 1.) ; X = sqrt(X2) … … 956 936 & + (1. - stabit)*(2.*log( (1. + X2)/2. )) ! Unstable 957 937 958 IF(wrk_not_released(2, 33,34,35))THEN 959 CALL ctl_stop('psi_h: failed to release workspace arrays.') 960 RETURN 961 END IF 962 938 IF( wrk_not_released(2, 33,34,35) ) CALL ctl_stop('psi_h: failed to release workspace arrays.') 939 ! 963 940 END FUNCTION psi_h 964 941
Note: See TracChangeset
for help on using the changeset viewer.
