Changeset 2636 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC
- Timestamp:
- 2011-03-01T20:04:06+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r2633 r2636 18 18 USE phycst ! physical constants 19 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! MPP library 20 21 21 22 IMPLICIT NONE … … 64 65 !! References : Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 65 66 !!---------------------------------------------------------------------- 66 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, llwrk_in_use, llwrk_not_released67 USE wrk_nemo, ONLY: wrk_3d_6, wrk_3d_7 ! 3D workspace67 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, llwrk_in_use, llwrk_not_released 68 USE wrk_nemo, ONLY: wrk_3d_6, wrk_3d_7 ! 3D workspace 68 69 !! 69 70 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pt_ice ! ice surface temperature (Kelvin) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90
r2633 r2636 20 20 !! cpl_prism_init : initialization of coupled mode communication 21 21 !! cpl_prism_define : definition of grid and fields 22 !! cpl_prism_snd : snd out fields in coupled mode23 !! cpl_prism_rcv : receive fields in coupled mode24 !! cpl_prism_update_time 22 !! cpl_prism_snd : snd out fields in coupled mode 23 !! cpl_prism_rcv : receive fields in coupled mode 24 !! cpl_prism_update_time : update date sent to Oasis 25 25 !! cpl_prism_finalize : finalize the coupled mode communication 26 26 !!---------------------------------------------------------------------- 27 USE prism ! OASIS4 prism module 28 USE par_oce ! ocean parameters 29 USE dom_oce ! ocean space and time domain 30 USE domwri ! ocean space and time domain 31 USE in_out_manager ! I/O manager 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE prism ! OASIS4 prism module 28 USE par_oce ! ocean parameters 29 USE dom_oce ! ocean space and time domain 30 USE domwri ! ocean space and time domain 31 USE in_out_manager ! I/O manager 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE lib_mpp ! MPP library 33 34 34 35 IMPLICIT NONE -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2633 r2636 15 15 USE oce ! ocean dynamics and tracers 16 16 USE dom_oce ! ocean space and time domain 17 USE ioipsl, ONLY : ymds2ju, ju2ymds ! for calendar18 17 USE phycst ! ??? 19 18 USE in_out_manager ! I/O manager 20 19 USE iom ! I/O manager library 21 20 USE geo2ocean ! for vector rotation on to model grid 21 USE lib_mpp ! MPP library 22 USE ioipsl, ONLY : ymds2ju, ju2ymds ! for calendar 22 23 23 24 IMPLICIT NONE … … 391 392 CALL fld_clopn( sdjf, iyear, imonth, iday ) 392 393 ENDIF 393 394 ! 394 395 END SUBROUTINE fld_init 395 396 … … 804 805 !! file, restructuring as required 805 806 !!---------------------------------------------------------------------- 806 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released807 USE wrk_nemo, ONLY: data_tmp => wrk_2d_1808 USE wrk_nemo, ONLY: data_src => iwrk_2d_1807 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 808 USE wrk_nemo, ONLY: data_tmp => wrk_2d_1 ! 2D real workspace 809 USE wrk_nemo, ONLY: data_src => iwrk_2d_1 ! 2D integer workspace 809 810 !! 810 811 TYPE( FLD ), INTENT(in) :: sd ! field with name of weights file … … 822 823 IF( wrk_in_use(2, 1) .OR. iwrk_in_use(2,1) ) THEN 823 824 CALL ctl_stop('fld_weights: requested workspace arrays are unavailable.') ; RETURN 824 END 825 ENDIF 825 826 ! 826 827 IF( nxt_wgt > tot_wgts ) THEN … … 934 935 ENDIF 935 936 936 IF( wrk_not_released(2, 1) .OR. &937 IF( wrk_not_released(2, 1) .OR. & 937 938 iwrk_not_released(2, 1) ) CALL ctl_stop('fld_weights: failed to release workspace arrays') 938 939 ! -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r2631 r2636 46 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 47 47 !! $Id$ 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 51 50 CONTAINS 52 51 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r2620 r2636 20 20 USE lib_fortran ! distribued memory computing library 21 21 USE iom ! IOM library 22 USE lib_mpp ! MPP library 22 23 USE restart ! ocean restart 23 24 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r2633 r2636 232 232 !!--------------------------------------------------------------------- 233 233 234 IF(wrk_in_use(3, 1,2,3))THEN 235 CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable.') 236 RETURN 237 END IF 234 IF( wrk_in_use(3, 1,2,3) ) THEN 235 CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable') ; RETURN 236 ENDIF 238 237 239 238 zpatm = 101000. ! atmospheric pressure (assumed constant here) … … 386 385 ENDIF 387 386 388 IF(wrk_not_released(3, 1,2,3))THEN 389 CALL ctl_stop('blk_oce_clio: failed to release workspace arrays.') 390 END IF 391 387 IF( wrk_not_released(3, 1,2,3) ) CALL ctl_stop('blk_oce_clio: failed to release workspace arrays') 388 ! 392 389 END SUBROUTINE blk_oce_clio 393 390 … … 420 417 !! 421 418 !!---------------------------------------------------------------------- 422 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released423 USE wrk_nemo, ONLY: ztatm=> wrk_2d_1 ! Tair in Kelvin424 USE wrk_nemo, ONLY: zqatm=> wrk_2d_2 ! specific humidity425 USE wrk_nemo, ONLY: zevsqr => wrk_2d_3 ! vapour pressure square-root426 USE wrk_nemo, ONLY: zrhoa=> wrk_2d_4 ! air density427 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2419 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 420 USE wrk_nemo, ONLY: ztatm => wrk_2d_1 ! Tair in Kelvin 421 USE wrk_nemo, ONLY: zqatm => wrk_2d_2 ! specific humidity 422 USE wrk_nemo, ONLY: zevsqr => wrk_2d_3 ! vapour pressure square-root 423 USE wrk_nemo, ONLY: zrhoa => wrk_2d_4 ! air density 424 USE wrk_nemo, ONLY: wrk_3d_1 , wrk_3d_2 428 425 !! 429 426 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] … … 457 454 !!--------------------------------------------------------------------- 458 455 459 IF( (wrk_in_use(2, 1,2,3,4)) .OR. (wrk_in_use(3, 1,2)) )THEN 460 CALL ctl_stop('blk_ice_clio: requested workspace arrays are unavailable.') 461 RETURN 456 IF( wrk_in_use(2, 1,2,3,4) .OR. wrk_in_use(3, 1,2) ) THEN 457 CALL ctl_stop('blk_ice_clio: requested workspace arrays are unavailable') ; RETURN 462 458 ELSE IF(pdim > jpk)THEN 463 459 CALL ctl_stop('blk_ice_clio: too many ice levels to use wrk_nemo 3D workspaces.') … … 637 633 ENDIF 638 634 639 IF( (wrk_not_released(2, 1,2,3,4)) .OR. (wrk_not_released(3, 1,2)) )THEN 635 IF( wrk_not_released(2, 1,2,3,4) .OR. & 636 wrk_not_released(3, 1,2) ) & 640 637 CALL ctl_stop('blk_ice_clio: failed to release workspace arrays.') 641 END IF 642 638 ! 643 639 END SUBROUTINE blk_ice_clio 644 640 … … 654 650 !! - also initialise sbudyko and stauc once for all 655 651 !!---------------------------------------------------------------------- 656 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released657 USE wrk_nemo, ONLY: zev => wrk_2d_1 ! vapour pressure658 USE wrk_nemo, ONLY: zdlha => wrk_2d_2, zlsrise => wrk_2d_3, zlsset => wrk_2d_4659 USE wrk_nemo, ONLY: zps => wrk_2d_5, zpc => wrk_2d_6 ! sine (cosine) of latitude per sine (cosine)of solar declination652 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 660 656 !! 661 657 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: pqsr_oce ! shortwave radiation over the ocean … … 679 675 !!--------------------------------------------------------------------- 680 676 681 IF(wrk_in_use(2, 1,2,3,4,5,6))THEN 682 CALL ctl_stop('blk_clio_qsr_oce: requested workspace arrays unavailable.') 683 RETURN 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 684 679 END IF 685 680 … … 796 791 END DO 797 792 798 IF(wrk_not_released(2, 1,2,3,4,5,6))THEN 799 CALL ctl_stop('blk_clio_qsr_oce: failed to release workspace arrays.') 800 END IF 801 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 ! 802 795 END SUBROUTINE blk_clio_qsr_oce 803 796 … … 813 806 !! - also initialise sbudyko and stauc once for all 814 807 !!---------------------------------------------------------------------- 815 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released816 USE wrk_nemo, ONLY: zev => wrk_2d_1! vapour pressure817 USE wrk_nemo, ONLY: zdlha => wrk_2d_2! 2D workspace818 USE wrk_nemo, ONLY: zlsrise => wrk_2d_3 ! 2D workspace819 USE wrk_nemo, ONLY: zlsset => wrk_2d_4! 2D workspace820 USE wrk_nemo, ONLY: zps => wrk_2d_5, zpc => wrk_2d_6 ! sine (cosine) of latitude per sine (cosine)of solar declination808 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 821 814 !! 822 815 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pa_ice_cs ! albedo of ice under clear sky … … 839 832 !!--------------------------------------------------------------------- 840 833 841 IF(wrk_in_use(2, 1,2,3,4,5,6))THEN 842 CALL ctl_stop('blk_clio_qsr_ice: requested workspace arrays unavailable.') 843 RETURN 844 END IF 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 845 837 846 838 ijpl = SIZE(pqsr_ice, 3 ) ! number of ice categories … … 945 937 END DO 946 938 ! 947 IF(wrk_not_released(2, 1,2,3,4,5,6))THEN 948 CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays.') 949 END IF 939 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays') 950 940 ! 951 941 END SUBROUTINE blk_clio_qsr_ice -
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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r2633 r2636 223 223 !!--------------------------------------------------------------------- 224 224 225 IF(wrk_in_use(2, 1,2) ) THEN226 CALL ctl_stop('sbc_cpl_init: requested workspace arrays unavailable .') ; RETURN227 END 225 IF(wrk_in_use(2, 1,2) ) THEN 226 CALL ctl_stop('sbc_cpl_init: requested workspace arrays unavailable') ; RETURN 227 ENDIF 228 228 229 229 ! ================================ ! … … 563 563 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 564 564 565 IF(wrk_not_released(2,1,2))THEN 566 CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays.') 567 END IF 568 565 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays.') 566 ! 569 567 END SUBROUTINE sbc_cpl_init 570 568 … … 629 627 !!---------------------------------------------------------------------- 630 628 631 IF(wrk_in_use(2, 1,2))THEN 632 CALL ctl_stop('sbc_cpl_rcv: requested workspace arrays unavailable.') 633 RETURN 634 END IF 629 IF( wrk_in_use(2, 1,2) ) THEN 630 CALL ctl_stop('sbc_cpl_rcv: requested workspace arrays unavailable') ; RETURN 631 ENDIF 635 632 636 633 IF( kt == nit000 ) CALL sbc_cpl_init( k_ice ) ! initialisation … … 820 817 ENDIF 821 818 ! 822 IF(wrk_not_released(2, 1,2))THEN 823 CALL ctl_stop('sbc_cpl_rcv: failed to release workspace arrays.') 824 END IF 819 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('sbc_cpl_rcv: failed to release workspace arrays') 825 820 ! 826 821 END SUBROUTINE sbc_cpl_rcv … … 870 865 !!---------------------------------------------------------------------- 871 866 872 IF(wrk_in_use(2,1,2))THEN 873 CALL ctl_stop('sbc_cpl_ice_tau: requested workspace arrays unavailable.') 874 RETURN 875 END IF 867 IF( wrk_in_use(2, 1,2) ) THEN 868 CALL ctl_stop('sbc_cpl_ice_tau: requested workspace arrays unavailable') ; RETURN 869 ENDIF 876 870 877 871 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1041 1035 ENDIF 1042 1036 ! 1043 IF(wrk_not_released(2,1,2))THEN 1044 CALL ctl_stop('sbc_cpl_ice_tau: failed to release workspace arrays.') 1045 END IF 1037 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('sbc_cpl_ice_tau: failed to release workspace arrays') 1046 1038 ! 1047 1039 END SUBROUTINE sbc_cpl_ice_tau … … 1118 1110 !!---------------------------------------------------------------------- 1119 1111 1120 IF( wrk_in_use(2,1,2,3) .OR. wrk_in_use(3,1) )THEN 1121 CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable.') 1122 RETURN 1123 END IF 1112 IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 1) ) THEN 1113 CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable') ; RETURN 1114 ENDIF 1124 1115 1125 1116 zicefr(:,:,1) = 1.- p_frld(:,:,1) … … 1240 1231 END SELECT 1241 1232 1242 IF( wrk_not_released(2,1,2,3) .OR. wrk_not_released(3,1) )THEN 1243 CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays.') 1244 END IF 1245 1233 IF( wrk_not_released(2, 1,2,3) .OR. & 1234 wrk_not_released(3, 1) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1235 ! 1246 1236 END SUBROUTINE sbc_cpl_ice_flx 1247 1237 … … 1268 1258 !!---------------------------------------------------------------------- 1269 1259 1270 IF(wrk_in_use(2, 1,2,3,4,5,6,7,8,9))THEN 1271 CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable.'); 1272 RETURN 1273 END IF 1260 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN 1261 CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable') ; RETURN 1262 ENDIF 1274 1263 1275 1264 isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges … … 1444 1433 ! 1445 1434 ENDIF 1446 ! 1447 IF(wrk_not_released(2, 1,2,3,4,5,6,7,8,9))THEN 1448 CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays.'); 1449 RETURN 1450 END IF 1451 ! 1435 ! 1436 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) ) CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 1437 ! 1452 1438 END SUBROUTINE sbc_cpl_snd 1453 1439 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
r2625 r2636 10 10 11 11 !!---------------------------------------------------------------------- 12 !! sbc_dcy : compute solar flux at kt from daily mean, taking 13 !! diurnal cycle into account 12 !! sbc_dcy : solar flux at kt from daily mean, taking diurnal cycle into account 14 13 !!---------------------------------------------------------------------- 15 14 USE oce ! ocean dynamics and tracers … … 33 32 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 34 33 !! $Id$ 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 35 !!---------------------------------------------------------------------- 37 36 CONTAINS … … 41 40 !! *** FUNCTION sbc_dcy_alloc *** 42 41 !!---------------------------------------------------------------------- 43 !44 42 ALLOCATE( raa (jpi,jpj) , rbb (jpi,jpj) , rcc (jpi,jpj) , rab (jpi,jpj) , & 45 43 & rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc ) … … 47 45 IF( lk_mpp ) CALL mpp_sum ( sbc_dcy_alloc ) 48 46 IF( sbc_dcy_alloc /= 0 ) CALL ctl_warn('sbc_dcy_alloc: failed to allocate arrays') 49 !50 47 END FUNCTION sbc_dcy_alloc 51 48 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r2620 r2636 19 19 USE iom ! I/O manager library 20 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! MPP library 21 22 22 23 IMPLICIT NONE -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r2633 r2636 22 22 USE oce ! ocean dynamics and tracers 23 23 USE dom_oce ! ocean space and time domain 24 USE lib_mpp ! MPP library25 24 USE par_ice ! sea-ice parameters 26 25 USE ice ! LIM-3: ice variables … … 50 49 USE c1d ! 1D vertical configuration 51 50 USE lbclnk ! lateral boundary condition - MPP link 51 USE lib_mpp ! MPP library 52 52 USE iom ! I/O manager library 53 53 USE in_out_manager ! I/O manager … … 101 101 102 102 IF( wrk_in_use(3, 1,2) ) THEN 103 CALL ctl_stop( 'sbc_ice_lim: requested workspace arrays are unavailable .' ) ; RETURN103 CALL ctl_stop( 'sbc_ice_lim: requested workspace arrays are unavailable' ) ; RETURN 104 104 ENDIF 105 105 … … 252 252 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 253 253 ! 254 IF( wrk_not_released(3, 1,2) ) CALL ctl_stop( 'sbc_ice_lim: failed to release workspace arrays .' )254 IF( wrk_not_released(3, 1,2) ) CALL ctl_stop( 'sbc_ice_lim: failed to release workspace arrays' ) 255 255 ! 256 256 END SUBROUTINE sbc_ice_lim -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r2633 r2636 96 96 !!---------------------------------------------------------------------- 97 97 98 IF( wrk_in_use(3, 1,2,3) ) THEN98 IF( wrk_in_use(3, 1,2,3) ) THEN 99 99 CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable.') ; RETURN 100 END 100 ENDIF 101 101 ! Use pointers to access only sub-arrays of workspaces 102 102 zalb_ice_os => wrk_3d_1(:,:,1:1) … … 228 228 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 229 229 ! 230 IF( wrk_not_released(3, 1,2,3) ) CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays')230 IF( wrk_not_released(3, 1,2,3) ) CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays') 231 231 ! 232 232 END SUBROUTINE sbc_ice_lim_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r2620 r2636 38 38 USE sbcfwb ! surface boundary condition: freshwater budget 39 39 USE closea ! closed sea 40 USE bdy_par ! unstructured open boundary data variables41 USE bdyice ! unstructured open boundary data (bdy_ice_frs routine)40 USE bdy_par ! unstructured open boundary data variables 41 USE bdyice ! unstructured open boundary data (bdy_ice_frs routine) 42 42 43 43 USE prtctl ! Print control (prt_ctl routine) … … 45 45 USE iom ! IOM library 46 46 USE in_out_manager ! I/O manager 47 USE lib_mpp ! MPP library 47 48 48 49 IMPLICIT NONE -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r2620 r2636 19 19 USE phycst ! physical constants 20 20 USE sbc_oce ! surface boundary condition variables 21 USE closea ! closed seas 21 22 USE fldread ! read input field at current time step 23 USE restart ! restart 22 24 USE in_out_manager ! I/O manager 23 25 USE iom ! I/O module 24 USE restart ! restart 25 USE closea ! closed seas 26 USE lib_mpp ! MPP library 26 27 27 28 IMPLICIT NONE
Note: See TracChangeset
for help on using the changeset viewer.