Changeset 3294 for trunk/NEMOGCM/NEMO/LIM_SRC_2
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/LIM_SRC_2
- Files:
-
- 14 edited
-
iceini_2.F90 (modified) (2 diffs)
-
limadv_2.F90 (modified) (7 diffs)
-
limdyn_2.F90 (modified) (4 diffs)
-
limhdf_2.F90 (modified) (4 diffs)
-
limistate_2.F90 (modified) (2 diffs)
-
limmsh_2.F90 (modified) (4 diffs)
-
limrhg_2.F90 (modified) (6 diffs)
-
limsbc_2.F90 (modified) (9 diffs)
-
limthd_2.F90 (modified) (4 diffs)
-
limthd_lac_2.F90 (modified) (5 diffs)
-
limthd_zdf_2.F90 (modified) (6 diffs)
-
limtrp_2.F90 (modified) (4 diffs)
-
limwri_2.F90 (modified) (5 diffs)
-
limwri_dimg_2.h90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r2855 r3294 23 23 USE par_ice_2 ! LIM2 parameters 24 24 USE thd_ice_2 ! LIM2 thermodynamical variables 25 USE limrhg ! LIM2 EVP rheology26 USE limrhg_2 ! LIM2 VP rheology (requires "key_lim2_vp")27 25 USE ice_2 ! LIM2 ice variable 28 26 USE limmsh_2 ! LIM2 mesh … … 64 62 ierr = ierr + sbc_ice_alloc () ! surface forcing 65 63 ierr = ierr + thd_ice_alloc_2() ! thermodynamics 66 #if ! defined key_lim2_vp 67 ierr = ierr + lim_rhg_alloc () 68 #else 69 ierr = ierr + lim_rhg_alloc_2 () 70 #endif 64 71 65 IF( lk_mpp ) CALL mpp_sum( ierr ) 72 66 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ice_init_2 : unable to allocate ice arrays' ) -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
r2715 r3294 23 23 USE in_out_manager ! I/O manager 24 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays 25 26 USE prtctl ! Print control 26 27 … … 59 60 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 60 61 !!-------------------------------------------------------------------- 61 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released62 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace63 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - -64 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - -65 !66 62 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 67 63 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 76 72 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 77 73 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 74 REAL(wp), DIMENSION(:,:), POINTER :: zf0, zfx , zfy , zbet ! 2D workspace 75 REAL(wp), DIMENSION(:,:), POINTER :: zfm, zfxx, zfyy, zfxy ! - - 76 REAL(wp), DIMENSION(:,:), POINTER :: zalg, zalg1, zalg1q ! - - 78 77 !--------------------------------------------------------------------- 79 78 80 IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 81 CALL ctl_stop( 'lim_adv_x_2 : requested workspace arrays unavailable.' ) ; RETURN 82 ENDIF 79 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 80 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 83 81 84 82 ! Limitation of moments. … … 225 223 ENDIF 226 224 ! 227 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) &228 CALL ctl_stop( 'lim_adv_x_2 : failed to release workspace arrays.')225 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 226 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 229 227 ! 230 228 END SUBROUTINE lim_adv_x_2 … … 245 243 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 246 244 !!--------------------------------------------------------------------- 247 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released248 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace249 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - -250 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - -251 !!252 245 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 253 246 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 262 255 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 263 256 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 257 REAL(wp), DIMENSION(:,:), POINTER :: zf0, zfx , zfy , zbet ! 2D workspace 258 REAL(wp), DIMENSION(:,:), POINTER :: zfm, zfxx, zfyy, zfxy ! - - 259 REAL(wp), DIMENSION(:,:), POINTER :: zalg, zalg1, zalg1q ! - - 264 260 !--------------------------------------------------------------------- 265 261 266 IF(wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 267 CALL ctl_stop( 'lim_adv_y_2 : requested workspace arrays unavailable.' ) ; RETURN 268 END IF 262 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 263 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 269 264 270 265 ! Limitation of moments. … … 414 409 ENDIF 415 410 ! 416 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 417 CALL ctl_stop( 'lim_adv_y_2 : failed to release workspace arrays.' ) 418 END IF 411 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 412 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 419 413 ! 420 414 END SUBROUTINE lim_adv_y_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
r2715 r3294 28 28 USE lbclnk ! lateral boundary condition - MPP link 29 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays 30 31 USE in_out_manager ! I/O manager 31 32 USE prtctl ! Print control … … 58 59 !! - treatment of the case if no ice dynamic 59 60 !!--------------------------------------------------------------------- 60 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released61 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_262 USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2 ! ice-ocean velocity63 !64 61 INTEGER, INTENT(in) :: kt ! number of iteration 65 62 !! … … 67 64 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 68 65 REAL(wp) :: zcoef ! temporary scalar 69 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 70 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 66 REAL(wp), POINTER, DIMENSION(: ) :: zind ! i-averaged indicator of sea-ice 67 REAL(wp), POINTER, DIMENSION(: ) :: zmsk ! i-averaged of tmask 68 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io ! ice-ocean velocity 71 69 !!--------------------------------------------------------------------- 72 70 73 IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1,2) ) THEN 74 CALL ctl_stop( 'lim_dyn_2 : requested workspace arrays unavailable' ) ; RETURN 75 ENDIF 76 zind => wrk_1d_1(1:jpj) ! Set-up pointers to sub-arrays of workspaces 77 zmsk => wrk_1d_2(1:jpj) 71 CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 72 CALL wrk_alloc( jpj, zind , zmsk ) 78 73 79 74 IF( kt == nit000 ) CALL lim_dyn_init_2 ! Initialization (first time-step only) … … 210 205 IF(ln_ctl) CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 211 206 ! 212 IF( wrk_not_released(1, 1,2) .OR. &213 wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_dyn_2 : failed to release workspace arrays')207 CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 208 CALL wrk_dealloc( jpj, zind , zmsk ) 214 209 ! 215 210 END SUBROUTINE lim_dyn_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r2715 r3294 18 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! work arrays 20 21 USE prtctl ! Print control 21 22 USE in_out_manager ! I/O manager … … 51 52 !! ** Action : update ptab with the diffusive contribution 52 53 !!------------------------------------------------------------------- 53 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released54 USE wrk_nemo, ONLY: zflu => wrk_2d_11, zdiv => wrk_2d_13, zrlx => wrk_2d_1555 USE wrk_nemo, ONLY: zflv => wrk_2d_12, zdiv0 => wrk_2d_14, ztab0 => wrk_2d_1656 !57 54 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 58 55 ! … … 60 57 INTEGER :: its, iter, ierr ! local integers 61 58 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! local scalars 59 REAL(wp), DIMENSION(:,:), POINTER :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 62 60 CHARACTER (len=55) :: charout 63 61 !!------------------------------------------------------------------- 64 62 65 IF( wrk_in_use(2, 11,12,13,14,15,16) ) THEN 66 CALL ctl_stop( 'lim_hdf_2 : requested workspace arrays unavailable.' ) ; RETURN 67 END IF 63 CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 68 64 69 65 ! !== Initialisation ==! … … 149 145 ENDIF 150 146 ! 151 IF( wrk_not_released(2, 11,12,13,14,15,16) ) CALL ctl_stop('lim_hdf_2: failed to release workspace arrays')147 CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 152 148 ! 153 149 END SUBROUTINE lim_hdf_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
r2855 r3294 33 33 PUBLIC lim_istate_2 ! routine called by lim_init_2.F90 34 34 35 !!! ** init namelist (namiceini) **35 !!! ** init namelist (namiceini) ** 36 36 LOGICAL :: ln_limini = .FALSE. !: Ice initialization state 37 37 REAL(wp) :: ttest = 2.0 ! threshold water temperature for initial sea ice … … 70 70 IF( .NOT. ln_limini ) THEN 71 71 72 tfu(:,:) = tfreez( sn(:,:,1) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius]72 tfu(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius] 73 73 74 74 DO jj = 1, jpj 75 75 DO ji = 1, jpi 76 76 ! ! ice if sst <= t-freez + ttest 77 IF( t n(ji,jj,1) - tfu(ji,jj) >= ttest ) THEN ; zidto = 0.e0 ! no ice78 ELSE ; zidto = 1.e0 ! ice77 IF( tsn(ji,jj,1,jp_tem) - tfu(ji,jj) >= ttest ) THEN ; zidto = 0.e0 ! no ice 78 ELSE ; zidto = 1.e0 ! ice 79 79 ENDIF 80 80 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
r2715 r3294 20 20 USE in_out_manager 21 21 USE lib_mpp ! MPP library 22 #if defined key_lim2_vp 23 USE wrk_nemo ! work arrays 24 #endif 22 25 23 26 IMPLICIT NONE … … 46 49 !! ** Refer. : Deleersnijder et al. Ocean Modelling 100, 7-10 47 50 !!--------------------------------------------------------------------- 48 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released49 USE wrk_nemo, ONLY: zd2d1 => wrk_2d_1, zd1d2 => wrk_2d_250 51 INTEGER :: ji, jj ! dummy loop indices 51 52 REAL(wp) :: zusden ! local scalars … … 54 55 REAL(wp) :: zh1p , zh2p ! - - 55 56 REAL(wp) :: zd2d1p, zd1d2p ! - - 57 REAL(wp), POINTER, DIMENSION(:,:) :: zd2d1, zd1d2 ! 2D workspace 56 58 #endif 57 59 !!--------------------------------------------------------------------- 58 60 59 IF( wrk_in_use(2, 1,2) ) THEN 60 CALL ctl_stop('lim_msh_2 : requested workspace arrays unavailable') ; RETURN61 ENDIF 61 #if defined key_lim2_vp 62 CALL wrk_alloc( jpi, jpj, zd2d1, zd1d2 ) 63 #endif 62 64 63 65 IF(lwp) THEN … … 281 283 area(:,:) = e1t(:,:) * e2t(:,:) 282 284 ! 283 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_msh_2 : failed to release workspace arrays') 285 #if defined key_lim2_vp 286 CALL wrk_dealloc( jpi, jpj, zd2d1, zd1d2 ) 287 #endif 284 288 ! 285 289 END SUBROUTINE lim_msh_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
r2715 r3294 27 27 USE lbclnk ! lateral boundary condition - MPP exchanges 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays 29 30 USE in_out_manager ! I/O manager 30 31 USE prtctl ! Print control … … 34 35 35 36 PUBLIC lim_rhg_2 ! routine called by lim_dyn 36 PUBLIC lim_rhg_alloc_2 ! routine called by lim_dyn_alloc_237 37 38 38 REAL(wp) :: rzero = 0._wp ! constant value: zero 39 39 REAL(wp) :: rone = 1._wp ! and one 40 41 ! 2D workspaces for lim_rhg_2. Can't use wrk_nemo module for them because42 ! extent in 2nd dimension is > jpj.43 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zu0, zv044 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zu_n, zv_n45 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zu_a, zv_a46 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zviszeta, zviseta47 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zzfrld, zztms48 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zi1, zi2, zmasst, zpresh49 40 50 41 !! * Substitutions … … 56 47 !!---------------------------------------------------------------------- 57 48 CONTAINS 58 59 INTEGER FUNCTION lim_rhg_alloc_2()60 !!-------------------------------------------------------------------61 !! *** FUNCTION lim_rhg_alloc_2 ***62 !!-------------------------------------------------------------------63 ALLOCATE( zu0(jpi,0:jpj+1), zv0(jpi,0:jpj+1), &64 & zu_n(jpi,0:jpj+1), zv_n(jpi,0:jpj+1), &65 & zu_a(jpi,0:jpj+1), zv_a(jpi,0:jpj+1), &66 & zviszeta(jpi,0:jpj+1), zviseta(jpi,0:jpj+1), &67 & zzfrld(jpi,0:jpj+1), zztms(jpi,0:jpj+1), &68 & zi1(jpi,0:jpj+1), zi2(jpi,0:jpj+1), &69 & zmasst(jpi,0:jpj+1), zpresh(jpi,0:jpj+1), &70 & Stat=lim_rhg_alloc_2)71 !72 IF( lim_rhg_alloc_2 /= 0 ) CALL ctl_warn('lim_rhg_alloc_2 : failed to allocate arrays')73 !74 END FUNCTION lim_rhg_alloc_275 76 49 77 50 SUBROUTINE lim_rhg_2( k_j1, k_jpj ) … … 87 60 !! at I-point 88 61 !!------------------------------------------------------------------- 89 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released90 USE wrk_nemo, ONLY: zfrld => wrk_2d_1, zmass => wrk_2d_2, zcorl => wrk_2d_391 USE wrk_nemo, ONLY: za1ct => wrk_2d_4, za2ct => wrk_2d_5, zresr => wrk_2d_692 USE wrk_nemo, ONLY: zc1u => wrk_2d_7, zc1v => wrk_2d_8, zc2u => wrk_2d_993 USE wrk_nemo, ONLY: zc2v => wrk_2d_10, zsang => wrk_2d_1194 !!95 62 INTEGER, INTENT(in) :: k_j1 ! southern j-index for ice computation 96 63 INTEGER, INTENT(in) :: k_jpj ! northern j-index for ice computation … … 113 80 REAL(wp) :: zs21_11, zs21_12, zs21_21, zs21_22 114 81 REAL(wp) :: zs22_11, zs22_12, zs22_21, zs22_22 82 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld, zmass, zcorl 83 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct, za2ct, zresr 84 REAL(wp), POINTER, DIMENSION(:,:) :: zc1u, zc1v, zc2u, zc2v 85 REAL(wp), POINTER, DIMENSION(:,:) :: zsang 86 REAL(wp), POINTER, DIMENSION(:,:) :: zu0, zv0 87 REAL(wp), POINTER, DIMENSION(:,:) :: zu_n, zv_n 88 REAL(wp), POINTER, DIMENSION(:,:) :: zu_a, zv_a 89 REAL(wp), POINTER, DIMENSION(:,:) :: zviszeta, zviseta 90 REAL(wp), POINTER, DIMENSION(:,:) :: zzfrld, zztms 91 REAL(wp), POINTER, DIMENSION(:,:) :: zi1, zi2, zmasst, zpresh 115 92 !!------------------------------------------------------------------- 116 93 94 CALL wrk_alloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr ) 95 CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang ) 96 CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 97 CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) 98 117 99 ! Store initial velocities 118 100 ! ---------------- … … 592 574 ENDIF 593 575 576 CALL wrk_dealloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr ) 577 CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang ) 578 CALL wrk_dealloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 579 CALL wrk_dealloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) 580 594 581 END SUBROUTINE lim_rhg_2 595 582 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r2715 r3294 27 27 USE sbc_ice ! surface boundary condition: ice 28 28 USE sbc_oce ! surface boundary condition: ocean 29 USE sbccpl 29 30 30 31 USE albedo ! albedo parameters 31 32 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 32 33 USE lib_mpp ! MPP library 34 USE wrk_nemo ! work arrays 33 35 USE in_out_manager ! I/O manager 34 36 USE diaar5, ONLY : lk_diaar5 … … 50 52 ! 51 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case 52 53 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 54 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s] … … 100 101 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 101 102 !!--------------------------------------------------------------------- 102 USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use103 USE wrk_nemo, ONLY: zqnsoce => wrk_2d_1 ! 2D workspace104 USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5105 103 INTEGER, INTENT(in) :: kt ! number of iteration 106 104 !! … … 111 109 REAL(wp) :: zqsr, zqns, zfm ! local scalars 112 110 REAL(wp) :: zinda, zfons, zemp ! - - 111 REAL(wp), POINTER, DIMENSION(:,:) :: zqnsoce ! 2D workspace 113 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 114 113 !!--------------------------------------------------------------------- 115 114 116 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 4,5) )THEN 117 CALL ctl_stop('lim_sbc_flx_2 : requested workspace arrays unavailable') ; RETURN 118 ENDIF 119 zalb => wrk_3d_4(:,:,1:1) ! Set-up pointers to sub-arrays of 3d workspaces 120 zalbp => wrk_3d_5(:,:,1:1) 115 CALL wrk_alloc( jpi, jpj, zqnsoce ) 116 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 121 117 122 118 !------------------------------------------! … … 234 230 !-----------------------------------------------! 235 231 236 IF( lk_cpl ) THEN ! coupled case 237 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 238 ! ! Computation of snow/ice and ocean albedo 239 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 240 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 241 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 242 ENDIF 232 #if defined key_coupled 233 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 234 ht_i(:,:,1) = hicif(:,:) 235 ht_s(:,:,1) = hsnif(:,:) 236 a_i(:,:,1) = fr_i(:,:) 237 ! ! Computation of snow/ice and ocean albedo 238 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 239 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 240 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 241 #endif 243 242 244 243 IF(ln_ctl) THEN ! control print … … 250 249 ENDIF 251 250 ! 252 IF( wrk_not_released(2, 1) .OR. &253 wrk_not_released(3, 4,5) ) CALL ctl_stop('lim_sbc_flx_2 : failed to release workspace arrays')251 CALL wrk_dealloc( jpi, jpj, zqnsoce ) 252 CALL wrk_dealloc( jpi, jpj, 1, zalb, zalbp ) 254 253 ! 255 254 END SUBROUTINE lim_sbc_flx_2 … … 282 281 !! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes 283 282 !!--------------------------------------------------------------------- 284 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released285 USE wrk_nemo, ONLY: ztio_u => wrk_2d_1, ztio_v => wrk_2d_2 ! ocean stress below sea-ice286 283 INTEGER , INTENT(in) :: kt ! ocean time-step index 287 284 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents … … 291 288 REAL(wp) :: zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi ! - - 292 289 REAL(wp) :: zsang, zumt ! - - 290 REAL(wp), POINTER, DIMENSION(:,:) :: ztio_u, ztio_v ! ocean stress below sea-ice 293 291 !!--------------------------------------------------------------------- 294 292 ! 295 IF( wrk_in_use(2, 1,2) ) THEN 296 CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.') ; RETURN 297 ENDIF 293 CALL wrk_alloc( jpi, jpj, ztio_u, ztio_v ) 298 294 ! 299 295 SELECT CASE( cp_ice_msh ) … … 409 405 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 410 406 ! 411 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays')407 CALL wrk_dealloc( jpi, jpj, ztio_u, ztio_v ) 412 408 ! 413 409 END SUBROUTINE lim_sbc_tau_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r2715 r3294 22 22 USE in_out_manager ! I/O manager 23 23 USE lib_mpp 24 USE wrk_nemo ! work arrays 24 25 USE iom ! IOM library 25 26 USE ice_2 ! LIM sea-ice variables … … 75 76 !! References : Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 76 77 !!--------------------------------------------------------------------- 77 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released78 USE wrk_nemo, ONLY: ztmp => wrk_2d_1, & ! 2D workspace79 zqlbsbq => wrk_2d_2, & ! link with lead energy budget qldif80 zlicegr => wrk_2d_3 ! link with lateral ice growth81 USE wrk_nemo, ONLY: zmsk => wrk_3d_4 ! 3D workspace82 USE wrk_nemo, ONLY: zdvosif => wrk_2d_4, & !: Variation of volume at surface83 zdvobif => wrk_2d_5, & !: Variation of ice volume at the bottom ice (outputs only)84 zdvolif => wrk_2d_6, & !: Total variation of ice volume (outputs only)85 zdvonif => wrk_2d_7, & !: Surface accretion Snow to Ice transformation (outputs only)86 zdvomif => wrk_2d_8, & !: Bottom variation of ice volume due to melting (outputs only)87 zu_imasstr =>wrk_2d_9, & !: Sea-ice transport along i-axis at U-point (outputs only)88 zv_imasstr =>wrk_2d_10 !: Sea-ice transport along j-axis at V-point (outputs only)89 !!90 78 INTEGER, INTENT(in) :: kt ! number of iteration 91 79 !! … … 110 98 REAL(wp) :: zrhoij, zrhoijm1 ! temporary scalars 111 99 REAL(wp) :: zztmp ! temporary scalars within a loop 112 !!$ REAL(wp), DIMENSION(jpi,jpj) :: firic !: IR flux over the ice (outputs only) 113 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fcsic !: Sensible heat flux over the ice (outputs only) 114 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fleic !: Latent heat flux over the ice (outputs only) 115 !!$ REAL(wp), DIMENSION(jpi,jpj) :: qlatic !: latent flux (outputs only) 100 REAL(wp), POINTER, DIMENSION(:,:) :: ztmp ! 2D workspace 101 REAL(wp), POINTER, DIMENSION(:,:) :: zqlbsbq ! link with lead energy budget qldif 102 REAL(wp), POINTER, DIMENSION(:,:) :: zlicegr ! link with lateral ice growth 103 !!$ REAL(wp), DIMENSION(:,:) :: firic ! IR flux over the ice (outputs only) 104 !!$ REAL(wp), DIMENSION(:,:) :: fcsic ! Sensible heat flux over the ice (outputs only) 105 !!$ REAL(wp), DIMENSION(:,:) :: fleic ! Latent heat flux over the ice (outputs only) 106 !!$ REAL(wp), DIMENSION(:,:) :: qlatic ! latent flux (outputs only) 107 REAL(wp), POINTER, DIMENSION(:,:) :: zdvosif ! Variation of volume at surface (outputs only) 108 REAL(wp), POINTER, DIMENSION(:,:) :: zdvobif ! Variation of ice volume at the bottom ice (outputs only) 109 REAL(wp), POINTER, DIMENSION(:,:) :: zdvolif ! Total variation of ice volume (outputs only) 110 REAL(wp), POINTER, DIMENSION(:,:) :: zdvonif ! Surface accretion Snow to Ice transformation (outputs only) 111 REAL(wp), POINTER, DIMENSION(:,:) :: zdvomif ! Bottom variation of ice volume due to melting (outputs only) 112 REAL(wp), POINTER, DIMENSION(:,:) :: zu_imasstr ! Sea-ice transport along i-axis at U-point (outputs only) 113 REAL(wp), POINTER, DIMENSION(:,:) :: zv_imasstr ! Sea-ice transport along j-axis at V-point (outputs only) 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmsk ! 3D workspace 116 115 !!------------------------------------------------------------------- 117 116 118 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10) .OR. & 119 wrk_in_use(3, 4) ) THEN 120 CALL ctl_stop('lim_thd_2 : requested workspace arrays unavailable') ; RETURN 121 ENDIF 117 CALL wrk_alloc( jpi, jpj, ztmp, zqlbsbq, zlicegr, zdvosif, zdvobif, zdvolif, zdvonif, zdvomif, zu_imasstr, zv_imasstr ) 118 CALL wrk_alloc( jpi, jpj, jpk, zmsk ) 122 119 123 120 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) … … 520 517 ENDIF 521 518 ! 522 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10) .OR. & 523 wrk_not_released(3, 4) ) THEN 524 CALL ctl_stop('lim_thd_2 : failed to release workspace arrays') 525 ENDIF 519 CALL wrk_dealloc( jpi, jpj, ztmp, zqlbsbq, zlicegr, zdvosif, zdvobif, zdvolif, zdvonif, zdvomif, zu_imasstr, zv_imasstr ) 520 CALL wrk_dealloc( jpi, jpj, jpk, zmsk ) 526 521 ! 527 522 END SUBROUTINE lim_thd_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
r2715 r3294 15 15 USE limistate_2 16 16 USE lib_mpp ! MPP library 17 USE wrk_nemo ! work arrays 17 18 18 19 IMPLICIT NONE … … 68 69 !! 2.0 ! 02-08 (C. Ethe, G. Madec) F90, mpp 69 70 !!------------------------------------------------------------------- 70 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released71 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_5, wrk_1d_672 !73 71 INTEGER , INTENT(IN):: & 74 72 kideb , & ! start point on which the the computation is applied … … 81 79 iiceform , & ! 1 = ice formed ; 0 = no ice formed 82 80 ihemis ! dummy indice 83 REAL(wp), POINTER, DIMENSION(:) :: & 84 zqbgow , & ! heat budget of the open water (negative) 85 zfrl_old , & ! previous sea/ice fraction 86 zhice_old , & ! previous ice thickness 87 zhice0 , & ! thickness of newly formed ice in leads 88 zfrlmin , & ! minimum fraction for leads 89 zdhicbot ! part of thickness of newly formed ice in leads which 81 REAL(wp), POINTER, DIMENSION(:) :: zqbgow ! heat budget of the open water (negative) 82 REAL(wp), POINTER, DIMENSION(:) :: zfrl_old ! previous sea/ice fraction 83 REAL(wp), POINTER, DIMENSION(:) :: zhice_old ! previous ice thickness 84 REAL(wp), POINTER, DIMENSION(:) :: zhice0 ! thickness of newly formed ice in leads 85 REAL(wp), POINTER, DIMENSION(:) :: zfrlmin ! minimum fraction for leads 86 REAL(wp), POINTER, DIMENSION(:) :: zdhicbot ! part of thickness of newly formed ice in leads which 90 87 ! has been already used in transport for example 91 88 REAL(wp) :: & … … 104 101 !!--------------------------------------------------------------------- 105 102 106 IF( wrk_in_use(1, 1,2,3,4,5,6) ) THEN 107 CALL ctl_stop('lim_thd_lac_2 : requestead workspace arrays unavailable') ; RETURN 108 ENDIF 109 ! Set-up pointers to sub-arrays of workspace arrays 110 zqbgow => wrk_1d_1(1:jpij) 111 zfrl_old => wrk_1d_2(1:jpij) 112 zhice_old => wrk_1d_3(1:jpij) 113 zhice0 => wrk_1d_4(1:jpij) 114 zfrlmin => wrk_1d_5(1:jpij) 115 zdhicbot => wrk_1d_6(1:jpij) 103 CALL wrk_alloc( jpij, zqbgow, zfrl_old, zhice_old, zhice0, zfrlmin, zdhicbot ) 116 104 117 105 !-------------------------------------------------------------- … … 232 220 END DO 233 221 234 IF( wrk_not_released(1, 1,2,3,4,5,6) ) CALL ctl_stop('lim_thd_lac_2 : failed to release workspace arrays.')222 CALL wrk_dealloc( jpij, zqbgow, zfrl_old, zhice_old, zhice0, zfrlmin, zdhicbot ) 235 223 ! 236 224 END SUBROUTINE lim_thd_lac_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r2715 r3294 20 20 USE in_out_manager 21 21 USE lib_mpp ! MPP library 22 USE wrk_nemo ! work arrays 22 23 USE cpl_oasis3, ONLY : lk_cpl 23 24 … … 67 68 !! Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268 68 69 !!------------------------------------------------------------------ 69 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released70 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_571 USE wrk_nemo, ONLY: wrk_1d_6, wrk_1d_7, wrk_1d_8, wrk_1d_9, wrk_1d_1072 USE wrk_nemo, ONLY: wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_1573 USE wrk_nemo, ONLY: wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_2074 USE wrk_nemo, ONLY: wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_2575 USE wrk_nemo, ONLY: wrk_1d_26, wrk_1d_2776 !!77 70 INTEGER, INTENT(in) :: kideb ! Start point on which the the computation is applied 78 71 INTEGER, INTENT(in) :: kiut ! End point on which the the computation is applied … … 81 74 REAL(wp), POINTER, DIMENSION(:) :: zqcmlts ! energy due to surface melting 82 75 REAL(wp), POINTER, DIMENSION(:) :: zqcmltb ! energy due to bottom melting 83 REAL(wp), POINTER, DIMENSION(:) :: & 84 ztsmlt & ! snow/ice surface melting temperature 85 ,ztbif & ! int. temp. at the mid-point of the 1st layer of the snow/ice sys. 86 ,zksn & ! effective conductivity of snow 87 ,zkic & ! effective conductivity of ice 88 ,zksndh & ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys. 89 , zfcsu & ! conductive heat flux at the surface of the snow/ice system 90 , zfcsudt & ! = zfcsu * dt 91 , zi0 & ! frac. of the net SW rad. which is not absorbed at the surface 92 , z1mi0 & ! fraction of the net SW radiation absorbed at the surface 93 , zqmax & ! maximum energy stored in brine pockets 94 , zrcpdt & ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 95 , zts_old & ! previous surface temperature 96 , zidsn , z1midsn , zidsnic ! tempory variables 97 REAL(wp), POINTER, DIMENSION(:) :: & 98 zfnet & ! net heat flux at the top surface( incl. conductive heat flux) 99 , zsprecip & ! snow accumulation 100 , zhsnw_old & ! previous snow thickness 101 , zdhictop & ! change in ice thickness due to top surf ablation/accretion 102 , zdhicbot & ! change in ice thickness due to bottom surf abl/acc 103 , zqsup & ! energy transmitted to ocean (coming from top surf abl/acc) 104 , zqocea & ! energy transmitted to ocean (coming from bottom sur abl/acc) 105 , zfrl_old & ! previous sea/ice fraction 106 , zfrld_1d & ! new sea/ice fraction 107 , zep ! internal temperature of the 2nd layer of the snow/ice system 108 REAL(wp), DIMENSION(3) :: & 76 REAL(wp), POINTER, DIMENSION(:) :: ztsmlt ! snow/ice surface melting temperature 77 REAL(wp), POINTER, DIMENSION(:) :: ztbif ! int. temp. at the mid-point of the 1st layer of the snow/ice sys. 78 REAL(wp), POINTER, DIMENSION(:) :: zksn ! effective conductivity of snow 79 REAL(wp), POINTER, DIMENSION(:) :: zkic ! effective conductivity of ice 80 REAL(wp), POINTER, DIMENSION(:) :: zksndh ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys. 81 REAL(wp), POINTER, DIMENSION(:) :: zfcsu ! conductive heat flux at the surface of the snow/ice system 82 REAL(wp), POINTER, DIMENSION(:) :: zfcsudt ! = zfcsu * dt 83 REAL(wp), POINTER, DIMENSION(:) :: zi0 ! frac. of the net SW rad. which is not absorbed at the surface 84 REAL(wp), POINTER, DIMENSION(:) :: z1mi0 ! fraction of the net SW radiation absorbed at the surface 85 REAL(wp), POINTER, DIMENSION(:) :: zqmax ! maximum energy stored in brine pockets 86 REAL(wp), POINTER, DIMENSION(:) :: zrcpdt ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 87 REAL(wp), POINTER, DIMENSION(:) :: zts_old ! previous surface temperature 88 REAL(wp), POINTER, DIMENSION(:) :: zidsn , z1midsn , zidsnic ! tempory variables 89 REAL(wp), POINTER, DIMENSION(:) :: zfnet ! net heat flux at the top surface( incl. conductive heat flux) 90 REAL(wp), POINTER, DIMENSION(:) :: zsprecip ! snow accumulation 91 REAL(wp), POINTER, DIMENSION(:) :: zhsnw_old ! previous snow thickness 92 REAL(wp), POINTER, DIMENSION(:) :: zdhictop ! change in ice thickness due to top surf ablation/accretion 93 REAL(wp), POINTER, DIMENSION(:) :: zdhicbot ! change in ice thickness due to bottom surf abl/acc 94 REAL(wp), POINTER, DIMENSION(:) :: zqsup ! energy transmitted to ocean (coming from top surf abl/acc) 95 REAL(wp), POINTER, DIMENSION(:) :: zqocea ! energy transmitted to ocean (coming from bottom sur abl/acc) 96 REAL(wp), POINTER, DIMENSION(:) :: zfrl_old ! previous sea/ice fraction 97 REAL(wp), POINTER, DIMENSION(:) :: zfrld_1d ! new sea/ice fraction 98 REAL(wp), POINTER, DIMENSION(:) :: zep ! internal temperature of the 2nd layer of the snow/ice system 99 REAL(wp), DIMENSION(3) :: & 109 100 zplediag & ! principle diagonal, subdiag. and supdiag. of the 110 101 , zsubdiag & ! tri-diagonal matrix coming from the computation … … 166 157 , zihsn, zidhb, zihic, zihe, zihq, ziexp, ziqf, zihnf, zibmlt, ziqr, zihgnew, zind 167 158 !!---------------------------------------------------------------------- 168 169 IF(wrk_in_use(1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 170 & 11,12,13,14,15,16,17,18,19,20, & 171 & 21,22,23,24,25,26,27) ) THEN 172 CALL ctl_stop('lim_thd_zdf_2 : requested workspace arrays unavailable') ; RETURN 173 ENDIF 174 175 ztsmlt => wrk_1d_1(1:jpij) 176 ztbif => wrk_1d_2(1:jpij) 177 zksn => wrk_1d_3(1:jpij) 178 zkic => wrk_1d_4(1:jpij) 179 zksndh => wrk_1d_5(1:jpij) 180 zfcsu => wrk_1d_6(1:jpij) 181 zfcsudt => wrk_1d_7(1:jpij) 182 zi0 => wrk_1d_8(1:jpij) 183 z1mi0 => wrk_1d_9(1:jpij) 184 zqmax => wrk_1d_10(1:jpij) 185 zrcpdt => wrk_1d_11(1:jpij) 186 zts_old => wrk_1d_12(1:jpij) 187 zidsn => wrk_1d_13(1:jpij) 188 z1midsn => wrk_1d_14(1:jpij) 189 zidsnic => wrk_1d_15(1:jpij) 190 191 zfnet => wrk_1d_16(1:jpij) 192 zsprecip => wrk_1d_17(1:jpij) 193 zhsnw_old => wrk_1d_18(1:jpij) 194 zdhictop => wrk_1d_19(1:jpij) 195 zdhicbot => wrk_1d_20(1:jpij) 196 zqsup => wrk_1d_21(1:jpij) 197 zqocea => wrk_1d_22(1:jpij) 198 zfrl_old => wrk_1d_23(1:jpij) 199 zfrld_1d => wrk_1d_24(1:jpij) 200 zep => wrk_1d_25(1:jpij) 201 202 zqcmlts => wrk_1d_26(1:jpij) 203 zqcmltb => wrk_1d_27(1:jpij) 159 CALL wrk_alloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax ) 160 CALL wrk_alloc( jpij, zrcpdt, zts_old, zidsn , z1midsn , zidsnic, zfnet , zsprecip, zhsnw_old, zdhictop, zdhicbot ) 161 CALL wrk_alloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep , zqcmlts, zqcmltb ) 204 162 205 163 !----------------------------------------------------------------------- … … 372 330 DO ji = kideb, kiut 373 331 sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 332 qla_ice_1d(ji) = -9999. ! default definition, not used as parsub = 0. in this case 374 333 zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) ) 375 334 END DO … … 805 764 END DO 806 765 ! 807 IF( wrk_not_released(1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 808 & 11,12,13,14,15,16,17,18,19,20, & 809 & 21,22,23,24,25,26,27) ) & 810 CALL ctl_stop('lim_thd_zdf_2 : failed to release workspace arrays.') 766 CALL wrk_dealloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax ) 767 CALL wrk_dealloc( jpij, zrcpdt, zts_old, zidsn , z1midsn , zidsnic, zfnet , zsprecip, zhsnw_old, zdhictop, zdhicbot ) 768 CALL wrk_dealloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep , zqcmlts, zqcmltb ) 811 769 ! 812 770 END SUBROUTINE lim_thd_zdf_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
r2715 r3294 27 27 USE lbclnk ! lateral boundary conditions -- MPP exchanges 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays 29 30 30 31 IMPLICIT NONE … … 63 64 !! ** action : 64 65 !!--------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released66 USE wrk_nemo, ONLY: zui_u => wrk_2d_1, zvi_v => wrk_2d_2, zsm => wrk_2d_367 USE wrk_nemo, ONLY: zs0ice => wrk_2d_4, zs0sn => wrk_2d_5, zs0a => wrk_2d_668 USE wrk_nemo, ONLY: zs0c0 => wrk_2d_7, zs0c1 => wrk_2d_8, zs0c2 => wrk_2d_9, &69 zs0st => wrk_2d_1070 !!71 66 INTEGER, INTENT(in) :: kt ! number of iteration 72 67 !! … … 77 72 REAL(wp) :: zvbord , zcfl , zusnit ! - - 78 73 REAL(wp) :: zrtt , ztsn , ztic1 , ztic2 ! - - 74 REAL(wp), POINTER, DIMENSION(:,:) :: zui_u , zvi_v , zsm ! 2D workspace 75 REAL(wp), POINTER, DIMENSION(:,:) :: zs0ice, zs0sn , zs0a ! - - 76 REAL(wp), POINTER, DIMENSION(:,:) :: zs0c0 , zs0c1 , zs0c2 , zs0st ! - - 79 77 !--------------------------------------------------------------------- 80 78 81 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10) ) THEN 82 CALL ctl_stop('lim_trp_2 : requested workspace arrays unavailable') ; RETURN 83 ENDIF 79 CALL wrk_alloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st ) 84 80 85 81 IF( kt == nit000 ) CALL lim_trp_init_2 ! Initialization (first time-step only) … … 273 269 ENDIF 274 270 ! 275 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10) ) CALL ctl_stop('lim_trp_2 : failed to release workspace arrays')271 CALL wrk_dealloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st ) 276 272 ! 277 273 END SUBROUTINE lim_trp_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r2715 r3294 30 30 USE in_out_manager 31 31 USE lib_mpp ! MPP library 32 USE wrk_nemo ! work arrays 32 33 USE iom 33 34 USE ioipsl … … 100 101 !! of a day 101 102 !!------------------------------------------------------------------- 102 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released103 USE wrk_nemo, ONLY: zfield => wrk_2d_1104 !!105 103 INTEGER, INTENT(in) :: kt ! number of iteration 106 104 !! … … 110 108 & zindh, zinda, zindb, ztmu 111 109 REAL(wp), DIMENSION(1) :: zdept 112 !!------------------------------------------------------------------- 113 114 IF( wrk_in_use(2, 1) ) THEN 115 CALL ctl_stop('lim_wri_2 : requested workspace array unavailable') ; RETURN 116 ENDIF 110 REAL(wp), POINTER, DIMENSION(:,:) :: zfield 111 !!------------------------------------------------------------------- 112 113 CALL wrk_alloc( jpi, jpj, zfield ) 117 114 !--------------------! 118 115 IF( kt == nit000 ) THEN ! Initialisation ! … … 207 204 IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice ) 208 205 209 IF( wrk_not_released(2, 1) ) CALL ctl_stop('lim_wri_2 : failed to release workspace array.')206 CALL wrk_dealloc( jpi, jpj, zfield ) 210 207 ! 211 208 END SUBROUTINE lim_wri_2 212 209 210 # endif 213 211 214 212 SUBROUTINE lim_wri_init_2 … … 297 295 END SUBROUTINE lim_wri_init_2 298 296 299 # endif300 297 #endif 301 298 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r2715 r3294 22 22 INTEGER , SAVE, DIMENSION(:), ALLOCATABLE :: nsubindex !: subindex to be saved 23 23 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 24 REAL(wp), SAVE, DIMENSION( jpi,jpj,jpnoumax):: rcmoy24 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy 25 25 26 26 INTEGER :: ji, jj, jf, ii ! dummy loop indices and array index 27 27 INTEGER :: iyear, iday, imon ! 28 INTEGER :: ialloc 28 29 CHARACTER(LEN=80) :: clname, cltext, clmode 29 30 REAL(wp), DIMENSION(1) :: zdept … … 39 40 #endif 40 41 !!------------------------------------------------------------------- 42 IF( .NOT. ALLOCATED(rcmoy) )THEN 43 ALLOCATE(rcmoy(jpi,jpj,jpnoumax), STAT=ialloc ) 44 ! 45 IF( lk_mpp ) CALL mpp_sum ( ialloc ) 46 IF( ialloc /= 0 ) CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays') 47 rcmoy(:,:,:) = 0._wp 48 ENDIF 41 49 42 50 IF( kt == nit000 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
