Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r2528 r2715 52 52 INTEGER , PARAMETER :: jp_tair = 6 ! index of 10m air temperature (Kelvin) 53 53 INTEGER , PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) 54 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 54 55 TYPE(FLD),ALLOCATABLE,DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 55 56 56 57 INTEGER, PARAMETER :: jpintsr = 24 ! number of time step between sunrise and sunset … … 73 74 & 6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 / 74 75 !! 75 REAL(wp), DIMENSION(jpi,jpj) :: sbudyko ! cloudiness effect on LW radiation76 REAL(wp), DIMENSION(jpi,jpj) :: stauc ! cloud optical depth76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sbudyko ! cloudiness effect on LW radiation 77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: stauc ! cloud optical depth 77 78 78 REAL(wp) :: zeps = 1.e-20 ! constant values 79 REAL(wp) :: zeps0 = 1.e-13 79 REAL(wp) :: eps20 = 1.e-20 ! constant values 80 80 81 81 !! * Substitutions 82 82 # include "vectopt_loop_substitute.h90" 83 83 !!---------------------------------------------------------------------- 84 !! NEMO/OPA 3.3 , NEMO Consortium (2010)84 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 85 85 !! $Id$ 86 86 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 116 116 !! - emp, emps evaporation minus precipitation 117 117 !!---------------------------------------------------------------------- 118 INTEGER, INTENT( in) :: kt ! ocean time step119 !! 120 INTEGER :: ifpr, jfpr 121 INTEGER :: ierr or! return error code118 INTEGER, INTENT(in) :: kt ! ocean time step 119 !! 120 INTEGER :: ifpr, jfpr ! dummy indices 121 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! return error code 122 122 !! 123 123 CHARACTER(len=100) :: cn_dir ! Root directory for location of CLIO files … … 156 156 157 157 ! set sf structure 158 ALLOCATE( sf(jpfld), STAT=ierror ) 159 IF( ierror > 0 ) THEN 160 CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' ) ; RETURN 161 ENDIF 158 ALLOCATE( sf(jpfld), STAT=ierr0 ) 159 IF( ierr0 > 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate sf structure' ) 162 160 DO ifpr= 1, jpfld 163 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 164 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 165 END DO 161 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) , STAT=ierr1) 162 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr2 ) 163 END DO 164 IF( ierr1+ierr2 > 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate sf array structure' ) 166 165 ! fill sf with slf_i and control print 167 166 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' ) 167 168 ! allocate sbcblk clio arrays 169 ALLOCATE( sbudyko(jpi,jpj) , stauc(jpi,jpj), STAT=ierr3 ) 170 IF( ierr3 > 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate arrays' ) 168 171 ! 169 172 ENDIF … … 208 211 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC 209 212 !!---------------------------------------------------------------------- 213 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 214 USE wrk_nemo, ONLY: zqlw => wrk_2d_1 ! long-wave heat flux over ocean 215 USE wrk_nemo, ONLY: zqla => wrk_2d_2 ! latent heat flux over ocean 216 USE wrk_nemo, ONLY: zqsb => wrk_2d_3 ! sensible heat flux over ocean 217 !! 210 218 TYPE(fld), INTENT(in), DIMENSION(:) :: sf ! input data 211 219 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pst ! surface temperature [Celcius] … … 223 231 REAL(wp) :: zrhoa, zev, zes, zeso, zqatm, zevsqr ! - - 224 232 REAL(wp) :: ztx2, zty2 ! - - 225 !!226 REAL(wp), DIMENSION(jpi,jpj) :: zqlw ! long-wave heat flux over ocean227 REAL(wp), DIMENSION(jpi,jpj) :: zqla ! latent heat flux over ocean228 REAL(wp), DIMENSION(jpi,jpj) :: zqsb ! sensible heat flux over ocean229 233 !!--------------------------------------------------------------------- 230 234 231 zpatm = 101000. ! atmospheric pressure (assumed constant here) 235 IF( wrk_in_use(3, 1,2,3) ) THEN 236 CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable') ; RETURN 237 ENDIF 238 239 zpatm = 101000._wp ! atmospheric pressure (assumed constant here) 232 240 233 241 !------------------------------------! … … 309 317 zdeltaq = zqatm - zqsato 310 318 ztvmoy = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm ) 311 zdenum = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps)319 zdenum = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, eps20 ) 312 320 zdtetar = zdteta / zdenum 313 321 ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum … … 331 339 zpsil = zpsih 332 340 333 zvatmg = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps)341 zvatmg = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, eps20 ) 334 342 zcmn = vkarmn / LOG ( 10. / zvatmg ) 335 343 zchn = 0.0327 * zcmn … … 378 386 ENDIF 379 387 388 IF( wrk_not_released(3, 1,2,3) ) CALL ctl_stop('blk_oce_clio: failed to release workspace arrays') 389 ! 380 390 END SUBROUTINE blk_oce_clio 381 391 … … 408 418 !! 409 419 !!---------------------------------------------------------------------- 420 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 421 USE wrk_nemo, ONLY: ztatm => wrk_2d_1 ! Tair in Kelvin 422 USE wrk_nemo, ONLY: zqatm => wrk_2d_2 ! specific humidity 423 USE wrk_nemo, ONLY: zevsqr => wrk_2d_3 ! vapour pressure square-root 424 USE wrk_nemo, ONLY: zrhoa => wrk_2d_4 ! air density 425 USE wrk_nemo, ONLY: wrk_3d_1 , wrk_3d_2 426 !! 410 427 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 411 428 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [%] … … 435 452 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 436 453 !! 437 REAL(wp), DIMENSION(jpi,jpj) :: ztatm ! Tair in Kelvin 438 REAL(wp), DIMENSION(jpi,jpj) :: zqatm ! specific humidity 439 REAL(wp), DIMENSION(jpi,jpj) :: zevsqr ! vapour pressure square-root 440 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa ! air density 441 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_qlw, z_qsb 454 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 442 455 !!--------------------------------------------------------------------- 456 457 IF( wrk_in_use(2, 1,2,3,4) .OR. wrk_in_use(3, 1,2) ) THEN 458 CALL ctl_stop('blk_ice_clio: requested workspace arrays are unavailable') ; RETURN 459 ELSE IF(pdim > jpk)THEN 460 CALL ctl_stop('blk_ice_clio: too many ice levels to use wrk_nemo 3D workspaces.') 461 RETURN 462 END IF 463 z_qlw => wrk_3d_1(:,:,1:pdim) 464 z_qsb => wrk_3d_2(:,:,1:pdim) 443 465 444 466 ijpl = pdim ! number of ice categories … … 612 634 ENDIF 613 635 614 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') 638 ! 615 639 END SUBROUTINE blk_ice_clio 616 640 … … 626 650 !! - also initialise sbudyko and stauc once for all 627 651 !!---------------------------------------------------------------------- 652 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 653 USE wrk_nemo, ONLY: zev => wrk_2d_1 ! vapour pressure 654 USE wrk_nemo, ONLY: zdlha => wrk_2d_2 , zlsrise => wrk_2d_3 , zlsset => wrk_2d_4 655 USE wrk_nemo, ONLY: zps => wrk_2d_5 , zpc => wrk_2d_6 ! sin/cos of latitude per sin/cos of solar declination 656 !! 628 657 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: pqsr_oce ! shortwave radiation over the ocean 629 658 !! … … 644 673 REAL(wp) :: zxday, zdist, zcoef, zcoef1 ! 645 674 REAL(wp) :: zes 646 !!647 REAL(wp), DIMENSION(jpi,jpj) :: zev ! vapour pressure648 REAL(wp), DIMENSION(jpi,jpj) :: zdlha, zlsrise, zlsset ! 2D workspace649 650 REAL(wp), DIMENSION(jpi,jpj) :: zps, zpc ! sine (cosine) of latitude per sine (cosine) of solar declination651 675 !!--------------------------------------------------------------------- 652 676 677 IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 678 CALL ctl_stop('blk_clio_qsr_oce: requested workspace arrays unavailable') ; RETURN 679 END IF 653 680 654 681 IF( lbulk_init ) THEN ! Initilization at first time step only … … 764 791 END DO 765 792 793 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_stop('blk_clio_qsr_oce: failed to release workspace arrays') 794 ! 766 795 END SUBROUTINE blk_clio_qsr_oce 767 796 … … 777 806 !! - also initialise sbudyko and stauc once for all 778 807 !!---------------------------------------------------------------------- 808 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 809 USE wrk_nemo, ONLY: zev => wrk_2d_1 ! vapour pressure 810 USE wrk_nemo, ONLY: zdlha => wrk_2d_2 ! 2D workspace 811 USE wrk_nemo, ONLY: zlsrise => wrk_2d_3 ! 2D workspace 812 USE wrk_nemo, ONLY: zlsset => wrk_2d_4 ! 2D workspace 813 USE wrk_nemo, ONLY: zps => wrk_2d_5 , zpc => wrk_2d_6 ! sin/cos of latitude per sin/cos of solar declination 814 !! 779 815 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pa_ice_cs ! albedo of ice under clear sky 780 816 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pa_ice_os ! albedo of ice under overcast sky … … 794 830 REAL(wp) :: zxday, zdist, zcoef, zcoef1 ! - - 795 831 REAL(wp) :: zqsr_ice_cs, zqsr_ice_os ! - - 796 !!797 REAL(wp), DIMENSION(jpi,jpj) :: zev ! vapour pressure798 REAL(wp), DIMENSION(jpi,jpj) :: zdlha, zlsrise, zlsset ! 2D workspace799 REAL(wp), DIMENSION(jpi,jpj) :: zps, zpc ! sine (cosine) of latitude per sine (cosine) of solar declination800 832 !!--------------------------------------------------------------------- 833 834 IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 835 CALL ctl_stop('blk_clio_qsr_ice: requested workspace arrays unavailable') ; RETURN 836 ENDIF 801 837 802 838 ijpl = SIZE(pqsr_ice, 3 ) ! number of ice categories … … 901 937 END DO 902 938 ! 939 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays') 940 ! 903 941 END SUBROUTINE blk_clio_qsr_ice 904 942
Note: See TracChangeset
for help on using the changeset viewer.
