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 3152 – NEMO

Changeset 3152


Ignore:
Timestamp:
2011-11-18T10:19:26+01:00 (12 years ago)
Author:
smasson
Message:

dev_NEMO_MERGE_2011: new dynamical allocation in IOM and SBC

Location:
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r3116 r3152  
    1010   USE in_out_manager   ! I/O manager 
    1111   USE lib_mpp          ! distributed memory computing 
     12   USE wrk_nemo_2       ! work arrays 
    1213 
    1314   IMPLICIT NONE 
    … …  
    7475      !!                    clinfo3 : additional information  
    7576      !!---------------------------------------------------------------------- 
    76       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    77       USE wrk_nemo, ONLY:   ztab2d_1 => wrk_2d_30 , ztab2d_2 => wrk_2d_31 
    78       USE wrk_nemo, ONLY:   zmask1   => wrk_3d_11 , zmask2   => wrk_3d_12  
    79       USE wrk_nemo, ONLY:   ztab3d_1 => wrk_3d_13 , ztab3d_2 => wrk_3d_14 
    80       ! 
    8177      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1 
    8278      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1 
    … …  
    9490      INTEGER ::   overlap, jn, sind, eind, kdir,j_id 
    9591      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    96       !!---------------------------------------------------------------------- 
    97  
    98       IF( wrk_in_use(2, 30,31) .OR. wrk_in_use(3, 11,12,13,14) ) THEN 
    99          CALL ctl_stop('prt_ctl : requested workspace arrays unavailable')   ;   RETURN 
    100       ENDIF 
     92      REAL(wp), POINTER, DIMENSION(:,:)   :: ztab2d_1, ztab2d_2 
     93      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask1, zmask2, ztab3d_1, ztab3d_2 
     94      !!---------------------------------------------------------------------- 
     95 
     96      CALL wrk_alloc( jpi,jpj, ztab2d_1, ztab2d_2 ) 
     97      CALL wrk_alloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 ) 
    10198 
    10299      ! Arrays, scalars initialization  
    … …  
    205202      ENDDO 
    206203 
    207       IF( wrk_not_released(2, 30,31)     .OR.   & 
    208           wrk_not_released(3, 11,12,13,14) )   CALL ctl_stop('prt_ctl: failed to release workspace arrays') 
     204      CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 ) 
     205      CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 ) 
    209206      ! 
    210207   END SUBROUTINE prt_ctl 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r2715 r3152  
    1919   USE in_out_manager  ! I/O manager 
    2020   USE lib_mpp         ! MPP library 
     21   USE wrk_nemo_2      ! work arrays 
    2122 
    2223   IMPLICIT NONE 
    … …  
    6566      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    6667      !!---------------------------------------------------------------------- 
    67       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY:   wrk_3d_6 , wrk_3d_7    ! 3D workspace 
    69       !! 
    7068      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
    7169      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness 
    … …  
    9189      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
    9290 
    93       IF( wrk_in_use(3, 6,7) ) THEN 
    94          CALL ctl_stop('albedo_ice: requested workspace arrays are unavailable')   ;   RETURN 
    95       ENDIF 
    96       ! Associate pointers with sub-arrays of workspace arrays 
    97       zalbfz  =>   wrk_3d_6(:,:,1:ijpl) 
    98       zficeth =>   wrk_3d_7(:,:,1:ijpl) 
     91      CALL wrk_alloc( jpi,jpj,ijpl, zalbfz, zficeth ) 
    9992 
    10093      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    … …  
    173166      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction 
    174167      ! 
    175       IF( wrk_not_released(3, 6,7) )   CALL ctl_stop('albedo_ice: failed to release workspace arrays') 
     168      CALL wrk_dealloc( jpi,jpj,ijpl, zalbfz, zficeth ) 
    176169      ! 
    177170   END SUBROUTINE albedo_ice 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90

    r2715 r3152  
    3232   USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
    3333   USE lib_mpp          ! MPP library 
     34   USE wrk_nemo_2       ! work arrays 
    3435 
    3536   IMPLICIT NONE 
    … …  
    111112      !! ** Method  :   OASIS4 MPI communication  
    112113      !!-------------------------------------------------------------------- 
    113       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    114       USE wrk_nemo, ONLY: zclo => wrk_3d_1, zcla => wrk_3d_2 
    115       USE wrk_nemo, ONLY: zlon => wrk_2d_1, zlat => wrk_2d_2 
    116       ! 
    117114      INTEGER, INTENT(in) :: krcv, ksnd     ! Number of received and sent coupling fields 
    118115      ! 
    … …  
    145142      TYPE(PRISM_Time_struct)    :: tmpdate 
    146143      INTEGER                    :: idate_incr      ! date increment 
    147       !!-------------------------------------------------------------------- 
    148  
    149       IF( wrk_in_use(3, 1,2) .OR. wrk_in_use(2, 1,2) )THEN 
    150          CALL ctl_stop('cpl_prism_define: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    151       ENDIF 
     144      REAL(wp), POINTER, DIMENSION(:,:)   ::   zlon, zlat 
     145      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zclo, zcla 
     146      !!-------------------------------------------------------------------- 
     147       
     148      CALL wrk_alloc( jpi,jpj, zlon, zlat ) 
     149      CALL wrk_alloc( jpi,jpj,jpk, zclo, zcla ) 
    152150 
    153151      IF(lwp) WRITE(numout,*) 
    … …  
    322320      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    323321       
    324       IF( wrk_not_released(3, 1,2) .OR.   & 
    325           wrk_not_released(2, 1,2)   )   CALL ctl_stop('cpl_prism_define: failed to release workspace arrays') 
     322      CALL wrk_dealloc( jpi,jpj, zlon, zlat ) 
     323      CALL wrk_dealloc( jpi,jpj,jpk, zclo, zcla ) 
    326324      ! 
    327325   END SUBROUTINE cpl_prism_define 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r3116 r3152  
    2020   USE geo2ocean       ! for vector rotation on to model grid 
    2121   USE lib_mpp         ! MPP library 
     22   USE wrk_nemo_2      ! work arrays 
    2223   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar 
    2324 
    … …  
    704705      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction 
    705706      !!---------------------------------------------------------------------- 
    706       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    707       USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25      ! 2D workspace 
    708       !! 
    709707      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
    710708      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    711709      !! 
    712       INTEGER                      ::   ju, jv, jk   ! loop indices 
    713       INTEGER                      ::   imf          ! size of the structure sd 
    714       INTEGER                      ::   ill          ! character length 
    715       INTEGER                      ::   iv           ! indice of V component 
    716       CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name 
    717       !!--------------------------------------------------------------------- 
    718  
    719       IF(wrk_in_use(2, 24,25) ) THEN 
    720          CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    721       END IF 
     710      INTEGER                           ::   ju, jv, jk   ! loop indices 
     711      INTEGER                           ::   imf          ! size of the structure sd 
     712      INTEGER                           ::   ill          ! character length 
     713      INTEGER                           ::   iv           ! indice of V component 
     714      REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation 
     715      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name 
     716      !!--------------------------------------------------------------------- 
     717 
     718      CALL wrk_alloc( jpi,jpj, utmp, vtmp ) 
    722719 
    723720      !! (sga: following code should be modified so that pairs arent searched for each time 
    … …  
    754751       END DO 
    755752      ! 
    756       IF(wrk_not_released(2, 24,25) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
     753      CALL wrk_dealloc( jpi,jpj, utmp, vtmp ) 
    757754      ! 
    758755   END SUBROUTINE fld_rot 
    … …  
    921918      !!                file, restructuring as required 
    922919      !!---------------------------------------------------------------------- 
    923       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    924       USE wrk_nemo, ONLY:   data_tmp =>  wrk_2d_1     ! 2D real    workspace 
    925       USE wrk_nemo, ONLY:   data_src => iwrk_2d_1     ! 2D integer workspace 
    926       !! 
    927920      TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file 
    928921      !! 
    929       INTEGER                ::   jn            ! dummy loop indices 
    930       INTEGER                ::   inum          ! temporary logical unit 
    931       INTEGER                ::   id            ! temporary variable id 
    932       INTEGER                ::   ipk           ! temporary vertical dimension 
    933       CHARACTER (len=5)      ::   aname 
    934       INTEGER , DIMENSION(3) ::   ddims 
    935       LOGICAL                ::   cyclical 
    936       INTEGER                ::   zwrap      ! local integer 
    937       !!---------------------------------------------------------------------- 
    938       ! 
    939       IF(  wrk_in_use(2, 1)  .OR.  iwrk_in_use(2,1) ) THEN 
    940          CALL ctl_stop('fld_weight: requested workspace arrays are unavailable')   ;   RETURN 
    941       ENDIF 
     922      INTEGER                           ::   jn            ! dummy loop indices 
     923      INTEGER                           ::   inum          ! temporary logical unit 
     924      INTEGER                           ::   id            ! temporary variable id 
     925      INTEGER                           ::   ipk           ! temporary vertical dimension 
     926      CHARACTER (len=5)                 ::   aname 
     927      INTEGER , DIMENSION(3)            ::   ddims 
     928      INTEGER , POINTER, DIMENSION(:,:) ::   data_src 
     929      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp 
     930      LOGICAL                           ::   cyclical 
     931      INTEGER                           ::   zwrap      ! local integer 
     932      !!---------------------------------------------------------------------- 
     933      ! 
     934      CALL wrk_alloc( jpi,jpj, data_src )   ! integer 
     935      CALL wrk_alloc( jpi,jpj, data_tmp ) 
    942936      ! 
    943937      IF( nxt_wgt > tot_wgts ) THEN 
    … …  
    10511045      ENDIF 
    10521046 
    1053       IF(  wrk_not_released(2, 1) .OR.    & 
    1054           iwrk_not_released(2, 1)  )   CALL ctl_stop('fld_weight: failed to release workspace arrays') 
     1047      CALL wrk_dealloc( jpi,jpj, data_src )   ! integer 
     1048      CALL wrk_dealloc( jpi,jpj, data_tmp ) 
    10551049      ! 
    10561050   END SUBROUTINE fld_weight 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r2777 r3152  
    2727   USE in_out_manager  ! I/O manager 
    2828   USE lib_mpp         ! distribued memory computing library 
     29   USE wrk_nemo_2      ! work arrays 
    2930   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3031 
    … …  
    207208      !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC 
    208209      !!---------------------------------------------------------------------- 
    209       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    210       USE wrk_nemo, ONLY: zqlw => wrk_2d_1  ! long-wave heat flux over ocean 
    211       USE wrk_nemo, ONLY: zqla => wrk_2d_2  ! latent heat flux over ocean 
    212       USE wrk_nemo, ONLY: zqsb => wrk_2d_3  ! sensible heat flux over ocean 
    213       !! 
    214210      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data 
    215211      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 
    … …  
    227223      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         - 
    228224      REAL(wp) ::   ztx2, zty2                                  !    -         - 
     225      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlw        ! long-wave heat flux over ocean 
     226      REAL(wp), POINTER, DIMENSION(:,:) ::   zqla        ! latent heat flux over ocean 
     227      REAL(wp), POINTER, DIMENSION(:,:) ::   zqsb        ! sensible heat flux over ocean 
    229228      !!--------------------------------------------------------------------- 
    230229 
    231       IF( wrk_in_use(3, 1,2,3) ) THEN 
    232          CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable')   ;   RETURN 
    233       ENDIF 
     230      CALL wrk_alloc( jpi,jpj, zqlw, zqla, zqsb ) 
    234231 
    235232      zpatm = 101000._wp      ! atmospheric pressure  (assumed constant here) 
    … …  
    382379      ENDIF 
    383380 
    384       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('blk_oce_clio: failed to release workspace arrays') 
     381      CALL wrk_dealloc( jpi,jpj, zqlw, zqla, zqsb ) 
    385382      ! 
    386383   END SUBROUTINE blk_oce_clio 
    … …  
    414411      !! 
    415412      !!---------------------------------------------------------------------- 
    416       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    417       USE wrk_nemo, ONLY:   ztatm  => wrk_2d_1   ! Tair in Kelvin 
    418       USE wrk_nemo, ONLY:   zqatm  => wrk_2d_2   ! specific humidity 
    419       USE wrk_nemo, ONLY:   zevsqr => wrk_2d_3   ! vapour pressure square-root 
    420       USE wrk_nemo, ONLY:   zrhoa  => wrk_2d_4   ! air density 
    421       USE wrk_nemo, ONLY:   wrk_3d_1 , wrk_3d_2 
    422       !! 
    423413      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    424414      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
    … …  
    448438      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
    449439      !! 
     440      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin 
     441      REAL(wp), DIMENSION(:,:)  , POINTER ::   zqatm   ! specific humidity 
     442      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevsqr  ! vapour pressure square-root 
     443      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density 
    450444      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
    451445      !!--------------------------------------------------------------------- 
    452446 
    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) 
     447      CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
     448      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    461449 
    462450      ijpl  = pdim                           ! number of ice categories 
    … …  
    634622      ENDIF 
    635623 
    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') 
     624      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
     625      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    638626      ! 
    639627   END SUBROUTINE blk_ice_clio 
    … …  
    650638      !!               - also initialise sbudyko and stauc once for all  
    651639      !!---------------------------------------------------------------------- 
    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       !! 
    657640      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   pqsr_oce    ! shortwave radiation  over the ocean 
    658641      !! 
    … …  
    673656      REAL(wp) ::   zxday, zdist, zcoef, zcoef1      ! 
    674657      REAL(wp) ::   zes 
     658       
     659      REAL(wp), DIMENSION(:,:), POINTER ::   zev          ! vapour pressure 
     660      REAL(wp), DIMENSION(:,:), POINTER ::   zdlha, zlsrise, zlsset     ! 2D workspace 
     661      REAL(wp), DIMENSION(:,:), POINTER ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    675662      !!--------------------------------------------------------------------- 
    676663 
    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 
     664      CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
    680665 
    681666      IF( lbulk_init ) THEN             !   Initilization at first time step only 
    … …  
    791776      END DO 
    792777 
    793       IF( wrk_not_released(2, 1,2,3,4,5,6) )   CALL ctl_stop('blk_clio_qsr_oce: failed to release workspace arrays') 
     778      CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
    794779      ! 
    795780   END SUBROUTINE blk_clio_qsr_oce 
    … …  
    806791      !!               - also initialise sbudyko and stauc once for all  
    807792      !!---------------------------------------------------------------------- 
    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       !! 
    815793      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_cs   ! albedo of ice under clear sky 
    816794      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_os   ! albedo of ice under overcast sky 
    … …  
    830808      REAL(wp) ::   zxday, zdist, zcoef, zcoef1   !    -         - 
    831809      REAL(wp) ::   zqsr_ice_cs, zqsr_ice_os      !    -         - 
    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 
     810 
     811      REAL(wp), DIMENSION(:,:), POINTER ::   zev                      ! vapour pressure 
     812      REAL(wp), DIMENSION(:,:), POINTER ::   zdlha, zlsrise, zlsset   ! 2D workspace 
     813      REAL(wp), DIMENSION(:,:), POINTER ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
     814       !!--------------------------------------------------------------------- 
     815 
     816      CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
    837817 
    838818      ijpl = SIZE(pqsr_ice, 3 )      ! number of ice categories 
    … …  
    937917      END DO 
    938918      ! 
    939       IF( wrk_not_released(2, 1,2,3,4,5,6) )   CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays') 
     919      CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
    940920      ! 
    941921   END SUBROUTINE blk_clio_qsr_ice 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3116 r3152  
    3333   USE in_out_manager  ! I/O manager 
    3434   USE lib_mpp         ! distribued memory computing library 
     35   USE wrk_nemo_2      ! work arrays 
    3536   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3637   USE prtctl          ! Print control 
    … …  
    223224      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    224225      !!--------------------------------------------------------------------- 
    225       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    226       USE wrk_nemo, ONLY:   zwnd_i => wrk_2d_1  , zwnd_j => wrk_2d_2      ! wind speed components at T-point 
    227       USE wrk_nemo, ONLY:   zqsatw => wrk_2d_3           ! specific humidity at pst 
    228       USE wrk_nemo, ONLY:   zqlw   => wrk_2d_4  , zqsb   => wrk_2d_5      ! long wave and sensible heat fluxes 
    229       USE wrk_nemo, ONLY:   zqla   => wrk_2d_6  , zevap  => wrk_2d_7      ! latent heat fluxes and evaporation 
    230       USE wrk_nemo, ONLY:   Cd     => wrk_2d_8           ! transfer coefficient for momentum      (tau) 
    231       USE wrk_nemo, ONLY:   Ch     => wrk_2d_9           ! transfer coefficient for sensible heat (Q_sens) 
    232       USE wrk_nemo, ONLY:   Ce     => wrk_2d_10          ! transfer coefficient for evaporation   (Q_lat) 
    233       USE wrk_nemo, ONLY:   zst    => wrk_2d_11          ! surface temperature in Kelvin 
    234       USE wrk_nemo, ONLY:   zt_zu  => wrk_2d_12          ! air temperature at wind speed height 
    235       USE wrk_nemo, ONLY:   zq_zu  => wrk_2d_13          ! air spec. hum.  at wind speed height 
    236       ! 
    237226      TYPE(fld), INTENT(in), DIMENSION(:)   ::   sf    ! input data 
    238227      REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
    … …  
    242231      INTEGER  ::   ji, jj               ! dummy loop indices 
    243232      REAL(wp) ::   zcoef_qsatw, zztmp   ! local variable 
     233      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
     234      REAL(wp), DIMENSION(:,:), POINTER ::   zqsatw            ! specific humidity at pst 
     235      REAL(wp), DIMENSION(:,:), POINTER ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
     236      REAL(wp), DIMENSION(:,:), POINTER ::   zqla, zevap       ! latent heat fluxes and evaporation 
     237      REAL(wp), DIMENSION(:,:), POINTER ::   Cd                ! transfer coefficient for momentum      (tau) 
     238      REAL(wp), DIMENSION(:,:), POINTER ::   Ch                ! transfer coefficient for sensible heat (Q_sens) 
     239      REAL(wp), DIMENSION(:,:), POINTER ::   Ce                ! tansfert coefficient for evaporation   (Q_lat) 
     240      REAL(wp), DIMENSION(:,:), POINTER ::   zst               ! surface temperature in Kelvin 
     241      REAL(wp), DIMENSION(:,:), POINTER ::   zt_zu             ! air temperature at wind speed height 
     242      REAL(wp), DIMENSION(:,:), POINTER ::   zq_zu             ! air spec. hum.  at wind speed height 
    244243      !!--------------------------------------------------------------------- 
    245244 
    246       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) ) THEN 
    247          CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable')   ;   RETURN 
    248       ENDIF 
     245      CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap ) 
     246      CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
    249247      ! 
    250248      ! local scalars ( place there for vector optimisation purposes) 
    … …  
    396394      ENDIF 
    397395      ! 
    398       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) )   & 
    399           CALL ctl_stop('blk_oce_core: failed to release workspace arrays') 
     396      CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap ) 
     397      CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
    400398      ! 
    401399   END SUBROUTINE blk_oce_core 
    … …  
    419417      !! caution : the net upward water flux has with mm/day unit 
    420418      !!--------------------------------------------------------------------- 
    421       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    422       USE wrk_nemo, ONLY:   z_wnds_t => wrk_2d_1                ! wind speed ( = | U10m - U_ice | ) at T-point 
    423       USE wrk_nemo, ONLY:   wrk_3d_4 , wrk_3d_5 , wrk_3d_6 , wrk_3d_7 
    424       !! 
    425419      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
    426420      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    … …  
    450444      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    451445      !! 
     446      REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point 
    452447      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
    453448      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
    … …  
    456451      !!--------------------------------------------------------------------- 
    457452 
     453      CALL wrk_alloc( jpi,jpj, z_wnds_t ) 
     454      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     455 
    458456      ijpl  = pdim                            ! number of ice categories 
    459  
    460       ! Set-up access to workspace arrays 
    461       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 4,5,6,7) ) THEN 
    462          CALL ctl_stop('blk_ice_core: requested workspace arrays unavailable')   ;   RETURN 
    463       ELSE IF(ijpl > jpk) THEN 
    464          CALL ctl_stop('blk_ice_core: no. of ice categories > jpk so wrk_nemo 3D workspaces cannot be used.') 
    465          RETURN 
    466       END IF 
    467       ! Set-up pointers to sub-arrays of workspaces 
    468       z_qlw  => wrk_3d_4(:,:,1:ijpl) 
    469       z_qsb  => wrk_3d_5(:,:,1:ijpl) 
    470       z_dqlw => wrk_3d_6(:,:,1:ijpl) 
    471       z_dqsb => wrk_3d_7(:,:,1:ijpl) 
    472457 
    473458      ! local scalars ( place there for vector optimisation purposes) 
    … …  
    622607      ENDIF 
    623608 
    624       IF( wrk_not_released(2, 1)       .OR.   & 
    625           wrk_not_released(3, 4,5,6,7) )   CALL ctl_stop('blk_ice_core: failed to release workspace arrays') 
     609      CALL wrk_dealloc( jpi,jpj, z_wnds_t ) 
     610      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
    626611      ! 
    627612   END SUBROUTINE blk_ice_core 
    … …  
    644629      !! References :   Large & Yeager, 2004 : ??? 
    645630      !!---------------------------------------------------------------------- 
    646       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    647       USE wrk_nemo, ONLY: dU10 => wrk_2d_14        ! dU                             [m/s] 
    648       USE wrk_nemo, ONLY: dT => wrk_2d_15          ! air/sea temperature difference   [K] 
    649       USE wrk_nemo, ONLY: dq => wrk_2d_16          ! air/sea humidity difference      [K] 
    650       USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_17      ! 10m neutral drag coefficient 
    651       USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_18      ! 10m neutral latent coefficient 
    652       USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_19      ! 10m neutral sensible coefficient 
    653       USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_20 ! root square of Cd_n10 
    654       USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_21     ! root square of Cd 
    655       USE wrk_nemo, ONLY: T_vpot => wrk_2d_22      ! virtual potential temperature    [K] 
    656       USE wrk_nemo, ONLY: T_star => wrk_2d_23      ! turbulent scale of tem. fluct. 
    657       USE wrk_nemo, ONLY: q_star => wrk_2d_24      ! turbulent humidity of temp. fluct. 
    658       USE wrk_nemo, ONLY: U_star => wrk_2d_25      ! turb. scale of velocity fluct. 
    659       USE wrk_nemo, ONLY: L => wrk_2d_26           ! Monin-Obukov length              [m] 
    660       USE wrk_nemo, ONLY: zeta => wrk_2d_27        ! stability parameter at height zu 
    661       USE wrk_nemo, ONLY: U_n10 => wrk_2d_28       ! neutral wind velocity at 10m     [m] 
    662       USE wrk_nemo, ONLY: xlogt  => wrk_2d_29,    xct => wrk_2d_30,   & 
    663                           zpsi_h => wrk_2d_31, zpsi_m => wrk_2d_32 
    664       USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
    665       ! 
    666631      REAL(wp)                , INTENT(in   ) ::   zu      ! altitude of wind measurement       [m] 
    667632      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sst     ! sea surface temperature         [Kelvin] 
    … …  
    678643      REAL(wp), PARAMETER ::   grav   = 9.8   ! gravity                        
    679644      REAL(wp), PARAMETER ::   kappa  = 0.4   ! von Karman s constant 
     645 
     646      REAL(wp), DIMENSION(:,:), POINTER  ::   dU10          ! dU                                   [m/s] 
     647      REAL(wp), DIMENSION(:,:), POINTER  ::   dT            ! air/sea temperature differeence      [K] 
     648      REAL(wp), DIMENSION(:,:), POINTER  ::   dq            ! air/sea humidity difference          [K] 
     649      REAL(wp), DIMENSION(:,:), POINTER  ::   Cd_n10        ! 10m neutral drag coefficient 
     650      REAL(wp), DIMENSION(:,:), POINTER  ::   Ce_n10        ! 10m neutral latent coefficient 
     651      REAL(wp), DIMENSION(:,:), POINTER  ::   Ch_n10        ! 10m neutral sensible coefficient 
     652      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd_n10   ! root square of Cd_n10 
     653      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd       ! root square of Cd 
     654      REAL(wp), DIMENSION(:,:), POINTER  ::   T_vpot        ! virtual potential temperature        [K] 
     655      REAL(wp), DIMENSION(:,:), POINTER  ::   T_star        ! turbulent scale of tem. fluct. 
     656      REAL(wp), DIMENSION(:,:), POINTER  ::   q_star        ! turbulent humidity of temp. fluct. 
     657      REAL(wp), DIMENSION(:,:), POINTER  ::   U_star        ! turb. scale of velocity fluct. 
     658      REAL(wp), DIMENSION(:,:), POINTER  ::   L             ! Monin-Obukov length                  [m] 
     659      REAL(wp), DIMENSION(:,:), POINTER  ::   zeta          ! stability parameter at height zu 
     660      REAL(wp), DIMENSION(:,:), POINTER  ::   U_n10         ! neutral wind velocity at 10m         [m]    
     661      REAL(wp), DIMENSION(:,:), POINTER  ::   xlogt, xct, zpsi_h, zpsi_m 
     662       
     663      INTEGER , DIMENSION(:,:), POINTER  ::   stab          ! 1st guess stability test integer 
    680664      !!---------------------------------------------------------------------- 
    681665 
    682       IF(  wrk_in_use(2,             14,15,16,17,18,19,        & 
    683                          20,21,22,23,24,25,26,27,28,29,        & 
    684                          30,31,32)                      .OR.   & 
    685           iwrk_in_use(2, 1)                               ) THEN 
    686          CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable')   ;   RETURN 
    687       ENDIF 
     666      CALL wrk_alloc( jpi,jpj, stab )   ! integer 
     667      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     668      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
    688669 
    689670      !! * Start 
    … …  
    755736      END DO 
    756737      !! 
    757       IF( wrk_not_released(2,             14,15,16,17,18,19,          & 
    758          &                    20,21,22,23,24,25,26,27,28,29,          & 
    759          &                    30,31,32                      )   .OR.  &       
    760          iwrk_not_released(2, 1)                                  )   & 
    761          CALL ctl_stop('TURB_CORE_1Z: failed to release workspace arrays') 
     738      CALL wrk_dealloc( jpi,jpj, stab )   ! integer 
     739      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     740      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
    762741      ! 
    763742    END SUBROUTINE TURB_CORE_1Z 
    … …  
    779758      !! References :   Large & Yeager, 2004 : ??? 
    780759      !!---------------------------------------------------------------------- 
    781       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    782       USE wrk_nemo, ONLY: dU10 => wrk_2d_14        ! dU                             [m/s] 
    783       USE wrk_nemo, ONLY: dT => wrk_2d_15          ! air/sea temperature difference   [K] 
    784       USE wrk_nemo, ONLY: dq => wrk_2d_16          ! air/sea humidity difference      [K] 
    785       USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_17      ! 10m neutral drag coefficient 
    786       USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_18      ! 10m neutral latent coefficient 
    787       USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_19      ! 10m neutral sensible coefficient 
    788       USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_20 ! root square of Cd_n10 
    789       USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_21     ! root square of Cd 
    790       USE wrk_nemo, ONLY: T_vpot => wrk_2d_22      ! virtual potential temperature    [K] 
    791       USE wrk_nemo, ONLY: T_star => wrk_2d_23     ! turbulent scale of tem. fluct. 
    792       USE wrk_nemo, ONLY: q_star => wrk_2d_24     ! turbulent humidity of temp. fluct. 
    793       USE wrk_nemo, ONLY: U_star => wrk_2d_25     ! turb. scale of velocity fluct. 
    794       USE wrk_nemo, ONLY: L => wrk_2d_26          ! Monin-Obukov length              [m] 
    795       USE wrk_nemo, ONLY: zeta_u => wrk_2d_27     ! stability parameter at height zu 
    796       USE wrk_nemo, ONLY: zeta_t => wrk_2d_28     ! stability parameter at height zt 
    797       USE wrk_nemo, ONLY: U_n10 => wrk_2d_29      ! neutral wind velocity at 10m     [m] 
    798       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 
    799       USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
    800       !! 
    801       REAL(wp), INTENT(in)   :: & 
    802          zt,      &     ! height for T_zt and q_zt                   [m] 
    803          zu             ! height for dU                              [m] 
    804       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::  & 
    805          sst,      &     ! sea surface temperature              [Kelvin] 
    806          T_zt,     &     ! potential air temperature            [Kelvin] 
    807          q_sat,    &     ! sea surface specific humidity         [kg/kg] 
    808          q_zt,     &     ! specific air humidity                 [kg/kg] 
    809          dU              ! relative wind module |U(zu)-U(0)|       [m/s] 
    810       REAL(wp), INTENT(out), DIMENSION(jpi,jpj)  ::  & 
    811          Cd,       &     ! transfer coefficient for momentum         (tau) 
    812          Ch,       &     ! transfer coefficient for sensible heat (Q_sens) 
    813          Ce,       &     ! transfert coefficient for evaporation   (Q_lat) 
    814          T_zu,     &     ! air temp. shifted at zu                     [K] 
    815          q_zu            ! spec. hum.  shifted at zu               [kg/kg] 
     760      REAL(wp), INTENT(in   )                     ::   zt       ! height for T_zt and q_zt                   [m] 
     761      REAL(wp), INTENT(in   )                     ::   zu       ! height for dU                              [m] 
     762      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature              [Kelvin] 
     763      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   T_zt     ! potential air temperature            [Kelvin] 
     764      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_sat    ! sea surface specific humidity         [kg/kg] 
     765      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg] 
     766      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module |U(zu)-U(0)|       [m/s] 
     767      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
     768      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens) 
     769      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat) 
     770      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   T_zu     ! air temp. shifted at zu                     [K] 
     771      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. hum.  shifted at zu               [kg/kg] 
    816772 
    817773      INTEGER :: j_itt 
    818       INTEGER, PARAMETER :: nb_itt = 3   ! number of itterations 
    819       REAL(wp), PARAMETER ::                        & 
    820          grav   = 9.8,      &  ! gravity                        
    821          kappa  = 0.4          ! von Karman's constant 
     774      INTEGER , PARAMETER :: nb_itt = 3              ! number of itterations 
     775      REAL(wp), PARAMETER ::   grav   = 9.8          ! gravity                        
     776      REAL(wp), PARAMETER ::   kappa  = 0.4          ! von Karman's constant 
     777       
     778      REAL(wp), DIMENSION(:,:), POINTER ::   dU10          ! dU                                [m/s] 
     779      REAL(wp), DIMENSION(:,:), POINTER ::   dT            ! air/sea temperature differeence   [K] 
     780      REAL(wp), DIMENSION(:,:), POINTER ::   dq            ! air/sea humidity difference       [K] 
     781      REAL(wp), DIMENSION(:,:), POINTER ::   Cd_n10        ! 10m neutral drag coefficient 
     782      REAL(wp), DIMENSION(:,:), POINTER ::   Ce_n10        ! 10m neutral latent coefficient 
     783      REAL(wp), DIMENSION(:,:), POINTER ::   Ch_n10        ! 10m neutral sensible coefficient 
     784      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd_n10   ! root square of Cd_n10 
     785      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd       ! root square of Cd 
     786      REAL(wp), DIMENSION(:,:), POINTER ::   T_vpot        ! virtual potential temperature        [K] 
     787      REAL(wp), DIMENSION(:,:), POINTER ::   T_star        ! turbulent scale of tem. fluct. 
     788      REAL(wp), DIMENSION(:,:), POINTER ::   q_star        ! turbulent humidity of temp. fluct. 
     789      REAL(wp), DIMENSION(:,:), POINTER ::   U_star        ! turb. scale of velocity fluct. 
     790      REAL(wp), DIMENSION(:,:), POINTER ::   L             ! Monin-Obukov length                  [m] 
     791      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu 
     792      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt 
     793      REAL(wp), DIMENSION(:,:), POINTER ::   U_n10         ! neutral wind velocity at 10m        [m] 
     794      REAL(wp), DIMENSION(:,:), POINTER ::   xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m 
     795 
     796      INTEGER , DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer 
    822797      !!---------------------------------------------------------------------- 
    823       !!  * Start 
    824  
    825       IF(  wrk_in_use(2,             14,15,16,17,18,19,        & 
    826                          20,21,22,23,24,25,26,27,28,29,        &          
    827                          30,31,32,33,34)                .OR.   & 
    828           iwrk_in_use(2, 1)                               ) THEN 
    829          CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable')   ;   RETURN 
    830       ENDIF 
     798 
     799      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     800      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
     801      CALL wrk_alloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
     802      CALL wrk_alloc( jpi,jpj, stab )   ! interger 
    831803 
    832804      !! Initial air/sea differences 
    … …  
    910882      END DO 
    911883      !! 
    912      IF( wrk_not_released(2,              14,15,16,17,18,19,          & 
    913          &                    20,21,22,23,24,25,26,27,28,29,          & 
    914          &                    30,31,32,33,34                )   .OR.  &   
    915          iwrk_not_released(2, 1)                                  )   & 
    916          CALL ctl_stop('TURB_CORE_2Z: failed to release workspace arrays') 
     884      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     885      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
     886      CALL wrk_dealloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
     887      CALL wrk_dealloc( jpi,jpj, stab )   ! interger 
    917888      ! 
    918889    END SUBROUTINE TURB_CORE_2Z 
    … …  
    921892    FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e) 
    922893      !------------------------------------------------------------------------------- 
    923       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    924       USE wrk_nemo, ONLY:     X2 => wrk_2d_35 
    925       USE wrk_nemo, ONLY:     X  => wrk_2d_36 
    926       USE wrk_nemo, ONLY: stabit => wrk_2d_37 
    927       !! 
    928894      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    929895 
    930896      REAL(wp), PARAMETER :: pi = 3.141592653589793_wp 
    931897      REAL(wp), DIMENSION(jpi,jpj)             :: psi_m 
     898      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
    932899      !------------------------------------------------------------------------------- 
    933900 
    934       IF( wrk_in_use(2, 35,36,37) ) THEN 
    935          CALL ctl_stop('psi_m: requested workspace arrays unavailable')   ;   RETURN 
    936       ENDIF 
     901      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    937902 
    938903      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2) 
    … …  
    941906         &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
    942907 
    943       IF( wrk_not_released(2, 35,36,37) )   CALL ctl_stop('psi_m: failed to release workspace arrays') 
     908      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    944909      ! 
    945910    END FUNCTION psi_m 
    … …  
    948913    FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e) 
    949914      !------------------------------------------------------------------------------- 
    950       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    951       USE wrk_nemo, ONLY:     X2 => wrk_2d_35 
    952       USE wrk_nemo, ONLY:     X  => wrk_2d_36 
    953       USE wrk_nemo, ONLY: stabit => wrk_2d_37 
    954       ! 
    955915      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta 
    956916      ! 
    957917      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h 
     918      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
    958919      !------------------------------------------------------------------------------- 
    959920 
    960       IF( wrk_in_use(2, 35,36,37) ) THEN 
    961          CALL ctl_stop('psi_h: requested workspace arrays unavailable')   ;   RETURN 
    962       ENDIF 
     921      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    963922 
    964923      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2) 
    … …  
    967926         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
    968927 
    969       IF( wrk_not_released(2, 35,36,37) )   CALL ctl_stop('psi_h: failed to release workspace arrays') 
     928      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    970929      ! 
    971930    END FUNCTION psi_h 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r3107 r3152  
    2020   USE in_out_manager  ! I/O manager 
    2121   USE lib_mpp         ! distribued memory computing library 
     22   USE wrk_nemo_2      ! work arrays 
    2223   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2324   USE prtctl          ! Print control 
    … …  
    283284      !! 
    284285      !!---------------------------------------------------------------------- 
    285       !! 
    286  
    287286      USE sbcblk_core, ONLY: turb_core_2z ! For wave coupling and Tair/rh from 2 to 10m 
    288       USE wrk_nemo, ONLY:  wrk_in_use, wrk_not_released 
    289       USE wrk_nemo, ONLY:  rspeed     => wrk_2d_1 
    290       USE wrk_nemo, ONLY:  sh10now    => wrk_2d_2 
    291       USE wrk_nemo, ONLY:  t10now     => wrk_2d_3 
    292       USE wrk_nemo, ONLY:  cdx        => wrk_2d_4   ! --- drag coeff. 
    293       USE wrk_nemo, ONLY:  ce         => wrk_2d_5   ! --- turbulent exchange coefficients 
    294       USE wrk_nemo, ONLY:  shms       => wrk_2d_6 
    295       USE wrk_nemo, ONLY:  rhom       => wrk_2d_7 
    296       USE wrk_nemo, ONLY:  sstk       => wrk_2d_8 
    297       USE wrk_nemo, ONLY:  ch         => wrk_2d_10 
    298       USE wrk_nemo, ONLY:  rel_windu  => wrk_2d_11 
    299       USE wrk_nemo, ONLY:  rel_windv  => wrk_2d_12 
    300287 
    301288      REAL(wp), INTENT(in   ) :: hour 
    … …  
    310297      REAL(wp)  :: esre, cseep 
    311298 
     299      REAL(wp), DIMENSION (:,:), POINTER ::   rspeed, sh10now, t10now, cdx, ce, shms 
     300      REAL(wp), DIMENSION (:,:), POINTER ::   rhom, sstk, ch, rel_windu, rel_windv 
    312301      !!---------------------------------------------------------------------- 
    313302      !!     coefficients ( in MKS )  : 
    … …  
    336325      INTEGER :: kku                        !index varing with wind speed 
    337326 
    338       ! Set-up access to workspace arrays 
    339       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,10,11,12) ) THEN 
    340          CALL ctl_stop('blk_mfs: requested workspace arrays unavailable')   ;   RETURN 
    341       END IF 
     327      CALL wrk_alloc( jpi,jpj, rspeed, sh10now, t10now, cdx, ce, shms ) 
     328      CALL wrk_alloc( jpi,jpj, rhom, sstk, ch, rel_windu, rel_windv ) 
    342329 
    343330      !!---------------------------------------------------------------------- 
    … …  
    501488       tauy(:,:)= rhom(:,:) * cdx(:,:) * rspeed(:,:) * rel_windv(:,:) 
    502489 
    503  
    504       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,10,11,12) )    & 
    505          CALL ctl_stop('fluxes_mfs: failed to release workspace arrays') 
    506  
     490      CALL wrk_dealloc( jpi,jpj, rspeed, sh10now, t10now, cdx, ce, shms ) 
     491      CALL wrk_dealloc( jpi,jpj, rhom, sstk, ch, rel_windu, rel_windv ) 
    507492 
    508493   END SUBROUTINE fluxes_mfs 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r3116 r3152  
    4747   USE iom             ! NetCDF library 
    4848   USE lib_mpp         ! distribued memory computing library 
     49   USE wrk_nemo_2      ! work arrays 
    4950   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    5051#if defined key_cpl_carbon_cycle 
    … …  
    217218      !!              * initialise the OASIS coupler 
    218219      !!---------------------------------------------------------------------- 
    219       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    220       USE wrk_nemo, ONLY:   zacs => wrk_2d_3 , zaos => wrk_2d_4   ! clear & overcast sky albedos 
    221       !! 
    222220      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    223221      !! 
    224222      INTEGER ::   jn   ! dummy loop index 
     223      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
    225224      !! 
    226225      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
    … …  
    229228      !!--------------------------------------------------------------------- 
    230229 
    231       IF( wrk_in_use(2, 3,4) ) THEN 
    232          CALL ctl_stop('sbc_cpl_init: requested workspace arrays unavailable')   ;   RETURN 
    233       ENDIF 
     230      CALL wrk_alloc( jpi,jpj, zacs, zaos ) 
    234231 
    235232      ! ================================ ! 
    … …  
    618615         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    619616 
    620       IF( wrk_not_released(2, 3,4) )   CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays') 
     617      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
    621618      ! 
    622619   END SUBROUTINE sbc_cpl_init 
    … …  
    665662      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case) 
    666663      !!---------------------------------------------------------------------- 
    667       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    668       USE wrk_nemo, ONLY:   ztx => wrk_2d_1 , zty => wrk_2d_2 
    669       !! 
    670664      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    671665      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    … …  
    680674      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    681675      REAL(wp) ::   zzx, zzy               ! temporary variables 
    682       !!---------------------------------------------------------------------- 
    683  
    684       IF( wrk_in_use(2, 1,2) ) THEN 
    685          CALL ctl_stop('sbc_cpl_rcv: requested workspace arrays unavailable')   ;   RETURN 
    686       ENDIF 
     676      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     677      !!---------------------------------------------------------------------- 
     678 
     679      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    687680 
    688681      IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    … …  
    867860      ENDIF 
    868861      ! 
    869       IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('sbc_cpl_rcv: failed to release workspace arrays') 
     862      CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
    870863      ! 
    871864   END SUBROUTINE sbc_cpl_rcv 
    … …  
    905898      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point 
    906899      !!---------------------------------------------------------------------- 
    907       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    908       USE wrk_nemo, ONLY:   ztx => wrk_2d_1 , zty => wrk_2d_2 
    909       !! 
    910900      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    911901      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    … …  
    913903      INTEGER ::   ji, jj                          ! dummy loop indices 
    914904      INTEGER ::   itx                             ! index of taux over ice 
    915       !!---------------------------------------------------------------------- 
    916  
    917       IF( wrk_in_use(2, 1,2) ) THEN 
    918          CALL ctl_stop('sbc_cpl_ice_tau: requested workspace arrays unavailable')   ;   RETURN 
    919       ENDIF 
     905      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     906      !!---------------------------------------------------------------------- 
     907       
     908      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    920909 
    921910      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    … …  
    10791068      ENDIF 
    10801069      !    
    1081       IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('sbc_cpl_ice_tau: failed to release workspace arrays') 
     1070      CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
    10821071      ! 
    10831072   END SUBROUTINE sbc_cpl_ice_tau 
    … …  
    11241113      !!                   sprecip             solid precipitation over the ocean   
    11251114      !!---------------------------------------------------------------------- 
    1126       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1127       USE wrk_nemo, ONLY:   zcptn  => wrk_2d_2   ! rcp * tsn(:,:,1,jp_tem) 
    1128       USE wrk_nemo, ONLY:   ztmp   => wrk_2d_3   ! temporary array 
    1129       USE wrk_nemo, ONLY:   zicefr => wrk_2d_4   ! ice fraction  
    1130       !! 
    11311115      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11321116      ! optional arguments, used only in 'mixed oce-ice' case 
    … …  
    11361120      ! 
    11371121      INTEGER ::   jl   ! dummy loop index 
    1138       !!---------------------------------------------------------------------- 
    1139  
    1140       IF( wrk_in_use(2, 2,3,4) ) THEN 
    1141          CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable')   ;   RETURN 
    1142       ENDIF 
     1122      REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
     1123      !!---------------------------------------------------------------------- 
     1124 
     1125      CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    11431126 
    11441127      zicefr(:,:) = 1.- p_frld(:,:) 
    … …  
    13161299      END SELECT 
    13171300 
    1318       IF( wrk_not_released(2, 2,3,4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 
     1301      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    13191302      ! 
    13201303   END SUBROUTINE sbc_cpl_ice_flx 
    … …  
    13301313      !!              all the needed fields (as defined in sbc_cpl_init) 
    13311314      !!---------------------------------------------------------------------- 
    1332       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1333       USE wrk_nemo, ONLY:   zfr_l => wrk_2d_1   ! 1. - fr_i(:,:) 
    1334       USE wrk_nemo, ONLY:   ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 
    1335       USE wrk_nemo, ONLY:   ztmp3 => wrk_3d_1 , ztmp4 => wrk_3d_2 
    1336       USE wrk_nemo, ONLY:   zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 
    1337       USE wrk_nemo, ONLY:   zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 
    1338       ! 
    13391315      INTEGER, INTENT(in) ::   kt 
    13401316      ! 
    13411317      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    13421318      INTEGER ::   isec, info   ! local integer 
    1343       !!---------------------------------------------------------------------- 
    1344  
    1345       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_in_use(3, 1,2)  ) THEN 
    1346          CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable')   ;   RETURN 
    1347       ENDIF 
     1319      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
     1320      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
     1321      !!---------------------------------------------------------------------- 
     1322 
     1323      CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     1324      CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
    13481325 
    13491326      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
    … …  
    15651542      ENDIF 
    15661543      ! 
    1567       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_not_released(3, 1,2) )   CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 
     1544      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     1545      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
    15681546      ! 
    15691547   END SUBROUTINE sbc_cpl_snd 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r2715 r3152  
    2222   USE in_out_manager  ! I/O manager 
    2323   USE lib_mpp         ! distribued memory computing library 
     24   USE wrk_nemo_2      ! work arrays 
    2425   USE lbclnk          ! ocean lateral boundary conditions 
    2526   USE lib_fortran 
    … …  
    5859      !!                   & spread out over erp area depending its sign 
    5960      !!---------------------------------------------------------------------- 
    60       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    61       USE wrk_nemo, ONLY:   ztmsk_neg      => wrk_2d_1 , ztmsk_pos => wrk_2d_2 
    62       USE wrk_nemo, ONLY:   ztmsk_tospread => wrk_2d_3 
    63       USE wrk_nemo, ONLY:   z_wgt          => wrk_2d_4 , zerp_cor  => wrk_2d_5 
    64       ! 
    6561      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    6662      INTEGER, INTENT( in ) ::   kn_fsbc  !  
    … …  
    7066      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp   ! local scalars 
    7167      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread    !   -      - 
     68      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor 
    7269      !!---------------------------------------------------------------------- 
    7370      ! 
    74       IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 
    75          CALL ctl_stop('sbc_fwb: requested workspace arrays are unavailable')   ;   RETURN 
    76       ENDIF 
     71      CALL wrk_alloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor ) 
    7772      ! 
    7873      IF( kt == nit000 ) THEN 
    … …  
    195190      END SELECT 
    196191      ! 
    197       IF( wrk_not_released(2, 1,2,3,4,5) )   CALL ctl_stop('sbc_fwb: failed to release workspace arrays') 
     192      CALL wrk_dealloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor ) 
    198193      ! 
    199194   END SUBROUTINE sbc_fwb 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r3116 r3152  
    1818   USE lib_mpp         ! distributed memory computing library 
    1919   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     20   USE wrk_nemo_2      ! work arrays 
    2021   USE daymod          ! calendar 
    2122   USE fldread         ! read input fields 
    … …  
    178179     CALL lbc_lnk ( fr_iv , 'V', 1. ) 
    179180 
    180  
    181181   END SUBROUTINE cice_sbc_init 
    182182 
     183    
    183184   SUBROUTINE cice_sbc_in (kt, nsbc) 
    184185      !!--------------------------------------------------------------------- 
    185186      !!                    ***  ROUTINE cice_sbc_in  *** 
    186187      !! ** Purpose: Set coupling fields and pass to CICE 
    187       !! 
    188       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    189       USE wrk_nemo, ONLY:   wrk_2d_1, wrk_3d_1                    ! Workspace 
    190       !! 
    191       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    192       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    193       !!--------------------------------------------------------------------- 
    194      INTEGER  ::   ji, jj, jpl                   ! dummy loop indices 
    195  
    196      REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
    197      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 
    198  
    199      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1)  ) THEN 
    200         CALL ctl_stop('cice_sbc_in: requested workspace arrays are unavailable')   ;   RETURN 
    201      ENDIF 
    202      ztmp => wrk_2d_1(:,:) 
    203      ztmpn => wrk_3d_1(:,:,1:ncat) 
     188      !!--------------------------------------------------------------------- 
     189      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
     190      INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
     191 
     192      INTEGER  ::   ji, jj, jpl                   ! dummy loop indices       
     193      REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     194      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 
     195      !!--------------------------------------------------------------------- 
     196 
     197      CALL wrk_alloc( jpi,jpj, ztmp ) 
     198      CALL wrk_alloc( jpi,jpj,ncat, ztmpn ) 
    204199 
    205200     IF( kt == nit000 )  THEN 
    … …  
    368363     CALL nemo2cice(ztmp,vocn,'F', -1. ) 
    369364 
    370      IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1)  )   CALL ctl_stop('cice_sbc_in: failed to release workspace arrays') 
     365      CALL wrk_dealloc( jpi,jpj, ztmp ) 
     366      CALL wrk_dealloc( jpi,jpj,ncat, ztmpn ) 
    371367     ! 
    372368   END SUBROUTINE cice_sbc_in 
    373369 
     370 
    374371   SUBROUTINE cice_sbc_out (kt,nsbc) 
    375372      !!--------------------------------------------------------------------- 
    376373      !!                    ***  ROUTINE cice_sbc_out  *** 
    377374      !! ** Purpose: Get fields from CICE and set surface fields for NEMO 
    378       !! 
    379       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    380       USE wrk_nemo, ONLY:   wrk_2d_1                         ! 2D workspace 
    381       !! 
     375      !!--------------------------------------------------------------------- 
    382376      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    383377      INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    384       !!--------------------------------------------------------------------- 
    385  
    386      INTEGER  ::   ji, jj, jpl                 ! dummy loop indices 
    387  
    388      REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
    389  
    390      IF( kt == nit000 )  THEN 
     378       
     379      INTEGER  ::   ji, jj, jpl                 ! dummy loop indices 
     380      REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     381      !!--------------------------------------------------------------------- 
     382 
     383      CALL wrk_alloc( jpi,jpj, ztmp ) 
     384       
     385      IF( kt == nit000 )  THEN 
    391386         IF(lwp) WRITE(numout,*)'cice_sbc_out' 
    392      ENDIF 
    393  
    394      IF( wrk_in_use(2, 1) ) THEN 
    395         CALL ctl_stop('cice_sbc_out: requested workspace arrays are unavailable')   ;   RETURN 
    396      ENDIF 
    397      ztmp => wrk_2d_1(:,:) 
    398  
     387      ENDIF 
     388       
    399389! x comp of ocean-ice stress  
    400390     CALL cice2nemo(strocnx,ztmp,'F', -1. ) 
    … …  
    532522! Release work space 
    533523 
    534      IF( wrk_not_released(2, 1) )   CALL ctl_stop('cice_sbc_out: failed to release workspace arrays') 
     524      CALL wrk_dealloc( jpi,jpj, ztmp ) 
    535525     ! 
    536526   END SUBROUTINE cice_sbc_out 
     527 
    537528 
    538529#if defined key_oasis3 || defined key_oasis4 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r2777 r3152  
    5050   USE lbclnk          ! lateral boundary condition - MPP link 
    5151   USE lib_mpp         ! MPP library 
     52   USE wrk_nemo_2      ! work arrays 
    5253   USE iom             ! I/O manager library 
    5354   USE in_out_manager  ! I/O manager 
    … …  
    8990      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    9091      !!--------------------------------------------------------------------- 
    91       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    92       USE wrk_nemo, ONLY:   wrk_3d_1, wrk_3d_2   ! for albedo of ice under overcast/clear sky 
    93       !! 
    9492      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    9593      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    … …  
    10098      !!---------------------------------------------------------------------- 
    10199 
    102       IF( wrk_in_use(3, 1,2) ) THEN 
    103          CALL ctl_stop( 'sbc_ice_lim: requested workspace arrays are unavailable' )   ;   RETURN 
    104       ENDIF 
    105       zalb_ice_os => wrk_3d_1(:,:,1:jpl)   ;    zalb_ice_cs => wrk_3d_2(:,:,1:jpl) 
     100      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    106101 
    107102      IF( kt == nit000 ) THEN 
    … …  
    253248!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    254249      ! 
    255       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop( 'sbc_ice_lim: failed to release workspace arrays' ) 
     250      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    256251      ! 
    257252   END SUBROUTINE sbc_ice_lim 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r3116 r3152  
    4444   USE lbclnk           ! lateral boundary condition - MPP link 
    4545   USE lib_mpp          ! MPP library 
     46   USE wrk_nemo_2       ! work arrays 
    4647   USE iom              ! I/O manager library 
    4748   USE in_out_manager   ! I/O manager 
    … …  
    8384      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8485      !!--------------------------------------------------------------------- 
    85       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    86       USE wrk_nemo, ONLY:   wrk_3d_1 , wrk_3d_2 , wrk_3d_3   ! 3D workspace 
    87       !! 
    8886      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    8987      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled ) 
    9088      !! 
    9189      INTEGER  ::   ji, jj   ! dummy loop indices 
    92       ! Pointers into workspaces contained in the wrk_nemo module 
    9390      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky 
    9491      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky 
    … …  
    9693      !!---------------------------------------------------------------------- 
    9794 
    98       IF( wrk_in_use(3, 1,2,3) ) THEN 
    99          CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable')   ;   RETURN 
    100       ENDIF 
    101       ! Use pointers to access only sub-arrays of workspaces 
    102       zalb_ice_os => wrk_3d_1(:,:,1:1) 
    103       zalb_ice_cs => wrk_3d_2(:,:,1:1) 
    104       zsist       => wrk_3d_3(:,:,1:1) 
     95      CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
    10596 
    10697      IF( kt == nit000 ) THEN 
    … …  
    230221      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    231222      ! 
    232       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays') 
     223      CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
    233224      ! 
    234225   END SUBROUTINE sbc_ice_lim_2 
Note: See TracChangeset for help on using the changeset viewer.