Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r2777 r3294 27 27 USE in_out_manager ! I/O manager 28 28 USE lib_mpp ! distribued memory computing library 29 USE wrk_nemo ! work arrays 30 USE timing ! Timing 29 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 32 … … 207 209 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC 208 210 !!---------------------------------------------------------------------- 209 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released210 USE wrk_nemo, ONLY: zqlw => wrk_2d_1 ! long-wave heat flux over ocean211 USE wrk_nemo, ONLY: zqla => wrk_2d_2 ! latent heat flux over ocean212 USE wrk_nemo, ONLY: zqsb => wrk_2d_3 ! sensible heat flux over ocean213 !!214 211 TYPE(fld), INTENT(in), DIMENSION(:) :: sf ! input data 215 212 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pst ! surface temperature [Celcius] … … 227 224 REAL(wp) :: zrhoa, zev, zes, zeso, zqatm, zevsqr ! - - 228 225 REAL(wp) :: ztx2, zty2 ! - - 226 REAL(wp), POINTER, DIMENSION(:,:) :: zqlw ! long-wave heat flux over ocean 227 REAL(wp), POINTER, DIMENSION(:,:) :: zqla ! latent heat flux over ocean 228 REAL(wp), POINTER, DIMENSION(:,:) :: zqsb ! sensible heat flux over ocean 229 229 !!--------------------------------------------------------------------- 230 231 IF( wrk_in_use(3, 1,2,3) ) THEN232 CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable') ; RETURN233 ENDIF230 ! 231 IF( nn_timing == 1 ) CALL timing_start('blk_oce_clio') 232 ! 233 CALL wrk_alloc( jpi,jpj, zqlw, zqla, zqsb ) 234 234 235 235 zpatm = 101000._wp ! atmospheric pressure (assumed constant here) … … 382 382 ENDIF 383 383 384 IF( wrk_not_released(3, 1,2,3) ) CALL ctl_stop('blk_oce_clio: failed to release workspace arrays') 384 CALL wrk_dealloc( jpi,jpj, zqlw, zqla, zqsb ) 385 ! 386 IF( nn_timing == 1 ) CALL timing_stop('blk_oce_clio') 385 387 ! 386 388 END SUBROUTINE blk_oce_clio … … 414 416 !! 415 417 !!---------------------------------------------------------------------- 416 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released417 USE wrk_nemo, ONLY: ztatm => wrk_2d_1 ! Tair in Kelvin418 USE wrk_nemo, ONLY: zqatm => wrk_2d_2 ! specific humidity419 USE wrk_nemo, ONLY: zevsqr => wrk_2d_3 ! vapour pressure square-root420 USE wrk_nemo, ONLY: zrhoa => wrk_2d_4 ! air density421 USE wrk_nemo, ONLY: wrk_3d_1 , wrk_3d_2422 !!423 418 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 424 419 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [%] … … 448 443 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 449 444 !! 445 REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin 446 REAL(wp), DIMENSION(:,:) , POINTER :: zqatm ! specific humidity 447 REAL(wp), DIMENSION(:,:) , POINTER :: zevsqr ! vapour pressure square-root 448 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density 450 449 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 451 450 !!--------------------------------------------------------------------- 452 453 IF( wrk_in_use(2, 1,2,3,4) .OR. wrk_in_use(3, 1,2) ) THEN 454 CALL ctl_stop('blk_ice_clio: requested workspace arrays are unavailable') ; RETURN 455 ELSE IF(pdim > jpk)THEN 456 CALL ctl_stop('blk_ice_clio: too many ice levels to use wrk_nemo 3D workspaces.') 457 RETURN 458 END IF 459 z_qlw => wrk_3d_1(:,:,1:pdim) 460 z_qsb => wrk_3d_2(:,:,1:pdim) 451 ! 452 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio') 453 ! 454 CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 455 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 461 456 462 457 ijpl = pdim ! number of ice categories … … 634 629 ENDIF 635 630 636 IF( wrk_not_released(2, 1,2,3,4) .OR. & 637 wrk_not_released(3, 1,2) ) CALL ctl_stop('blk_ice_clio: failed to release workspace arrays') 631 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 632 CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 633 ! 634 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio') 638 635 ! 639 636 END SUBROUTINE blk_ice_clio … … 650 647 !! - also initialise sbudyko and stauc once for all 651 648 !!---------------------------------------------------------------------- 652 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released653 USE wrk_nemo, ONLY: zev => wrk_2d_1 ! vapour pressure654 USE wrk_nemo, ONLY: zdlha => wrk_2d_2 , zlsrise => wrk_2d_3 , zlsset => wrk_2d_4655 USE wrk_nemo, ONLY: zps => wrk_2d_5 , zpc => wrk_2d_6 ! sin/cos of latitude per sin/cos of solar declination656 !!657 649 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: pqsr_oce ! shortwave radiation over the ocean 658 650 !! … … 673 665 REAL(wp) :: zxday, zdist, zcoef, zcoef1 ! 674 666 REAL(wp) :: zes 667 668 REAL(wp), DIMENSION(:,:), POINTER :: zev ! vapour pressure 669 REAL(wp), DIMENSION(:,:), POINTER :: zdlha, zlsrise, zlsset ! 2D workspace 670 REAL(wp), DIMENSION(:,:), POINTER :: zps, zpc ! sine (cosine) of latitude per sine (cosine) of solar declination 675 671 !!--------------------------------------------------------------------- 676 677 IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN678 CALL ctl_stop('blk_clio_qsr_oce: requested workspace arrays unavailable') ; RETURN679 END IF672 ! 673 IF( nn_timing == 1 ) CALL timing_start('blk_clio_qsr_oce') 674 ! 675 CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 680 676 681 677 IF( lbulk_init ) THEN ! Initilization at first time step only … … 791 787 END DO 792 788 793 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_stop('blk_clio_qsr_oce: failed to release workspace arrays') 789 CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 790 ! 791 IF( nn_timing == 1 ) CALL timing_stop('blk_clio_qsr_oce') 794 792 ! 795 793 END SUBROUTINE blk_clio_qsr_oce … … 806 804 !! - also initialise sbudyko and stauc once for all 807 805 !!---------------------------------------------------------------------- 808 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released809 USE wrk_nemo, ONLY: zev => wrk_2d_1 ! vapour pressure810 USE wrk_nemo, ONLY: zdlha => wrk_2d_2 ! 2D workspace811 USE wrk_nemo, ONLY: zlsrise => wrk_2d_3 ! 2D workspace812 USE wrk_nemo, ONLY: zlsset => wrk_2d_4 ! 2D workspace813 USE wrk_nemo, ONLY: zps => wrk_2d_5 , zpc => wrk_2d_6 ! sin/cos of latitude per sin/cos of solar declination814 !!815 806 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pa_ice_cs ! albedo of ice under clear sky 816 807 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pa_ice_os ! albedo of ice under overcast sky … … 830 821 REAL(wp) :: zxday, zdist, zcoef, zcoef1 ! - - 831 822 REAL(wp) :: zqsr_ice_cs, zqsr_ice_os ! - - 823 824 REAL(wp), DIMENSION(:,:), POINTER :: zev ! vapour pressure 825 REAL(wp), DIMENSION(:,:), POINTER :: zdlha, zlsrise, zlsset ! 2D workspace 826 REAL(wp), DIMENSION(:,:), POINTER :: zps, zpc ! sine (cosine) of latitude per sine (cosine) of solar declination 832 827 !!--------------------------------------------------------------------- 833 834 IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN835 CALL ctl_stop('blk_clio_qsr_ice: requested workspace arrays unavailable') ; RETURN836 ENDIF828 ! 829 IF( nn_timing == 1 ) CALL timing_start('blk_clio_qsr_ice') 830 ! 831 CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 837 832 838 833 ijpl = SIZE(pqsr_ice, 3 ) ! number of ice categories … … 937 932 END DO 938 933 ! 939 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays') 934 CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 935 ! 936 IF( nn_timing == 1 ) CALL timing_stop('blk_clio_qsr_ice') 940 937 ! 941 938 END SUBROUTINE blk_clio_qsr_ice
Note: See TracChangeset
for help on using the changeset viewer.
