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 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r2528 r2715  
    8383      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8484      !!--------------------------------------------------------------------- 
     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      !! 
    8588      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    8689      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled ) 
    8790      !! 
    8891      INTEGER  ::   ji, jj   ! dummy loop indices 
    89       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb_ice_os   ! albedo of the ice under overcast sky 
    90       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb_ice_cs   ! albedo of ice under clear sky 
    91       REAL(wp), DIMENSION(jpi,jpj,1) ::   zsist        ! surface ice temperature (K) 
     92      ! Pointers into workspaces contained in the wrk_nemo module 
     93      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky 
     94      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky 
     95      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K) 
    9296      !!---------------------------------------------------------------------- 
     97 
     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) 
    93105 
    94106      IF( kt == nit000 ) THEN 
     
    129141 
    130142         ! ... ice albedo (clear sky and overcast sky) 
    131          CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalb_ice_cs, zalb_ice_os ) 
     143         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 
     144                                 reshape( hsnif, (/jpi,jpj,1/) ), & 
     145                          zalb_ice_cs, zalb_ice_os ) 
    132146 
    133147         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
     
    189203         !                                             ! Ice surface fluxes in coupled mode  
    190204         IF( ksbc == 5 )   CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),                 & 
    191       &                                                   qns_tot, qns_ice, qsr_tot , qsr_ice,   & 
    192       &                                                   emp_tot, emp_ice, dqns_ice, sprecip,   & 
    193       !                                      optional arguments, used only in 'mixed oce-ice' case 
    194       &                                                   palbi = zalb_ice_cs, psst = sst_m, pist = sist ) 
     205            &                                             qns_tot, qns_ice, qsr_tot , qsr_ice,   & 
     206            &                                             emp_tot, emp_ice, dqns_ice, sprecip,   & 
     207            !                                optional arguments, used only in 'mixed oce-ice' case 
     208            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 
    195209#endif 
    196210                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
     
    214228      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    215229      ! 
     230      IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays') 
     231      ! 
    216232   END SUBROUTINE sbc_ice_lim_2 
    217233 
     
    222238CONTAINS 
    223239   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine 
     240      INTEGER, INTENT(in) ::   kt, ksbc     
    224241      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc 
    225242   END SUBROUTINE sbc_ice_lim_2 
Note: See TracChangeset for help on using the changeset viewer.