Changeset 7910 for branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO
- Timestamp:
- 2017-04-13T16:21:08+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO
- Files:
-
- 174 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
r3625 r7910 23 23 USE in_out_manager ! I/O manager 24 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays26 25 USE prtctl ! Print control 27 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 73 72 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 74 73 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 75 REAL(wp), DIMENSION( :,:), POINTER:: zf0, zfx , zfy , zbet ! 2D workspace76 REAL(wp), DIMENSION( :,:), POINTER:: zfm, zfxx, zfyy, zfxy ! - -77 REAL(wp), DIMENSION( :,:), POINTER:: zalg, zalg1, zalg1q ! - -74 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace 75 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - - 76 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 78 77 !--------------------------------------------------------------------- 79 78 80 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )81 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )82 79 83 80 ! Limitation of moments. … … 224 221 ENDIF 225 222 ! 226 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )227 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )228 223 ! 229 224 END SUBROUTINE lim_adv_x_2 … … 256 251 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 257 252 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 258 REAL(wp), DIMENSION( :,:), POINTER:: zf0, zfx , zfy , zbet ! 2D workspace259 REAL(wp), DIMENSION( :,:), POINTER:: zfm, zfxx, zfyy, zfxy ! - -260 REAL(wp), DIMENSION( :,:), POINTER:: zalg, zalg1, zalg1q ! - -253 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace 254 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - - 255 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 261 256 !--------------------------------------------------------------------- 262 257 263 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )264 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )265 258 266 259 ! Limitation of moments. … … 410 403 ENDIF 411 404 ! 412 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )413 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )414 405 ! 415 406 END SUBROUTINE lim_adv_y_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
r7646 r7910 28 28 USE lbclnk ! lateral boundary condition - MPP link 29 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays31 30 USE in_out_manager ! I/O manager 32 31 USE prtctl ! Print control … … 65 64 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 66 65 REAL(wp) :: zcoef ! temporary scalar 67 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice68 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask69 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io ! ice-ocean velocity66 REAL(wp), DIMENSION(jpj) :: zind ! i-averaged indicator of sea-ice 67 REAL(wp), DIMENSION(jpj) :: zmsk ! i-averaged of tmask 68 REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io ! ice-ocean velocity 70 69 !!--------------------------------------------------------------------- 71 70 72 CALL wrk_alloc( jpi, jpj, zu_io, zv_io )73 CALL wrk_alloc( jpj, zind , zmsk )74 71 75 72 IF( kt == nit000 ) CALL lim_dyn_init_2 ! Initialization (first time-step only) … … 206 203 IF(ln_ctl) CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 207 204 ! 208 CALL wrk_dealloc( jpi, jpj, zu_io, zv_io )209 CALL wrk_dealloc( jpj, zind , zmsk )210 205 ! 211 206 END SUBROUTINE lim_dyn_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r4990 r7910 18 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! work arrays21 20 USE prtctl ! Print control 22 21 USE in_out_manager ! I/O manager … … 58 57 INTEGER :: its, iter, ierr ! local integers 59 58 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! local scalars 60 REAL(wp), DIMENSION( :,:), POINTER:: zrlx, zflu, zflv, zdiv0, zdiv, ztab059 REAL(wp), DIMENSION(jpi,jpj) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 61 60 CHARACTER (len=55) :: charout 62 61 !!------------------------------------------------------------------- 63 62 64 CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 )65 63 66 64 ! !== Initialisation ==! … … 144 142 ENDIF 145 143 ! 146 CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 )147 144 ! 148 145 END SUBROUTINE lim_hdf_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
r7646 r7910 21 21 USE lib_mpp ! MPP library 22 22 #if defined key_lim2_vp 23 USE wrk_nemo ! work arrays24 23 #endif 25 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 56 55 REAL(wp) :: zh1p , zh2p ! - - 57 56 REAL(wp) :: zd2d1p, zd1d2p ! - - 58 REAL(wp), POINTER, DIMENSION(:,:) :: zd2d1, zd1d2 ! 2D workspace57 REAL(wp), DIMENSION(jpi,jpj) :: zd2d1, zd1d2 ! 2D workspace 59 58 #endif 60 59 !!--------------------------------------------------------------------- 61 60 62 61 #if defined key_lim2_vp 63 CALL wrk_alloc( jpi, jpj, zd2d1, zd1d2 )64 62 #endif 65 63 … … 280 278 ! 281 279 #if defined key_lim2_vp 282 CALL wrk_dealloc( jpi, jpj, zd2d1, zd1d2 )283 280 #endif 284 281 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90
r7647 r7910 34 34 USE lbclnk ! Lateral Boundary Condition / MPP link 35 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! work arrays37 36 USE in_out_manager ! I/O manager 38 37 USE prtctl ! Print control … … 131 130 REAL(wp) :: zintb, zintn ! dummy argument 132 131 133 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength134 REAL(wp), POINTER, DIMENSION(:,:) :: zpreshc ! Ice strength on grid cell corners (zpreshc)135 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld1, zfrld2 ! lead fraction on U/V points136 REAL(wp), POINTER, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points137 REAL(wp), POINTER, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points138 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays139 REAL(wp), POINTER, DIMENSION(:,:) :: v_oce1 ! ocean u/v component on U points140 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2 ! ocean u/v component on V points141 REAL(wp), POINTER, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point142 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses143 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! mask ocean grid points132 REAL(wp), DIMENSION(jpi,jpj) :: zpresh ! temporary array for ice strength 133 REAL(wp), DIMENSION(jpi,jpj) :: zpreshc ! Ice strength on grid cell corners (zpreshc) 134 REAL(wp), DIMENSION(jpi,jpj) :: zfrld1, zfrld2 ! lead fraction on U/V points 135 REAL(wp), DIMENSION(jpi,jpj) :: zmass1, zmass2 ! ice/snow mass on U/V points 136 REAL(wp), DIMENSION(jpi,jpj) :: zcorl1, zcorl2 ! coriolis parameter on U/V points 137 REAL(wp), DIMENSION(jpi,jpj) :: za1ct , za2ct ! temporary arrays 138 REAL(wp), DIMENSION(jpi,jpj) :: v_oce1 ! ocean u/v component on U points 139 REAL(wp), DIMENSION(jpi,jpj) :: u_oce2 ! ocean u/v component on V points 140 REAL(wp), DIMENSION(jpi,jpj) :: u_ice2, v_ice1 ! ice u/v component on V/U point 141 REAL(wp), DIMENSION(jpi,jpj) :: zf1 , zf2 ! arrays for internal stresses 142 REAL(wp), DIMENSION(jpi,jpj) :: zmask ! mask ocean grid points 144 143 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdt ! tension at centre of grid cells146 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! Shear on northeast corner of grid cells147 REAL(wp), POINTER, DIMENSION(:,:) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs2148 REAL(wp), POINTER, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs12149 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity150 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope:144 REAL(wp), DIMENSION(jpi,jpj) :: zdt ! tension at centre of grid cells 145 REAL(wp), DIMENSION(jpi,jpj) :: zds ! Shear on northeast corner of grid cells 146 REAL(wp), DIMENSION(jpi,jpj) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs2 147 REAL(wp), DIMENSION(jpi,jpj) :: zs12 ! Non-diagonal stress tensor component zs12 148 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! Local error on velocity 149 REAL(wp), DIMENSION(jpi,jpj) :: zpice ! array used for the calculation of ice surface slope: 151 150 ! ocean surface (ssh_m) if ice is not embedded 152 151 ! ice top surface if ice is embedded … … 156 155 !!------------------------------------------------------------------- 157 156 158 CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )159 CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask )160 CALL wrk_alloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds )161 CALL wrk_alloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice )162 157 163 158 #if defined key_lim2 && ! defined key_lim2_vp … … 687 682 ENDIF 688 683 ! 689 CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )690 CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask )691 CALL wrk_dealloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds )692 CALL wrk_dealloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice )693 684 694 685 END SUBROUTINE lim_rhg -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
r7646 r7910 27 27 USE lbclnk ! lateral boundary condition - MPP exchanges 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays30 29 USE in_out_manager ! I/O manager 31 30 USE prtctl ! Print control … … 86 85 REAL(wp) :: zs22_11, zs22_12, zs22_21, zs22_22 87 86 REAL(wp) :: zintb, zintn 88 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld, zmass, zcorl89 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct, za2ct, zresr90 REAL(wp), POINTER, DIMENSION(:,:) :: zc1u, zc1v, zc2u, zc2v91 REAL(wp), POINTER, DIMENSION(:,:) :: zsang, zpice92 REAL(wp), POINTER, DIMENSION(:,:) :: zu0, zv093 REAL(wp), POINTER, DIMENSION(:,:) :: zu_n, zv_n94 REAL(wp), POINTER, DIMENSION(:,:) :: zu_a, zv_a95 REAL(wp), POINTER, DIMENSION(:,:) :: zviszeta, zviseta96 REAL(wp), POINTER, DIMENSION(:,:) :: zzfrld, zztms97 REAL(wp), POINTER, DIMENSION(:,:) :: zi1, zi2, zmasst, zpresh87 REAL(wp), DIMENSION(jpi,jpj) :: zfrld, zmass, zcorl 88 REAL(wp), DIMENSION(jpi,jpj) :: za1ct, za2ct, zresr 89 REAL(wp), DIMENSION(jpi,jpj) :: zc1u, zc1v, zc2u, zc2v 90 REAL(wp), DIMENSION(jpi,jpj) :: zsang, zpice 91 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zu0, zv0 92 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zu_n, zv_n 93 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zu_a, zv_a 94 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zviszeta, zviseta 95 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zzfrld, zztms 96 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zi1, zi2, zmasst, zpresh 98 97 !!------------------------------------------------------------------- 99 98 100 CALL wrk_alloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )101 CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )102 CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )103 CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )104 99 105 100 ! Store initial velocities … … 600 595 ENDIF 601 596 602 CALL wrk_dealloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )603 CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )604 CALL wrk_dealloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )605 CALL wrk_dealloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )606 597 607 598 END SUBROUTINE lim_rhg_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r7646 r7910 35 35 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 36 36 USE lib_mpp ! MPP library 37 USE wrk_nemo ! work arrays38 37 USE in_out_manager ! I/O manager 39 38 USE iom ! I/O library … … 111 110 REAL(wp) :: zemp_snw, zqhc, zcd ! - - 112 111 REAL(wp) :: zswitch ! - - 113 REAL(wp), POINTER, DIMENSION(:,:) :: zqnsoce ! 2D workspace114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace112 REAL(wp), DIMENSION(jpi,jpj) :: zqnsoce ! 2D workspace 113 REAL(wp), DIMENSION(jpi,jpj,1) :: zalb, zalbp ! 2D/3D workspace 115 114 !!--------------------------------------------------------------------- 116 115 ! 117 CALL wrk_alloc( jpi, jpj, zqnsoce )118 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp )119 116 ! 120 117 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option … … 269 266 ENDIF 270 267 ! 271 CALL wrk_dealloc( jpi, jpj, zqnsoce )272 CALL wrk_dealloc( jpi, jpj, 1, zalb, zalbp )273 268 ! 274 269 END SUBROUTINE lim_sbc_flx_2 … … 308 303 REAL(wp) :: zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi ! - - 309 304 REAL(wp) :: zsang, zumt ! - - 310 REAL(wp), POINTER, DIMENSION(:,:) :: ztio_u, ztio_v ! ocean stress below sea-ice305 REAL(wp), DIMENSION(jpi,jpj) :: ztio_u, ztio_v ! ocean stress below sea-ice 311 306 !!--------------------------------------------------------------------- 312 307 ! 313 CALL wrk_alloc( jpi, jpj, ztio_u, ztio_v )314 308 ! 315 309 SELECT CASE( cp_ice_msh ) … … 421 415 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 422 416 ! 423 CALL wrk_dealloc( jpi, jpj, ztio_u, ztio_v )424 417 ! 425 418 END SUBROUTINE lim_sbc_tau_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r7646 r7910 31 31 USE lbclnk ! 32 32 USE lib_mpp ! 33 USE wrk_nemo ! work arrays34 33 USE iom ! IOM library 35 34 USE prtctl ! Print control … … 94 93 REAL(wp) :: zrhoij, zrhoijm1 ! temporary scalars 95 94 REAL(wp) :: zztmp ! temporary scalars within a loop 96 REAL(wp), POINTER, DIMENSION(:,:) :: ztmp ! 2D workspace97 REAL(wp), POINTER, DIMENSION(:,:) :: zqlbsbq ! link with lead energy budget qldif98 REAL(wp), POINTER, DIMENSION(:,:) :: zlicegr ! link with lateral ice growth95 REAL(wp), DIMENSION(jpi,jpj) :: ztmp ! 2D workspace 96 REAL(wp), DIMENSION(jpi,jpj) :: zqlbsbq ! link with lead energy budget qldif 97 REAL(wp), DIMENSION(jpi,jpj) :: zlicegr ! link with lateral ice growth 99 98 !!$ REAL(wp), DIMENSION(:,:) :: firic ! IR flux over the ice (outputs only) 100 99 !!$ REAL(wp), DIMENSION(:,:) :: fcsic ! Sensible heat flux over the ice (outputs only) 101 100 !!$ REAL(wp), DIMENSION(:,:) :: fleic ! Latent heat flux over the ice (outputs only) 102 101 !!$ REAL(wp), DIMENSION(:,:) :: qlatic ! latent flux (outputs only) 103 REAL(wp), POINTER, DIMENSION(:,:) :: zdvosif ! Variation of volume at surface (outputs only)104 REAL(wp), POINTER, DIMENSION(:,:) :: zdvobif ! Variation of ice volume at the bottom ice (outputs only)105 REAL(wp), POINTER, DIMENSION(:,:) :: zdvolif ! Total variation of ice volume (outputs only)106 REAL(wp), POINTER, DIMENSION(:,:) :: zdvonif ! Surface accretion Snow to Ice transformation (outputs only)107 REAL(wp), POINTER, DIMENSION(:,:) :: zdvomif ! Bottom variation of ice volume due to melting (outputs only)108 REAL(wp), POINTER, DIMENSION(:,:) :: zu_imasstr ! Sea-ice transport along i-axis at U-point (outputs only)109 REAL(wp), POINTER, DIMENSION(:,:) :: zv_imasstr ! Sea-ice transport along j-axis at V-point (outputs only)110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmsk ! 3D workspace102 REAL(wp), DIMENSION(jpi,jpj) :: zdvosif ! Variation of volume at surface (outputs only) 103 REAL(wp), DIMENSION(jpi,jpj) :: zdvobif ! Variation of ice volume at the bottom ice (outputs only) 104 REAL(wp), DIMENSION(jpi,jpj) :: zdvolif ! Total variation of ice volume (outputs only) 105 REAL(wp), DIMENSION(jpi,jpj) :: zdvonif ! Surface accretion Snow to Ice transformation (outputs only) 106 REAL(wp), DIMENSION(jpi,jpj) :: zdvomif ! Bottom variation of ice volume due to melting (outputs only) 107 REAL(wp), DIMENSION(jpi,jpj) :: zu_imasstr ! Sea-ice transport along i-axis at U-point (outputs only) 108 REAL(wp), DIMENSION(jpi,jpj) :: zv_imasstr ! Sea-ice transport along j-axis at V-point (outputs only) 109 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! 3D workspace 111 110 !!------------------------------------------------------------------- 112 111 113 CALL wrk_alloc( jpi, jpj, ztmp, zqlbsbq, zlicegr, zdvosif, zdvobif, zdvolif, zdvonif, zdvomif, zu_imasstr, zv_imasstr )114 CALL wrk_alloc( jpi, jpj, jpk, zmsk )115 112 116 113 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) … … 522 519 ENDIF 523 520 ! 524 CALL wrk_dealloc( jpi, jpj, ztmp, zqlbsbq, zlicegr, zdvosif, zdvobif, zdvolif, zdvonif, zdvomif, zu_imasstr, zv_imasstr )525 CALL wrk_dealloc( jpi, jpj, jpk, zmsk )526 521 ! 527 522 END SUBROUTINE lim_thd_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
r5836 r7910 15 15 USE limistate_2 16 16 USE lib_mpp ! MPP library 17 USE wrk_nemo ! work arrays18 17 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 19 18 … … 80 79 iiceform , & ! 1 = ice formed ; 0 = no ice formed 81 80 ihemis ! dummy indice 82 REAL(wp), POINTER, DIMENSION(:) :: zqbgow ! heat budget of the open water (negative)83 REAL(wp), POINTER, DIMENSION(:) :: zfrl_old ! previous sea/ice fraction84 REAL(wp), POINTER, DIMENSION(:) :: zhice_old ! previous ice thickness85 REAL(wp), POINTER, DIMENSION(:) :: zhice0 ! thickness of newly formed ice in leads86 REAL(wp), POINTER, DIMENSION(:) :: zfrlmin ! minimum fraction for leads87 REAL(wp), POINTER, DIMENSION(:) :: zdhicbot ! part of thickness of newly formed ice in leads which81 REAL(wp), DIMENSION(jpij) :: zqbgow ! heat budget of the open water (negative) 82 REAL(wp), DIMENSION(jpij) :: zfrl_old ! previous sea/ice fraction 83 REAL(wp), DIMENSION(jpij) :: zhice_old ! previous ice thickness 84 REAL(wp), DIMENSION(jpij) :: zhice0 ! thickness of newly formed ice in leads 85 REAL(wp), DIMENSION(jpij) :: zfrlmin ! minimum fraction for leads 86 REAL(wp), DIMENSION(jpij) :: zdhicbot ! part of thickness of newly formed ice in leads which 88 87 ! has been already used in transport for example 89 88 REAL(wp) :: & … … 102 101 !!--------------------------------------------------------------------- 103 102 104 CALL wrk_alloc( jpij, zqbgow, zfrl_old, zhice_old, zhice0, zfrlmin, zdhicbot )105 103 106 104 !-------------------------------------------------------------- … … 221 219 END DO 222 220 223 CALL wrk_dealloc( jpij, zqbgow, zfrl_old, zhice_old, zhice0, zfrlmin, zdhicbot )224 221 ! 225 222 END SUBROUTINE lim_thd_lac_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r5407 r7910 21 21 USE in_out_manager 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! work arrays24 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 24 … … 73 72 !! 74 73 INTEGER :: ji ! dummy loop indices 75 REAL(wp), POINTER, DIMENSION(:) :: zqcmlts ! energy due to surface melting76 REAL(wp), POINTER, DIMENSION(:) :: zqcmltb ! energy due to bottom melting77 REAL(wp), POINTER, DIMENSION(:) :: ztsmlt ! snow/ice surface melting temperature78 REAL(wp), POINTER, DIMENSION(:) :: ztbif ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.79 REAL(wp), POINTER, DIMENSION(:) :: zksn ! effective conductivity of snow80 REAL(wp), POINTER, DIMENSION(:) :: zkic ! effective conductivity of ice81 REAL(wp), POINTER, DIMENSION(:) :: zksndh ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys.82 REAL(wp), POINTER, DIMENSION(:) :: zfcsu ! conductive heat flux at the surface of the snow/ice system83 REAL(wp), POINTER, DIMENSION(:) :: zfcsudt ! = zfcsu * dt84 REAL(wp), POINTER, DIMENSION(:) :: zi0 ! frac. of the net SW rad. which is not absorbed at the surface85 REAL(wp), POINTER, DIMENSION(:) :: z1mi0 ! fraction of the net SW radiation absorbed at the surface86 REAL(wp), POINTER, DIMENSION(:) :: zqmax ! maximum energy stored in brine pockets87 REAL(wp), POINTER, DIMENSION(:) :: zrcpdt ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer)88 REAL(wp), POINTER, DIMENSION(:) :: zts_old ! previous surface temperature89 REAL(wp), POINTER, DIMENSION(:) :: zidsn , z1midsn , zidsnic ! temporary variables90 REAL(wp), POINTER, DIMENSION(:) :: zfnet ! net heat flux at the top surface( incl. conductive heat flux)91 REAL(wp), POINTER, DIMENSION(:) :: zsprecip ! snow accumulation92 REAL(wp), POINTER, DIMENSION(:) :: zhsnw_old ! previous snow thickness93 REAL(wp), POINTER, DIMENSION(:) :: zdhictop ! change in ice thickness due to top surf ablation/accretion94 REAL(wp), POINTER, DIMENSION(:) :: zdhicbot ! change in ice thickness due to bottom surf abl/acc95 REAL(wp), POINTER, DIMENSION(:) :: zqsup ! energy transmitted to ocean (coming from top surf abl/acc)96 REAL(wp), POINTER, DIMENSION(:) :: zqocea ! energy transmitted to ocean (coming from bottom sur abl/acc)97 REAL(wp), POINTER, DIMENSION(:) :: zfrl_old ! previous sea/ice fraction98 REAL(wp), POINTER, DIMENSION(:) :: zfrld_1d ! new sea/ice fraction99 REAL(wp), POINTER, DIMENSION(:) :: zep ! internal temperature of the 2nd layer of the snow/ice system74 REAL(wp), DIMENSION(jpij) :: zqcmlts ! energy due to surface melting 75 REAL(wp), DIMENSION(jpij) :: zqcmltb ! energy due to bottom melting 76 REAL(wp), DIMENSION(jpij) :: ztsmlt ! snow/ice surface melting temperature 77 REAL(wp), DIMENSION(jpij) :: ztbif ! int. temp. at the mid-point of the 1st layer of the snow/ice sys. 78 REAL(wp), DIMENSION(jpij) :: zksn ! effective conductivity of snow 79 REAL(wp), DIMENSION(jpij) :: zkic ! effective conductivity of ice 80 REAL(wp), DIMENSION(jpij) :: zksndh ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys. 81 REAL(wp), DIMENSION(jpij) :: zfcsu ! conductive heat flux at the surface of the snow/ice system 82 REAL(wp), DIMENSION(jpij) :: zfcsudt ! = zfcsu * dt 83 REAL(wp), DIMENSION(jpij) :: zi0 ! frac. of the net SW rad. which is not absorbed at the surface 84 REAL(wp), DIMENSION(jpij) :: z1mi0 ! fraction of the net SW radiation absorbed at the surface 85 REAL(wp), DIMENSION(jpij) :: zqmax ! maximum energy stored in brine pockets 86 REAL(wp), DIMENSION(jpij) :: zrcpdt ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 87 REAL(wp), DIMENSION(jpij) :: zts_old ! previous surface temperature 88 REAL(wp), DIMENSION(jpij) :: zidsn , z1midsn , zidsnic ! temporary variables 89 REAL(wp), DIMENSION(jpij) :: zfnet ! net heat flux at the top surface( incl. conductive heat flux) 90 REAL(wp), DIMENSION(jpij) :: zsprecip ! snow accumulation 91 REAL(wp), DIMENSION(jpij) :: zhsnw_old ! previous snow thickness 92 REAL(wp), DIMENSION(jpij) :: zdhictop ! change in ice thickness due to top surf ablation/accretion 93 REAL(wp), DIMENSION(jpij) :: zdhicbot ! change in ice thickness due to bottom surf abl/acc 94 REAL(wp), DIMENSION(jpij) :: zqsup ! energy transmitted to ocean (coming from top surf abl/acc) 95 REAL(wp), DIMENSION(jpij) :: zqocea ! energy transmitted to ocean (coming from bottom sur abl/acc) 96 REAL(wp), DIMENSION(jpij) :: zfrl_old ! previous sea/ice fraction 97 REAL(wp), DIMENSION(jpij) :: zfrld_1d ! new sea/ice fraction 98 REAL(wp), DIMENSION(jpij) :: zep ! internal temperature of the 2nd layer of the snow/ice system 100 99 REAL(wp), DIMENSION(3) :: & 101 100 zplediag & ! principle diagonal, subdiag. and supdiag. of the … … 164 163 , zibmlt, ziqr, zihgnew, zind, ztmp ! temporary scalars 165 164 !!---------------------------------------------------------------------- 166 CALL wrk_alloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax )167 CALL wrk_alloc( jpij, zrcpdt, zts_old, zidsn , z1midsn , zidsnic, zfnet , zsprecip, zhsnw_old, zdhictop, zdhicbot )168 CALL wrk_alloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep , zqcmlts, zqcmltb )169 165 170 166 !----------------------------------------------------------------------- … … 809 805 END DO 810 806 ! 811 CALL wrk_dealloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax )812 CALL wrk_dealloc( jpij, zrcpdt, zts_old, zidsn , z1midsn , zidsnic, zfnet , zsprecip, zhsnw_old, zdhictop, zdhicbot )813 CALL wrk_dealloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep , zqcmlts, zqcmltb )814 807 ! 815 808 END SUBROUTINE lim_thd_zdf_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
r7646 r7910 27 27 USE lbclnk ! lateral boundary conditions -- MPP exchanges 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays30 29 # if defined key_agrif 31 30 USE agrif_lim2_interp ! nesting … … 76 75 REAL(wp) :: zvbord , zcfl , zusnit ! - - 77 76 REAL(wp) :: zrtt , ztsn , ztic1 , ztic2 ! - - 78 REAL(wp), POINTER, DIMENSION(:,:) :: zui_u , zvi_v , zsm ! 2D workspace79 REAL(wp), POINTER, DIMENSION(:,:) :: zs0ice, zs0sn , zs0a ! - -80 REAL(wp), POINTER, DIMENSION(:,:) :: zs0c0 , zs0c1 , zs0c2 , zs0st ! - -77 REAL(wp), DIMENSION(jpi,jpj) :: zui_u , zvi_v , zsm ! 2D workspace 78 REAL(wp), DIMENSION(jpi,jpj) :: zs0ice, zs0sn , zs0a ! - - 79 REAL(wp), DIMENSION(jpi,jpj) :: zs0c0 , zs0c1 , zs0c2 , zs0st ! - - 81 80 !--------------------------------------------------------------------- 82 81 83 CALL wrk_alloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st )84 82 85 83 IF( kt == nit000 ) CALL lim_trp_init_2 ! Initialization (first time-step only) … … 281 279 # endif 282 280 ! 283 CALL wrk_dealloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st )284 281 ! 285 282 END SUBROUTINE lim_trp_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r6140 r7910 30 30 USE in_out_manager 31 31 USE lib_mpp ! MPP library 32 USE wrk_nemo ! work arrays33 32 USE iom 34 33 USE ioipsl … … 103 102 & zindh, zinda, zindb, ztmu 104 103 REAL(wp), DIMENSION(1) :: zdept 105 REAL(wp), POINTER, DIMENSION(:,:) :: zfield 106 !!------------------------------------------------------------------- 107 108 CALL wrk_alloc( jpi, jpj, zfield ) 104 REAL(wp), DIMENSION(jpi,jpj) :: zfield 105 !!------------------------------------------------------------------- 106 109 107 !--------------------! 110 108 IF( kt == nit000 ) THEN ! Initialisation ! … … 206 204 IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice ) 207 205 208 CALL wrk_dealloc( jpi, jpj, zfield )209 206 ! 210 207 END SUBROUTINE lim_wri_2 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90
r7646 r7910 21 21 USE prtctl ! Print control 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! work arrays24 23 USE lib_fortran ! to use key_nosignedzero 25 24 … … 65 64 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 66 65 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 67 REAL(wp), POINTER, DIMENSION(:,:) :: zf0 , zfx , zfy , zbet ! 2D workspace68 REAL(wp), POINTER, DIMENSION(:,:) :: zfm , zfxx , zfyy , zfxy ! - -69 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - -66 REAL(wp), DIMENSION(jpi,jpj) :: zf0 , zfx , zfy , zbet ! 2D workspace 67 REAL(wp), DIMENSION(jpi,jpj) :: zfm , zfxx , zfyy , zfxy ! - - 68 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 70 69 !--------------------------------------------------------------------- 71 70 72 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )73 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )74 71 75 72 ! Limitation of moments. … … 218 215 ENDIF 219 216 ! 220 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )221 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )222 217 ! 223 218 END SUBROUTINE lim_adv_x … … 250 245 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 251 246 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 252 REAL(wp), POINTER, DIMENSION(:,:) :: zf0, zfx , zfy , zbet ! 2D workspace253 REAL(wp), POINTER, DIMENSION(:,:) :: zfm, zfxx, zfyy, zfxy ! - -254 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - -247 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace 248 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - - 249 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 255 250 !--------------------------------------------------------------------- 256 251 257 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )258 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )259 252 260 253 ! Limitation of moments. … … 404 397 ENDIF 405 398 ! 406 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )407 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )408 399 ! 409 400 END SUBROUTINE lim_adv_y -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
r7753 r7910 21 21 USE lbclnk ! lateral boundary conditions -- MPP exchanges 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! work arrays24 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 24 USE timing ! Timing … … 65 64 REAL(wp) :: zfp_ui, zfp_vj ! - - 66 65 REAL(wp) :: zfm_ui, zfm_vj ! - - 67 REAL(wp), POINTER, DIMENSION(:,:) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v66 REAL(wp), DIMENSION(jpi,jpj) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v 68 67 !!---------------------------------------------------------------------- 69 68 ! 70 69 IF( nn_timing == 1 ) CALL timing_start('lim_adv_umx') 71 70 ! 72 CALL wrk_alloc( jpi,jpj, zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )73 71 ! 74 72 ! … … 146 144 ! 147 145 ! 148 CALL wrk_dealloc( jpi,jpj, zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )149 146 ! 150 147 IF( nn_timing == 1 ) CALL timing_stop('lim_adv_umx') … … 174 171 INTEGER :: ji, jj ! dummy loop indices 175 172 REAL(wp) :: zc_box ! - - 176 REAL(wp), POINTER, DIMENSION(:,:) :: zzt173 REAL(wp), DIMENSION(jpi,jpj) :: zzt 177 174 !!---------------------------------------------------------------------- 178 175 ! 179 176 IF( nn_timing == 1 ) CALL timing_start('macho') 180 177 ! 181 CALL wrk_alloc( jpi,jpj, zzt )182 178 ! 183 179 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! … … 219 215 ENDIF 220 216 ! 221 CALL wrk_dealloc( jpi,jpj, zzt )222 217 ! 223 218 IF( nn_timing == 1 ) CALL timing_stop('macho') … … 245 240 INTEGER :: ji, jj ! dummy loop indices 246 241 REAL(wp) :: zcu, zdx2, zdx4 ! - - 247 REAL(wp), POINTER, DIMENSION(:,:) :: ztu1, ztu2, ztu3, ztu4242 REAL(wp), DIMENSION(jpi,jpj) :: ztu1, ztu2, ztu3, ztu4 248 243 !!---------------------------------------------------------------------- 249 244 ! 250 245 IF( nn_timing == 1 ) CALL timing_start('ultimate_x') 251 246 ! 252 CALL wrk_alloc( jpi,jpj, ztu1, ztu2, ztu3, ztu4 )253 247 ! 254 248 ! !-- Laplacian in i-direction --! … … 346 340 END SELECT 347 341 ! 348 CALL wrk_dealloc( jpi,jpj, ztu1, ztu2, ztu3, ztu4 )349 342 ! 350 343 IF( nn_timing == 1 ) CALL timing_stop('ultimate_x') … … 372 365 INTEGER :: ji, jj ! dummy loop indices 373 366 REAL(wp) :: zcv, zdy2, zdy4 ! - - 374 REAL(wp), POINTER, DIMENSION(:,:) :: ztv1, ztv2, ztv3, ztv4367 REAL(wp), DIMENSION(jpi,jpj) :: ztv1, ztv2, ztv3, ztv4 375 368 !!---------------------------------------------------------------------- 376 369 ! 377 370 IF( nn_timing == 1 ) CALL timing_start('ultimate_y') 378 371 ! 379 CALL wrk_alloc( jpi,jpj, ztv1, ztv2, ztv3, ztv4 )380 372 ! 381 373 ! !-- Laplacian in j-direction --! … … 474 466 END SELECT 475 467 ! 476 CALL wrk_dealloc( jpi,jpj, ztv1, ztv2, ztv3, ztv4 )477 468 ! 478 469 IF( nn_timing == 1 ) CALL timing_stop('ultimate_y') … … 502 493 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zsml, z1_dt ! local scalars 503 494 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 504 REAL(wp), POINTER, DIMENSION(:,:) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv495 REAL(wp), DIMENSION(jpi,jpj) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv 505 496 !!---------------------------------------------------------------------- 506 497 ! 507 498 IF( nn_timing == 1 ) CALL timing_start('nonosc_2d') 508 499 ! 509 CALL wrk_alloc( jpi,jpj, zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )510 500 ! 511 501 zbig = 1.e+40_wp … … 578 568 CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 579 569 ! 580 CALL wrk_dealloc( jpi,jpj, zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )581 570 ! 582 571 IF( nn_timing == 1 ) CALL timing_stop('nonosc_2d') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r7753 r7910 20 20 USE lbclnk ! lateral boundary condition - MPP exchanges 21 21 USE lib_mpp ! MPP library 22 USE wrk_nemo ! work arrays23 22 USE prtctl ! Print control 24 23 USE in_out_manager ! I/O manager … … 66 65 INTEGER , PARAMETER :: num_convfrq = 5 ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 67 66 REAL(wp), POINTER, DIMENSION(:) :: zconv 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrlx, zdiv0, ztab069 REAL(wp), POINTER, DIMENSION(:,:) :: zflu, zflv, zdiv67 REAL(wp), DIMENSION(jpi,jpj,isize) :: zrlx, zdiv0, ztab0 68 REAL(wp), DIMENSION(jpi,jpj) :: zflu, zflv, zdiv 70 69 !!------------------------------------------------------------------- 71 70 TYPE(arrayptr) , ALLOCATABLE, DIMENSION(:) :: pt2d_array, zrlx_array … … 83 82 ALLOCATE( psgn_array(isize) ) 84 83 85 CALL wrk_alloc( jpi,jpj, zflu, zflv, zdiv )86 CALL wrk_alloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )87 84 88 85 DO jk= 1, isize … … 206 203 ENDIF 207 204 ! 208 CALL wrk_dealloc( jpi,jpj, zflu, zflv, zdiv )209 CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )210 205 ! 211 206 DEALLOCATE( zconv ) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7761 r7910 28 28 USE lib_mpp ! MPP library 29 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 USE wrk_nemo ! work arrays31 30 USE fldread ! read input fields 32 31 USE iom … … 82 81 INTEGER :: i_hemis, i_fill, jl0 83 82 REAL(wp) :: zarg, zV, zconv, zdv 84 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 85 REAL(wp), POINTER, DIMENSION(:,:) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 86 REAL(wp), POINTER, DIMENSION(:,:) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini !data by cattegories to fill 88 INTEGER , POINTER, DIMENSION(:) :: itest 89 !-------------------------------------------------------------------- 90 91 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 92 CALL wrk_alloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 93 CALL wrk_alloc( jpi, jpj, zswitch ) 94 Call wrk_alloc( 4, itest ) 83 REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator 84 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 85 REAL(wp), DIMENSION(jpi,jpj) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 86 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zh_i_ini, za_i_ini !data by cattegories to fill 87 INTEGER , DIMENSION(4) :: itest 88 !-------------------------------------------------------------------- 95 89 96 90 IF(lwp) WRITE(numout,*) … … 464 458 !!! 465 459 466 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini )467 CALL wrk_dealloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )468 CALL wrk_dealloc( jpi, jpj, zswitch )469 460 Call wrk_dealloc( 4, itest ) 470 461 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r7753 r7910 21 21 USE lbclnk ! lateral boundary condition - MPP exchanges 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! work arrays24 23 25 24 USE in_out_manager ! I/O manager … … 110 109 REAL(wp) :: za, zfac ! local scalar 111 110 CHARACTER (len = 15) :: fieldid 112 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s)111 REAL(wp), DIMENSION(jpi,jpj) :: closing_net ! net rate at which area is removed (1/s) 113 112 ! (ridging ice area - area of new ridges) / dt 114 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s)115 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear116 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges113 REAL(wp), DIMENSION(jpi,jpj) :: divu_adv ! divu as implied by transport scheme (1/s) 114 REAL(wp), DIMENSION(jpi,jpj) :: opning ! rate of opening due to divergence/shear 115 REAL(wp), DIMENSION(jpi,jpj) :: closing_gross ! rate at which area removed, not counting area of new ridges 117 116 ! 118 117 INTEGER, PARAMETER :: nitermax = 20 … … 122 121 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 123 122 124 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross )125 123 126 124 ! conservation test … … 289 287 IF( ln_ctl ) CALL lim_prt3D( 'limitd_me' ) 290 288 291 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross )292 289 ! 293 290 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 305 302 INTEGER :: ji,jj, jl ! dummy loop indices 306 303 REAL(wp) :: Gstari, astari, hrmean, zdummy ! local scalar 307 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 308 !------------------------------------------------------------------------------! 309 310 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 304 REAL(wp), DIMENSION(jpi,jpj,-1:jpl) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 305 !------------------------------------------------------------------------------! 306 311 307 312 308 Gstari = 1.0/rn_gstar … … 477 473 END DO 478 474 ! 479 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )480 475 ! 481 476 END SUBROUTINE lim_itd_me_ridgeprep … … 501 496 REAL(wp) :: hL, hR, farea ! left and right limits of integration 502 497 503 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices504 REAL(wp), POINTER, DIMENSION(:) :: zswitch, fvol ! new ridge volume going to n2505 506 REAL(wp), POINTER, DIMENSION(:) :: afrac ! fraction of category area ridged507 REAL(wp), POINTER, DIMENSION(:) :: ardg1 , ardg2 ! area of ice ridged & new ridges508 REAL(wp), POINTER, DIMENSION(:) :: vsrdg , esrdg ! snow volume & energy of ridging ice509 REAL(wp), POINTER, DIMENSION(:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2510 511 REAL(wp), POINTER, DIMENSION(:) :: vrdg1 ! volume of ice ridged512 REAL(wp), POINTER, DIMENSION(:) :: vrdg2 ! volume of new ridges513 REAL(wp), POINTER, DIMENSION(:) :: vsw ! volume of seawater trapped into ridges514 REAL(wp), POINTER, DIMENSION(:) :: srdg1 ! sal*volume of ice ridged515 REAL(wp), POINTER, DIMENSION(:) :: srdg2 ! sal*volume of new ridges516 REAL(wp), POINTER, DIMENSION(:) :: smsw ! sal*volume of water trapped into ridges517 REAL(wp), POINTER, DIMENSION(:) :: oirdg1, oirdg2 ! ice age of ice ridged518 519 REAL(wp), POINTER, DIMENSION(:) :: afrft ! fraction of category area rafted520 REAL(wp), POINTER, DIMENSION(:) :: arft1 , arft2 ! area of ice rafted and new rafted zone521 REAL(wp), POINTER, DIMENSION(:) :: virft , vsrft ! ice & snow volume of rafting ice522 REAL(wp), POINTER, DIMENSION(:) :: esrft , smrft ! snow energy & salinity of rafting ice523 REAL(wp), POINTER, DIMENSION(:) :: oirft1, oirft2 ! ice age of ice rafted524 525 REAL(wp), POINTER, DIMENSION(:,:) :: eirft ! ice energy of rafting ice526 REAL(wp), POINTER, DIMENSION(:,:) :: erdg1 ! enth*volume of ice ridged527 REAL(wp), POINTER, DIMENSION(:,:) :: erdg2 ! enth*volume of new ridges528 REAL(wp), POINTER, DIMENSION(:,:) :: ersw ! enth of water trapped into ridges498 INTEGER , DIMENSION(jpij) :: indxi, indxj ! compressed indices 499 REAL(wp), DIMENSION(jpij) :: zswitch, fvol ! new ridge volume going to n2 500 501 REAL(wp), DIMENSION(jpij) :: afrac ! fraction of category area ridged 502 REAL(wp), DIMENSION(jpij) :: ardg1 , ardg2 ! area of ice ridged & new ridges 503 REAL(wp), DIMENSION(jpij) :: vsrdg , esrdg ! snow volume & energy of ridging ice 504 REAL(wp), DIMENSION(jpij) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 505 506 REAL(wp), DIMENSION(jpij) :: vrdg1 ! volume of ice ridged 507 REAL(wp), DIMENSION(jpij) :: vrdg2 ! volume of new ridges 508 REAL(wp), DIMENSION(jpij) :: vsw ! volume of seawater trapped into ridges 509 REAL(wp), DIMENSION(jpij) :: srdg1 ! sal*volume of ice ridged 510 REAL(wp), DIMENSION(jpij) :: srdg2 ! sal*volume of new ridges 511 REAL(wp), DIMENSION(jpij) :: smsw ! sal*volume of water trapped into ridges 512 REAL(wp), DIMENSION(jpij) :: oirdg1, oirdg2 ! ice age of ice ridged 513 514 REAL(wp), DIMENSION(jpij) :: afrft ! fraction of category area rafted 515 REAL(wp), DIMENSION(jpij) :: arft1 , arft2 ! area of ice rafted and new rafted zone 516 REAL(wp), DIMENSION(jpij) :: virft , vsrft ! ice & snow volume of rafting ice 517 REAL(wp), DIMENSION(jpij) :: esrft , smrft ! snow energy & salinity of rafting ice 518 REAL(wp), DIMENSION(jpij) :: oirft1, oirft2 ! ice age of ice rafted 519 520 REAL(wp), DIMENSION(jpij,nlay_i) :: eirft ! ice energy of rafting ice 521 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg1 ! enth*volume of ice ridged 522 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg2 ! enth*volume of new ridges 523 REAL(wp), DIMENSION(jpij,nlay_i) :: ersw ! enth of water trapped into ridges 529 524 !!---------------------------------------------------------------------- 530 525 531 CALL wrk_alloc( jpij, indxi, indxj )532 CALL wrk_alloc( jpij, zswitch, fvol )533 CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )534 CALL wrk_alloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )535 CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )536 CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )537 526 538 527 !------------------------------------------------------------------------------- … … 732 721 733 722 ! 734 CALL wrk_dealloc( jpij, indxi, indxj )735 CALL wrk_dealloc( jpij, zswitch, fvol )736 CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )737 CALL wrk_dealloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )738 CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )739 CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )740 723 ! 741 724 END SUBROUTINE lim_itd_me_ridgeshift … … 760 743 INTEGER :: numts_rm ! number of time steps for the P smoothing 761 744 REAL(wp) :: zp, z1_3 ! local scalars 762 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here763 REAL(wp), POINTER, DIMENSION(:,:) :: zstrp1, zstrp2 ! strength at previous time steps745 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 746 REAL(wp), DIMENSION(jpi,jpj) :: zstrp1, zstrp2 ! strength at previous time steps 764 747 !!---------------------------------------------------------------------- 765 748 766 CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 )767 749 768 750 !------------------------------------------------------------------------------! … … 896 878 ENDIF ! ksmooth 897 879 898 CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 )899 880 ! 900 881 END SUBROUTINE lim_itd_me_icestrength -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r7753 r7910 27 27 USE in_out_manager ! I/O manager 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays30 29 USE lib_fortran ! to use key_nosignedzero 31 30 USE limcons ! conservation tests … … 67 66 CHARACTER (len = 15) :: fieldid 68 67 69 INTEGER , POINTER, DIMENSION(:,:,:) :: zdonor ! donor category index70 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdhice ! ice thickness increment72 REAL(wp), POINTER, DIMENSION(:,:,:) :: g0 ! coefficients for fitting the line of the ITD73 REAL(wp), POINTER, DIMENSION(:,:,:) :: g1 ! coefficients for fitting the line of the ITD74 REAL(wp), POINTER, DIMENSION(:,:,:) :: hL ! left boundary for the ITD for each thickness75 REAL(wp), POINTER, DIMENSION(:,:,:) :: hR ! left boundary for the ITD for each thickness76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zht_i_b ! old ice thickness77 REAL(wp), POINTER, DIMENSION(:,:,:) :: dummy_es78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! local increment of ice area and volume79 REAL(wp), POINTER, DIMENSION(:) :: zvetamin, zvetamax ! maximum values for etas80 INTEGER , POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions68 INTEGER , DIMENSION(jpi,jpj,jpl-1) :: zdonor ! donor category index 69 70 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zdhice ! ice thickness increment 71 REAL(wp), DIMENSION(jpi,jpj,jpl) :: g0 ! coefficients for fitting the line of the ITD 72 REAL(wp), DIMENSION(jpi,jpj,jpl) :: g1 ! coefficients for fitting the line of the ITD 73 REAL(wp), DIMENSION(jpi,jpj,jpl) :: hL ! left boundary for the ITD for each thickness 74 REAL(wp), DIMENSION(jpi,jpj,jpl) :: hR ! left boundary for the ITD for each thickness 75 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zht_i_b ! old ice thickness 76 REAL(wp), DIMENSION(jpi,jpj,jpl) :: dummy_es 77 REAL(wp), DIMENSION(jpi,jpj,jpl-1) :: zdaice, zdvice ! local increment of ice area and volume 78 REAL(wp), DIMENSION((jpi+1)*(jpj+1)) :: zvetamin, zvetamax ! maximum values for etas 79 INTEGER , DIMENSION((jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions 81 80 INTEGER :: nbrem ! number of cells with ice to transfer 82 81 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 83 REAL(wp), POINTER, DIMENSION(:,:) :: zhb0, zhb1 ! category boundaries for thinnes categories 84 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 85 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 86 REAL(wp), POINTER, DIMENSION(:,:) :: et_i_init, et_i_final ! ice energy summed over categories 87 REAL(wp), POINTER, DIMENSION(:,:) :: et_s_init, et_s_final ! snow energy summed over categories 88 INTEGER , POINTER, DIMENSION(:,:) :: zremap_flag ! compute remapping or not ???? 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhbnew ! new boundaries of ice categories 90 !!------------------------------------------------------------------ 91 92 CALL wrk_alloc( jpi,jpj, zremap_flag ) 93 CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 94 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 95 CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice ) 96 CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) 97 CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax ) 98 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 99 CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 82 REAL(wp), DIMENSION(jpi,jpj) :: zhb0, zhb1 ! category boundaries for thinnes categories 83 REAL(wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 84 REAL(wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 85 REAL(wp), DIMENSION(jpi,jpj) :: et_i_init, et_i_final ! ice energy summed over categories 86 REAL(wp), DIMENSION(jpi,jpj) :: et_s_init, et_s_final ! snow energy summed over categories 87 INTEGER , DIMENSION(jpi,jpj) :: zremap_flag ! compute remapping or not ???? 88 REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: zhbnew ! new boundaries of ice categories 89 !!------------------------------------------------------------------ 90 100 91 101 92 !!---------------------------------------------------------------------------------------------- … … 383 374 ENDIF 384 375 385 CALL wrk_dealloc( jpi,jpj, zremap_flag )386 CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )387 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )388 CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )389 CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )390 CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )391 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )392 CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )393 376 394 377 END SUBROUTINE lim_itd_th_rem … … 477 460 INTEGER :: ii, ij ! indices when changing from 2D-1D is done 478 461 479 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaTsfn480 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here462 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zaTsfn 463 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 481 464 482 465 REAL(wp) :: zdvsnow, zdesnow ! snow volume and energy transferred … … 486 469 REAL(wp) :: zdaTsf ! aicen*Tsfcn transferred 487 470 488 INTEGER, POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions471 INTEGER, DIMENSION((jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions 489 472 490 473 INTEGER :: nbrem ! number of cells with ice to transfer 491 474 !!------------------------------------------------------------------ 492 475 493 CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )494 CALL wrk_alloc( jpi,jpj, zworka )495 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )496 476 497 477 !---------------------------------------------------------------------------------------------- … … 621 601 END DO 622 602 ! 623 CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )624 CALL wrk_dealloc( jpi,jpj, zworka )625 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )626 603 ! 627 604 END SUBROUTINE lim_itd_shiftice … … 643 620 CHARACTER (len = 15) :: fieldid 644 621 645 INTEGER , POINTER, DIMENSION(:,:,:) :: zdonor ! donor category index646 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! ice area and volume transferred647 648 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories649 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories622 INTEGER , DIMENSION(jpi,jpj,jpl) :: zdonor ! donor category index 623 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zdaice, zdvice ! ice area and volume transferred 624 625 REAL(wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 626 REAL(wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 650 627 !!------------------------------------------------------------------ 651 628 652 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger653 CALL wrk_alloc( jpi,jpj,jpl, zdaice, zdvice )654 CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )655 629 ! 656 630 IF( con_i ) THEN ! conservation check … … 772 746 ENDIF 773 747 ! 774 CALL wrk_dealloc( jpi,jpj,jpl, zdonor )775 CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice )776 CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )777 748 778 749 END SUBROUTINE lim_itd_th_reb -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r7753 r7910 28 28 USE lbclnk ! Lateral Boundary Condition / MPP link 29 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays31 30 USE in_out_manager ! I/O manager 32 31 USE prtctl ! Print control … … 123 122 REAL(wp) :: zintb, zintn ! dummy argument 124 123 125 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors126 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points124 REAL(wp), DIMENSION(jpi,jpj) :: z1_e1t0, z1_e2t0 ! scale factors 125 REAL(wp), DIMENSION(jpi,jpj) :: zp_delt ! P/delta at T points 127 126 ! 128 REAL(wp), POINTER, DIMENSION(:,:) :: zaU , zaV ! ice fraction on U/V points129 REAL(wp), POINTER, DIMENSION(:,:) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points130 REAL(wp), POINTER, DIMENSION(:,:) :: zmf ! coriolis parameter at T points131 REAL(wp), POINTER, DIMENSION(:,:) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points132 REAL(wp), POINTER, DIMENSION(:,:) :: zspgU , zspgV ! surface pressure gradient at U/V points133 REAL(wp), POINTER, DIMENSION(:,:) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points134 REAL(wp), POINTER, DIMENSION(:,:) :: zfU , zfV ! internal stresses127 REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV ! ice fraction on U/V points 128 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points 129 REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points 130 REAL(wp), DIMENSION(jpi,jpj) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points 131 REAL(wp), DIMENSION(jpi,jpj) :: zspgU , zspgV ! surface pressure gradient at U/V points 132 REAL(wp), DIMENSION(jpi,jpj) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 133 REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses 135 134 136 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear137 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components138 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence139 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope:135 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear 136 REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components 137 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! check convergence 138 REAL(wp), DIMENSION(jpi,jpj) :: zpice ! array used for the calculation of ice surface slope: 140 139 ! ocean surface (ssh_m) if ice is not embedded 141 140 ! ice top surface if ice is embedded 142 REAL(wp), POINTER, DIMENSION(:,:) :: zswitchU, zswitchV ! dummy arrays143 REAL(wp), POINTER, DIMENSION(:,:) :: zmaskU, zmaskV ! mask for ice presence144 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask, zwf ! mask at F points for the ice141 REAL(wp), DIMENSION(jpi,jpj) :: zswitchU, zswitchV ! dummy arrays 142 REAL(wp), DIMENSION(jpi,jpj) :: zmaskU, zmaskV ! mask for ice presence 143 REAL(wp), DIMENSION(jpi,jpj) :: zfmask, zwf ! mask at F points for the ice 145 144 146 145 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter … … 149 148 !!------------------------------------------------------------------- 150 149 151 CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )152 CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )153 CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )154 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )155 CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )156 150 157 151 #if defined key_agrif … … 698 692 ! 699 693 700 CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )701 CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )702 CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )703 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )704 CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )705 694 706 695 END SUBROUTINE lim_rhg -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r7813 r7910 24 24 USE iom ! I/O library 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! work arrays27 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 27 USE limctl … … 107 106 CHARACTER(len=25) :: znam 108 107 CHARACTER(len=2) :: zchar, zchar1 109 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 110 !!---------------------------------------------------------------------- 111 112 CALL wrk_alloc( jpi, jpj, z2d ) 108 REAL(wp), DIMENSION(jpi,jpj) :: z2d 109 !!---------------------------------------------------------------------- 110 113 111 114 112 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 … … 301 299 ENDIF 302 300 ! 303 CALL wrk_dealloc( jpi, jpj, z2d )304 301 ! 305 302 END SUBROUTINE lim_rst_write … … 314 311 INTEGER :: ji, jj, jk, jl 315 312 REAL(wp) :: zfice, ziter 316 REAL(wp), POINTER, DIMENSION(:,:) :: z2d313 REAL(wp), DIMENSION(jpi,jpj) :: z2d 317 314 CHARACTER(len=25) :: znam 318 315 CHARACTER(len=2) :: zchar, zchar1 … … 321 318 !!---------------------------------------------------------------------- 322 319 323 CALL wrk_alloc( jpi, jpj, z2d )324 320 325 321 IF(lwp) THEN … … 528 524 !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 529 525 ! 530 CALL wrk_dealloc( jpi, jpj, z2d )531 526 ! 532 527 END SUBROUTINE lim_rst_read -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r7753 r7910 42 42 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 43 43 USE lib_mpp ! MPP library 44 USE wrk_nemo ! work arrays45 44 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 46 45 … … 106 105 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 107 106 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 3D workspace109 REAL(wp), POINTER, DIMENSION(:,:) :: zalb ! 2D workspace107 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_cs, zalb_os ! 3D workspace 108 REAL(wp), DIMENSION(jpi,jpj) :: zalb ! 2D workspace 110 109 !!--------------------------------------------------------------------- 111 110 … … 121 120 122 121 ! albedo output 123 CALL wrk_alloc( jpi,jpj, zalb )124 122 125 123 zalb(:,:) = 0._wp … … 132 130 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 133 131 134 CALL wrk_dealloc( jpi,jpj, zalb )135 132 136 133 DO jj = 1, jpj … … 210 207 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 211 208 !------------------------------------------------------------------------! 212 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os )213 209 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 214 210 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 215 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os )216 211 217 212 ! conservation test -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r7813 r7910 41 41 USE lbclnk ! lateral boundary condition - MPP links 42 42 USE lib_mpp ! MPP library 43 USE wrk_nemo ! work arrays44 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 45 44 USE timing ! Timing … … 87 86 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 88 87 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 89 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)88 REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 90 89 ! 91 90 !!------------------------------------------------------------------- … … 93 92 IF( nn_timing == 1 ) CALL timing_start('limthd') 94 93 95 CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric )96 94 97 95 IF( kt == nit000 .AND. lwp ) THEN … … 342 340 IF( ln_ctl ) CALL lim_prt3D( 'limthd' ) 343 341 ! 344 CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric )345 342 ! 346 343 IF( nn_timing == 1 ) CALL timing_stop('limthd') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
r7753 r7910 17 17 USE ice ! LIM variables 18 18 USE lib_mpp ! MPP library 19 USE wrk_nemo ! work arrays20 19 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 21 20 … … 104 103 REAL(wp), PARAMETER :: zm2 = 1.36_wp 105 104 ! 106 REAL(wp), POINTER, DIMENSION(:,:) :: zda_tot105 REAL(wp), DIMENSION(jpi,jpj) :: zda_tot 107 106 !!--------------------------------------------------------------------- 108 CALL wrk_alloc( jpi,jpj, zda_tot )109 107 110 108 !------------------------------------------------------------! … … 168 166 WHERE( a_i == 0._wp ) ht_i = 0._wp 169 167 ! 170 CALL wrk_dealloc( jpi,jpj, zda_tot )171 168 ! 172 169 END SUBROUTINE lim_thd_da -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r7646 r7910 23 23 USE in_out_manager ! I/O manager 24 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays26 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 26 … … 89 88 REAL(wp) :: zsstK ! SST in Kelvin 90 89 91 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3)92 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2)93 REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2)94 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2)95 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2)96 REAL(wp), POINTER, DIMENSION(:) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2)97 98 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt99 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre ! snow precipitation100 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_sub ! snow sublimation101 102 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah103 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness104 INTEGER , POINTER, DIMENSION(:,:) :: icount ! number of layers vanished by melting105 106 REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2)107 REAL(wp), POINTER, DIMENSION(:) :: zsnw ! distribution of snow after wind blowing90 REAL(wp), DIMENSION(jpij) :: zqprec ! energy of fallen snow (J.m-3) 91 REAL(wp), DIMENSION(jpij) :: zq_su ! heat for surface ablation (J.m-2) 92 REAL(wp), DIMENSION(jpij) :: zq_bo ! heat for bottom ablation (J.m-2) 93 REAL(wp), DIMENSION(jpij) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 94 REAL(wp), DIMENSION(jpij) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 95 REAL(wp), DIMENSION(jpij) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2) 96 97 REAL(wp), DIMENSION(jpij) :: zdh_s_mel ! snow melt 98 REAL(wp), DIMENSION(jpij) :: zdh_s_pre ! snow precipitation 99 REAL(wp), DIMENSION(jpij) :: zdh_s_sub ! snow sublimation 100 101 REAL(wp), DIMENSION(jpij,nlay_i) :: zdeltah 102 REAL(wp), DIMENSION(jpij,nlay_i) :: zh_i ! ice layer thickness 103 INTEGER , DIMENSION(jpij,nlay_i) :: icount ! number of layers vanished by melting 104 105 REAL(wp), DIMENSION(jpij) :: zqh_i ! total ice heat content (J.m-2) 106 REAL(wp), DIMENSION(jpij) :: zsnw ! distribution of snow after wind blowing 108 107 109 108 REAL(wp) :: zswitch_sal … … 120 119 END SELECT 121 120 122 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )123 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )124 CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )125 CALL wrk_alloc( jpij, nlay_i, icount )126 121 127 122 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp … … 681 676 WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 682 677 683 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )684 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )685 CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )686 CALL wrk_dealloc( jpij, nlay_i, icount )687 678 ! 688 679 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r7813 r7910 22 22 USE in_out_manager ! I/O manager 23 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays25 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 25 … … 99 98 INTEGER :: minnumeqmin, maxnumeqmax 100 99 101 INTEGER, POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation102 INTEGER, POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation100 INTEGER, DIMENSION(jpij) :: numeqmin ! reference number of top equation 101 INTEGER, DIMENSION(jpij) :: numeqmax ! reference number of bottom equation 103 102 104 103 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system … … 113 112 REAL(wp) :: zhsu 114 113 115 REAL(wp), POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow116 REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure )117 REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration118 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness119 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness120 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface121 REAL(wp), POINTER, DIMENSION(:) :: zqns_ice_b ! solar radiation absorbed at the surface122 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function123 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function124 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature125 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4)126 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice127 REAL(wp), POINTER, DIMENSION(:) :: zihic114 REAL(wp), DIMENSION(jpij) :: isnow ! switch for presence (1) or absence (0) of snow 115 REAL(wp), DIMENSION(jpij) :: ztsub ! old surface temperature (before the iterative procedure ) 116 REAL(wp), DIMENSION(jpij) :: ztsubit ! surface temperature at previous iteration 117 REAL(wp), DIMENSION(jpij) :: zh_i ! ice layer thickness 118 REAL(wp), DIMENSION(jpij) :: zh_s ! snow layer thickness 119 REAL(wp), DIMENSION(jpij) :: zfsw ! solar radiation absorbed at the surface 120 REAL(wp), DIMENSION(jpij) :: zqns_ice_b ! solar radiation absorbed at the surface 121 REAL(wp), DIMENSION(jpij) :: zf ! surface flux function 122 REAL(wp), DIMENSION(jpij) :: dzf ! derivative of the surface flux function 123 REAL(wp), DIMENSION(jpij) :: zerrit ! current error on temperature 124 REAL(wp), DIMENSION(jpij) :: zdifcase ! case of the equation resolution (1->4) 125 REAL(wp), DIMENSION(jpij) :: zftrice ! solar radiation transmitted through the ice 126 REAL(wp), DIMENSION(jpij) :: zihic 128 127 129 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity130 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice131 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice132 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice133 REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice134 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice135 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence136 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat137 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice138 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow139 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow140 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow141 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow142 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence143 REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow144 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow145 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! 'Ind'ependent term146 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! Temporary 'ind'ependent term147 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis ! Temporary 'dia'gonal term148 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! Tridiagonal system terms128 REAL(wp), DIMENSION(jpij,nlay_i+1) :: ztcond_i ! Ice thermal conductivity 129 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zradtr_i ! Radiation transmitted through the ice 130 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zradab_i ! Radiation absorbed in the ice 131 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zkappa_i ! Kappa factor in the ice 132 REAL(wp), DIMENSION(jpij,nlay_i+1) :: ztib ! Old temperature in the ice 133 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zeta_i ! Eta factor in the ice 134 REAL(wp), DIMENSION(jpij,nlay_i+1) :: ztitemp ! Temporary temperature in the ice to check the convergence 135 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zspeche_i ! Ice specific heat 136 REAL(wp), DIMENSION(jpij,nlay_i+1) :: z_i ! Vertical cotes of the layers in the ice 137 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zradtr_s ! Radiation transmited through the snow 138 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zradab_s ! Radiation absorbed in the snow 139 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zkappa_s ! Kappa factor in the snow 140 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zeta_s ! Eta factor in the snow 141 REAL(wp), DIMENSION(jpij,nlay_s+1) :: ztstemp ! Temporary temperature in the snow to check the convergence 142 REAL(wp), DIMENSION(jpij,nlay_s+1) :: ztsb ! Temporary temperature in the snow 143 REAL(wp), DIMENSION(jpij,nlay_s+1) :: z_s ! Vertical cotes of the layers in the snow 144 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindterm ! 'Ind'ependent term 145 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindtbis ! Temporary 'ind'ependent term 146 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zdiagbis ! Temporary 'dia'gonal term 147 REAL(wp), DIMENSION(jpij,nlay_i+3,3) :: ztrid ! Tridiagonal system terms 149 148 150 149 ! diag errors on heat 151 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err150 REAL(wp), DIMENSION(jpij) :: zdq, zq_ini, zhfx_err 152 151 153 152 ! Mono-category … … 162 161 REAL(wp) :: zheshth ! dummy factor 163 162 164 REAL(wp), POINTER, DIMENSION(:) :: zghe ! G(he), th. conduct enhancement factor, mono-cat163 REAL(wp), DIMENSION(jpij) :: zghe ! G(he), th. conduct enhancement factor, mono-cat 165 164 166 165 !!------------------------------------------------------------------ 167 166 ! 168 CALL wrk_alloc( jpij, numeqmin, numeqmax ) 169 CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 170 CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe ) 171 CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 ) 172 CALL wrk_alloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 ) 173 CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 174 CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 175 176 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 167 177 168 178 169 ! --- diag error on heat diffusion - PART 1 --- ! … … 792 783 END DO 793 784 ! 794 CALL wrk_dealloc( jpij, numeqmin, numeqmax )795 CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )796 CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )797 CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )798 CALL wrk_dealloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )799 CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )800 CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )801 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )802 785 803 786 END SUBROUTINE lim_thd_dif -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r5134 r7910 29 29 USE in_out_manager ! I/O manager 30 30 USE lib_mpp ! MPP library 31 USE wrk_nemo ! work arrays32 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 32 … … 76 75 INTEGER :: jk0, jk1 ! old/new layer indices 77 76 ! 78 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces79 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces80 REAL(wp), POINTER, DIMENSION(:) :: zhnew ! new layers thicknesses77 REAL(wp), DIMENSION(jpij,0:nlay_i+2) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces 78 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zqh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces 79 REAL(wp), DIMENSION(jpij) :: zhnew ! new layers thicknesses 81 80 !!------------------------------------------------------------------- 82 81 83 CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )84 CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )85 CALL wrk_alloc( jpij, zhnew )86 82 87 83 !-------------------------------------------------------------------------- … … 146 142 147 143 ! 148 CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )149 CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )150 CALL wrk_dealloc( jpij, zhnew )151 144 ! 152 145 END SUBROUTINE lim_thd_ent -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r7753 r7910 26 26 USE in_out_manager ! I/O manager 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! work arrays29 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 85 84 REAL(wp) :: zv_newfra 86 85 87 INTEGER , POINTER, DIMENSION(:) :: jcat ! indexes of categories where new ice grows88 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not89 90 REAL(wp), POINTER, DIMENSION(:) :: zv_newice ! volume of accreted ice91 REAL(wp), POINTER, DIMENSION(:) :: za_newice ! fractional area of accreted ice92 REAL(wp), POINTER, DIMENSION(:) :: zh_newice ! thickness of accreted ice93 REAL(wp), POINTER, DIMENSION(:) :: ze_newice ! heat content of accreted ice94 REAL(wp), POINTER, DIMENSION(:) :: zs_newice ! salinity of accreted ice95 REAL(wp), POINTER, DIMENSION(:) :: zo_newice ! age of accreted ice96 REAL(wp), POINTER, DIMENSION(:) :: zdv_res ! residual volume in case of excessive heat budget97 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget98 REAL(wp), POINTER, DIMENSION(:) :: zat_i_1d ! total ice fraction99 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom100 REAL(wp), POINTER, DIMENSION(:) :: zvrel_1d ! relative ice / frazil velocity (1D vector)101 102 REAL(wp), POINTER, DIMENSION(:,:) :: zv_b ! old volume of ice in category jl103 REAL(wp), POINTER, DIMENSION(:,:) :: za_b ! old area of ice in category jl104 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i105 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i106 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i107 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d !: 1-D version of e_i109 110 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity86 INTEGER , DIMENSION(jpij) :: jcat ! indexes of categories where new ice grows 87 REAL(wp), DIMENSION(jpij) :: zswinew ! switch for new ice or not 88 89 REAL(wp), DIMENSION(jpij) :: zv_newice ! volume of accreted ice 90 REAL(wp), DIMENSION(jpij) :: za_newice ! fractional area of accreted ice 91 REAL(wp), DIMENSION(jpij) :: zh_newice ! thickness of accreted ice 92 REAL(wp), DIMENSION(jpij) :: ze_newice ! heat content of accreted ice 93 REAL(wp), DIMENSION(jpij) :: zs_newice ! salinity of accreted ice 94 REAL(wp), DIMENSION(jpij) :: zo_newice ! age of accreted ice 95 REAL(wp), DIMENSION(jpij) :: zdv_res ! residual volume in case of excessive heat budget 96 REAL(wp), DIMENSION(jpij) :: zda_res ! residual area in case of excessive heat budget 97 REAL(wp), DIMENSION(jpij) :: zat_i_1d ! total ice fraction 98 REAL(wp), DIMENSION(jpij) :: zv_frazb ! accretion of frazil ice at the ice bottom 99 REAL(wp), DIMENSION(jpij) :: zvrel_1d ! relative ice / frazil velocity (1D vector) 100 101 REAL(wp), DIMENSION(jpij,jpl) :: zv_b ! old volume of ice in category jl 102 REAL(wp), DIMENSION(jpij,jpl) :: za_b ! old area of ice in category jl 103 REAL(wp), DIMENSION(jpij,jpl) :: za_i_1d ! 1-D version of a_i 104 REAL(wp), DIMENSION(jpij,jpl) :: zv_i_1d ! 1-D version of v_i 105 REAL(wp), DIMENSION(jpij,jpl) :: zsmv_i_1d ! 1-D version of smv_i 106 107 REAL(wp), DIMENSION(jpij,nlay_i,jpl) :: ze_i_1d !: 1-D version of e_i 108 109 REAL(wp), DIMENSION(jpi,jpj) :: zvrel ! relative ice / frazil velocity 111 110 112 111 REAL(wp) :: zcai = 1.4e-3_wp ! ice-air drag (clem: should be dependent on coupling/forcing used) 113 112 !!-----------------------------------------------------------------------! 114 113 115 CALL wrk_alloc( jpij, jcat ) ! integer116 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )117 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )118 CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )119 CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )120 CALL wrk_alloc( jpi,jpj, zvrel )121 114 122 115 CALL lim_var_agg(1) … … 512 505 513 506 ! 514 CALL wrk_dealloc( jpij, jcat ) ! integer515 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )516 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )517 CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )518 CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )519 CALL wrk_dealloc( jpi,jpj, zvrel )520 507 ! 521 508 END SUBROUTINE lim_thd_lac -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r7753 r7910 26 26 USE lbclnk ! lateral boundary conditions -- MPP exchanges 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! work arrays29 28 USE prtctl ! Print control 30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 72 71 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 73 72 REAL(wp) :: zdv, zda 74 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold, zsmvold75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax, zviold, zvsold73 REAL(wp), DIMENSION(jpi,jpj) :: zatold, zeiold, zesold, zsmvold 74 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhimax, zviold, zvsold 76 75 ! --- diffusion --- ! 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab76 REAL(wp), DIMENSION(jpi,jpj,jpl*(ihdf_vars+nlay_i)+1) :: zhdfptab 78 77 INTEGER , PARAMETER :: ihdf_vars = 6 ! Number of variables in which we apply horizontal diffusion 79 78 ! inside limtrp for each ice category , not counting the … … 81 80 ! --- ultimate macho only --- ! 82 81 REAL(wp) :: zdt 83 REAL(wp), POINTER, DIMENSION(:,:) :: zudy, zvdx, zcu_box, zcv_box82 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 84 83 ! --- prather only --- ! 85 REAL(wp), POINTER, DIMENSION(:,:) :: zarea86 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw87 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi88 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: z0ei84 REAL(wp), DIMENSION(jpi,jpj) :: zarea 85 REAL(wp), DIMENSION(jpi,jpj,1) :: z0opw 86 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi 87 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: z0ei 89 88 !! 90 89 !!--------------------------------------------------------------------- 91 90 IF( nn_timing == 1 ) CALL timing_start('limtrp') 92 91 93 CALL wrk_alloc( jpi,jpj, zatold, zeiold, zesold, zsmvold )94 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold )95 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)96 92 97 93 IF( kt == nit000 .AND. lwp ) THEN … … 163 159 !=============================! 164 160 165 CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )166 161 167 162 IF( kt == nit000 .AND. lwp ) THEN … … 213 208 END DO 214 209 ! 215 CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )216 210 217 211 !=============================! … … 219 213 !=============================! 220 214 221 CALL wrk_alloc( jpi,jpj, zarea )222 CALL wrk_alloc( jpi,jpj,1, z0opw )223 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )224 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei )225 215 226 216 IF( kt == nit000 .AND. lwp ) THEN … … 354 344 END DO 355 345 356 CALL wrk_dealloc( jpi,jpj, zarea )357 CALL wrk_dealloc( jpi,jpj,1, z0opw )358 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )359 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei )360 346 361 347 END SELECT … … 525 511 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 526 512 ! 527 CALL wrk_dealloc( jpi,jpj, zatold, zeiold, zesold, zsmvold )528 CALL wrk_dealloc( jpi,jpj,jpl, zhimax, zviold, zvsold )529 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)530 513 ! 531 514 IF( nn_timing == 1 ) CALL timing_stop('limtrp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r7813 r7910 43 43 USE in_out_manager ! I/O manager 44 44 USE lib_mpp ! MPP library 45 USE wrk_nemo ! work arrays46 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 47 46 … … 289 288 REAL(wp) :: zfac0, zfac1, zsal 290 289 REAL(wp) :: zswi0, zswi01, zargtemp , zs_zero 291 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha290 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_slope_s, zalpha 292 291 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 293 292 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 294 293 !!------------------------------------------------------------------ 295 294 296 CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )297 295 298 296 !--------------------------------------- … … 378 376 ENDIF ! nn_icesal 379 377 ! 380 CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )381 378 ! 382 379 END SUBROUTINE lim_var_salprof … … 434 431 REAL(wp) :: zalpha, zswi0, zswi01, zs_zero ! - - 435 432 ! 436 REAL(wp), POINTER, DIMENSION(:) :: z_slope_s433 REAL(wp), DIMENSION(jpij) :: z_slope_s 437 434 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 438 435 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 439 436 !!--------------------------------------------------------------------- 440 437 441 CALL wrk_alloc( jpij, z_slope_s )442 438 443 439 !--------------------------------------- … … 503 499 ENDIF 504 500 ! 505 CALL wrk_dealloc( jpij, z_slope_s )506 501 ! 507 502 END SUBROUTINE lim_var_salprof1d … … 639 634 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables 640 635 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables 641 INTEGER , POINTER, DIMENSION(:) :: itest636 INTEGER , DIMENSION(4) :: itest 642 637 643 CALL wrk_alloc( 4, itest )644 638 !-------------------------------------------------------------------- 645 639 ! initialisation of variables … … 765 759 ENDDO 766 760 767 CALL wrk_dealloc( 4, itest )768 761 ! 769 762 END SUBROUTINE lim_var_itd -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r7753 r7910 22 22 USE lbclnk 23 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays25 24 USE iom 26 25 USE timing ! Timing … … 56 55 REAL(wp) :: z1_365 57 56 REAL(wp) :: z2da, z2db, ztmp 58 REAL(wp), POINTER, DIMENSION(:,:,:) :: zswi259 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, zswi ! 2D workspace57 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zswi2 58 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zswi ! 2D workspace 60 59 !!------------------------------------------------------------------- 61 60 62 61 IF( nn_timing == 1 ) CALL timing_start('limwri') 63 62 64 CALL wrk_alloc( jpi,jpj,jpl, zswi2 )65 CALL wrk_alloc( jpi,jpj , z2d, zswi )66 63 67 64 !----------------------------- … … 229 226 ! not yet implemented 230 227 231 CALL wrk_dealloc( jpi, jpj, jpl, zswi2 )232 CALL wrk_dealloc( jpi, jpj , z2d, zswi )233 228 234 229 IF( nn_timing == 1 ) CALL timing_stop('limwri') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7646 r7910 28 28 USE agrif_opa_sponge 29 29 USE lib_mpp 30 USE wrk_nemo31 30 32 31 IMPLICIT NONE … … 77 76 INTEGER :: ji, jj, jk ! dummy loop indices 78 77 INTEGER :: j1, j2, i1, i2 79 REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb78 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb 80 79 !!---------------------------------------------------------------------- 81 80 ! 82 81 IF( Agrif_Root() ) RETURN 83 82 ! 84 CALL wrk_alloc( jpi,jpj, zub, zvb )85 83 ! 86 84 Agrif_SpecialValue = 0._wp … … 376 374 ENDIF 377 375 ! 378 CALL wrk_dealloc( jpi,jpj, zub, zvb )379 376 ! 380 377 END SUBROUTINE Agrif_dyn -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r7646 r7910 14 14 USE in_out_manager 15 15 USE agrif_oce 16 USE wrk_nemo17 16 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 18 17 … … 88 87 LOGICAL :: ll_spdone 89 88 REAL(wp) :: z1spongearea, zramp 90 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp89 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 91 90 92 91 #if defined SPONGE || defined SPONGE_TOP … … 98 97 ll_spdone=.FALSE. 99 98 100 CALL wrk_alloc( jpi, jpj, ztabramp )101 99 102 100 ispongearea = 2 + nn_sponge_len * Agrif_irhox() … … 185 183 ENDIF 186 184 ! 187 IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )188 185 ! 189 186 #endif -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r7646 r7910 40 40 USE prtctl ! print control 41 41 USE fldread ! read input fields 42 USE wrk_nemo ! Memory allocation43 42 USE timing ! Timing 44 43 USE trc, ONLY : ln_rsttr, numrtr, numrtw, lrst_trc … … 109 108 INTEGER, INTENT(in) :: kt ! ocean time-step index 110 109 INTEGER :: ji, jj, jk 111 REAL(wp), POINTER, DIMENSION(:,:) :: zemp110 REAL(wp), DIMENSION(jpi,jpj) :: zemp 112 111 ! 113 112 !!---------------------------------------------------------------------- … … 142 141 ! 143 142 IF( .NOT.ln_linssh ) THEN 144 CALL wrk_alloc(jpi, jpj, zemp )145 143 zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:) ! effective u-transport 146 144 emp_b (:,:) = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1) ! E-P 147 145 zemp (:,:) = 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr * tmask(:,:,1) 148 146 CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) ) != ssh, vertical scale factor & vertical transport 149 CALL wrk_dealloc(jpi, jpj, zemp )150 147 ! Write in the tracer restart file 151 148 ! ******************************* … … 590 587 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 591 588 INTEGER :: iswap 592 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuslp, zvslp, zwslpi, zwslpj589 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuslp, zvslp, zwslpi, zwslpj 593 590 !!--------------------------------------------------------------------- 594 591 ! 595 CALL wrk_alloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj )596 592 ! 597 593 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) … … 663 659 ENDIF 664 660 ! 665 CALL wrk_dealloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj )666 661 ! 667 662 END SUBROUTINE dta_dyn_slp -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r6140 r7910 22 22 !! seaice_asm_inc : Apply the seaice increment 23 23 !!---------------------------------------------------------------------- 24 USE wrk_nemo ! Memory Allocation25 24 USE par_oce ! Ocean space and time domain variables 26 25 USE dom_oce ! Ocean space and time domain … … 124 123 REAL(wp) :: zdate_inc ! Time axis in increments file 125 124 ! 126 REAL(wp), POINTER, DIMENSION(:,:) :: hdiv ! 2D workspace125 REAL(wp), DIMENSION(jpi,jpj) :: hdiv ! 2D workspace 127 126 !! 128 127 NAMELIST/nam_asminc/ ln_bkgwri, & … … 432 431 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 433 432 ! 434 CALL wrk_alloc( jpi,jpj, hdiv )435 433 ! 436 434 DO jt = 1, nn_divdmp … … 460 458 END DO 461 459 ! 462 CALL wrk_dealloc( jpi,jpj, hdiv )463 460 ! 464 461 ENDIF -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r7646 r7910 16 16 !! conditions 17 17 !!---------------------------------------------------------------------- 18 USE wrk_nemo ! Memory Allocation19 18 USE timing ! Timing 20 19 USE oce ! ocean dynamics and tracers … … 51 50 INTEGER :: jk, ii, ij, ib_bdy, ib, igrd ! Loop counter 52 51 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 53 REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d ! after barotropic velocities52 REAL(wp), DIMENSION(jpi,jpj) :: pua2d, pva2d ! after barotropic velocities 54 53 !!---------------------------------------------------------------------- 55 54 ! … … 73 72 !------------------------------------------------------- 74 73 75 CALL wrk_alloc( jpi,jpj, pua2d, pva2d )76 74 77 75 !------------------------------------------------------- … … 127 125 END IF 128 126 ! 129 CALL wrk_dealloc( jpi,jpj, pua2d, pva2d )130 127 ! 131 128 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r7646 r7910 29 29 USE lib_mpp ! for mpp_sum 30 30 USE iom ! I/O 31 USE wrk_nemo ! Memory Allocation32 31 USE timing ! Timing 33 32 … … 151 150 INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b ! Flags for boundaries receiving 152 151 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 153 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat)152 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 154 153 !! 155 154 CHARACTER(LEN=1) :: ctypebdy ! - - … … 1217 1216 ! For the flagu/flagv calculation below we require a version of fmask without 1218 1217 ! the land boundary condition (shlat) included: 1219 CALL wrk_alloc(jpi,jpj, zfmask )1220 1218 DO ij = 2, jpjm1 1221 1219 DO ii = 2, jpim1 … … 1346 1344 IF( nb_bdy>0 ) DEALLOCATE( nbidta, nbjdta, nbrdta ) 1347 1345 ! 1348 CALL wrk_dealloc(jpi,jpj, zfmask )1349 1346 ! 1350 1347 IF( nn_timing == 1 ) CALL timing_stop('bdy_segs') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r7646 r7910 25 25 USE fldread ! 26 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE wrk_nemo ! Memory allocation28 27 USE timing ! timing 29 28 … … 76 75 CHARACTER(len=80) :: clfile !: full file name for tidal input file 77 76 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read !: work space to read in tidal harmonics data 78 REAL(wp), POINTER, DIMENSION(:,:) :: ztr, zti !: " " " " " " " "77 REAL(wp), DIMENSION(jpi,jpj) :: ztr, zti !: " " " " " " " " 79 78 !! 80 79 TYPE(TIDES_DATA), POINTER :: td !: local short cut … … 153 152 ! given on the global domain (ie global, jpiglo x jpjglo) 154 153 ! 155 CALL wrk_alloc( jpi,jpj, zti, ztr )156 154 ! 157 155 ! SSH fields … … 203 201 CALL iom_close( inum ) 204 202 ! 205 CALL wrk_dealloc( jpi,jpj, ztr, zti )206 203 ! 207 204 ELSE -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
r7646 r7910 17 17 USE iom ! I/O library (iom_get) 18 18 USE in_out_manager ! I/O manager (ctmp1) 19 USE wrk_nemo ! Memory allocation20 19 USE timing ! Timing 21 20 … … 59 58 REAL(wp) :: zlam1, zcos_alpha, ze1, ze1deg ! Case 5 local scalars 60 59 REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05 ! 61 REAL(wp) , POINTER, DIMENSION(:,:) :: gphidta, glamdta, zdist ! Global lat/lon60 REAL(wp) , DIMENSION(jpidta,jpjdta) :: gphidta, glamdta, zdist ! Global lat/lon 62 61 !! 63 62 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & … … 78 77 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 79 78 80 CALL wrk_alloc( jpidta,jpjdta, gphidta, glamdta, zdist )81 79 82 80 ! ============================= ! … … 187 185 jpjzoom = iloc(2) + njmpp - 2 ! corner index of the zoom domain. 188 186 189 CALL wrk_dealloc( jpidta,jpjdta, gphidta, glamdta, zdist )190 187 191 188 IF (lwp) THEN -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
r6140 r7910 18 18 USE fldread ! read input fields 19 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! Memory allocation21 20 USE timing ! Timing 22 21 … … 143 142 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 144 143 REAL(wp):: zl, zi ! local floats 145 REAL(wp), POINTER, DIMENSION(:) :: zup, zvp ! 1D workspace144 REAL(wp), DIMENSION(jpk) :: zup, zvp ! 1D workspace 146 145 !!---------------------------------------------------------------------- 147 146 ! … … 155 154 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 156 155 ! 157 CALL wrk_alloc( jpk, zup, zvp )158 156 ! 159 157 IF( kt == nit000 .AND. lwp )THEN … … 191 189 END DO 192 190 ! 193 CALL wrk_dealloc( jpk, zup, zvp )194 191 ! 195 192 ELSE !== z- or zps- coordinate ==! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
r6140 r7910 27 27 USE lib_mpp ! MPP library 28 28 USE prtctl ! Print control 29 USE wrk_nemo ! Memory allocation30 29 USE timing ! Timing 31 30 USE iom ! I/O manager … … 154 153 INTEGER :: ji, jj, jk ! dummy loop indices 155 154 REAL(wp) :: zua, zva ! local scalars 156 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuv_dta ! Read in data155 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zuv_dta ! Read in data 157 156 !!---------------------------------------------------------------------- 158 157 ! 159 158 IF( nn_timing == 1 ) CALL timing_start( 'dyn_dmp' ) 160 159 ! 161 CALL wrk_alloc( jpi,jpj,jpk,2, zuv_dta )162 160 ! 163 161 ! !== read and interpolate U & V current data at kt ==! … … 225 223 & tab3d_2=va(:,:,:), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 226 224 ! 227 CALL wrk_dealloc( jpi,jpj,jpk,2, zuv_dta )228 225 ! 229 226 IF( nn_timing == 1 ) CALL timing_stop( 'dyn_dmp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r7646 r7910 36 36 USE par_kind 37 37 USE crslbclnk 38 USE wrk_nemo ! work arrays39 38 USE lib_mpp 40 39 … … 352 351 INTEGER :: ji, jj, jk , ii, ij, je_2 353 352 REAL(wp) :: zdAm 354 REAL(wp), DIMENSION( :,:,:), POINTER:: zvol, zmask353 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol, zmask 355 354 !!---------------------------------------------------------------- 356 355 ! 357 CALL wrk_alloc( jpi,jpj,jpk, zvol, zmask )358 356 ! 359 357 p_fld1_crs(:,:,:) = 0._wp … … 445 443 CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 ) 446 444 ! 447 CALL wrk_dealloc( jpi, jpj, jpk, zvol, zmask )448 445 ! 449 446 END SUBROUTINE crs_dom_facvol … … 487 484 INTEGER :: ii, ij, ijie, ijje, je_2 488 485 REAL(wp) :: zflcrs, zsfcrs 489 REAL(wp), DIMENSION( :,:,:), POINTER:: zsurf, zsurfmsk, zmask486 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsurf, zsurfmsk, zmask 490 487 !!---------------------------------------------------------------- 491 488 ! … … 496 493 CASE ( 'VOL' ) 497 494 ! 498 CALL wrk_alloc( jpi,jpj,jpk, zsurf, zsurfmsk )499 495 ! 500 496 SELECT CASE ( cd_type ) … … 585 581 END SELECT 586 582 587 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )588 583 589 584 CASE ( 'SUM' ) 590 585 591 CALL wrk_alloc( jpi, jpj, jpk, zsurfmsk )592 586 593 587 SELECT CASE ( cd_type ) … … 763 757 ENDIF 764 758 765 CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk )766 759 767 760 CASE ( 'MAX' ) ! search the max of unmasked grid cells 768 761 769 CALL wrk_alloc( jpi, jpj, jpk, zmask )770 762 771 763 SELECT CASE ( cd_type ) … … 934 926 END SELECT 935 927 936 CALL wrk_dealloc( jpi, jpj, jpk, zmask )937 928 938 929 CASE ( 'MIN' ) ! Search the min of unmasked grid cells 939 930 940 CALL wrk_alloc( jpi, jpj, jpk, zmask )941 931 942 932 SELECT CASE ( cd_type ) … … 1104 1094 END SELECT 1105 1095 ! 1106 CALL wrk_dealloc( jpi, jpj, jpk, zmask )1107 1096 ! 1108 1097 END SELECT … … 1149 1138 INTEGER :: ijie, ijje, ii, ij, je_2 1150 1139 REAL(wp) :: zflcrs, zsfcrs 1151 REAL(wp), DIMENSION( :,:), POINTER:: zsurfmsk1140 REAL(wp), DIMENSION(jpi,jpj) :: zsurfmsk 1152 1141 !!---------------------------------------------------------------- 1153 1142 ! … … 1158 1147 CASE ( 'VOL' ) 1159 1148 1160 CALL wrk_alloc( jpi, jpj, zsurfmsk )1161 1149 zsurfmsk(:,:) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 1162 1150 … … 1222 1210 ENDDO 1223 1211 1224 CALL wrk_dealloc( jpi, jpj, zsurfmsk )1225 1212 1226 1213 CASE ( 'SUM' ) 1227 1214 1228 CALL wrk_alloc( jpi, jpj, zsurfmsk )1229 1215 IF( PRESENT( p_e3 ) ) THEN 1230 1216 zsurfmsk(:,:) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) … … 1364 1350 ENDIF 1365 1351 1366 CALL wrk_dealloc( jpi, jpj, zsurfmsk )1367 1352 1368 1353 CASE ( 'MAX' ) … … 1644 1629 INTEGER :: ijie, ijje, ii, ij, je_2 1645 1630 REAL(wp) :: ze3crs 1646 REAL(wp), DIMENSION( :,:,:), POINTER:: zmask, zsurf1631 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, zsurf 1647 1632 1648 1633 !!---------------------------------------------------------------- … … 1652 1637 1653 1638 1654 CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )1655 1639 1656 1640 SELECT CASE ( cd_type ) … … 1756 1740 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 1757 1741 ! 1758 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask )1759 1742 ! 1760 1743 END SUBROUTINE crs_dom_e3 … … 1773 1756 INTEGER :: ji, jj, jk ! dummy loop indices 1774 1757 INTEGER :: ii, ij, je_2 1775 REAL(wp), DIMENSION( :,:,:), POINTER:: zsurf, zsurfmsk1758 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsurf, zsurfmsk 1776 1759 !!---------------------------------------------------------------- 1777 1760 ! Initialize 1778 1761 1779 1762 1780 CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )1781 1763 ! 1782 1764 SELECT CASE ( cd_type ) … … 1868 1850 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 1869 1851 1870 CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf )1871 1852 1872 1853 END SUBROUTINE crs_dom_sfc … … 2236 2217 !! local variables 2237 2218 INTEGER :: ji,jj,jk ! dummy indices 2238 REAL(wp), DIMENSION( :,:) , POINTER:: zmbk2219 REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: zmbk 2239 2220 !!---------------------------------------------------------------- 2240 2221 2241 CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )2242 2222 2243 2223 mbathy_crs(:,:) = jpkm1 … … 2281 2261 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 2282 2262 ! 2283 CALL wrk_dealloc( jpi_crs, jpj_crs, zmbk )2284 2263 ! 2285 2264 END SUBROUTINE crs_dom_bat -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
r6140 r7910 24 24 USE crsdom ! coarse grid domain 25 25 USE crslbclnk ! crs mediator to lbclnk 26 USE wrk_nemo ! Working array27 26 28 27 … … 70 69 INTEGER :: ji, jj, jk ! dummy loop indices 71 70 ! ! workspaces 72 REAL(wp), POINTER, DIMENSION(:,:) :: zprt, zprw73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv74 REAL(wp), POINTER, DIMENSION(:,:) :: ze3tp, ze3wp71 REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: zprt, zprw 72 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zdepu, zdepv 73 REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: ze3tp, ze3wp 75 74 !!---------------------------------------------------------------------- 76 75 ! 77 76 IF( nn_timing == 1 ) CALL timing_start('crs_dom_wri') 78 77 ! 79 CALL wrk_alloc( jpi_crs, jpj_crs, zprt , zprw )80 CALL wrk_alloc( jpi_crs, jpj_crs, ze3tp, ze3wp )81 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv )82 78 83 79 ze3tp(:,:) = 0.0 … … 298 294 END SELECT 299 295 ! 300 CALL wrk_dealloc( jpi_crs, jpj_crs, zprt , zprw )301 CALL wrk_dealloc( jpi_crs, jpj_crs, ze3tp, ze3wp )302 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv )303 296 ! 304 297 IF( nn_timing == 1 ) CALL timing_stop('crs_dom_wri') … … 324 317 INTEGER :: ji ! dummy loop indices 325 318 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not 326 REAL(wp), POINTER, DIMENSION(:,:) :: ztstref319 REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: ztstref 327 320 !!---------------------------------------------------------------------- 328 321 ! 329 322 IF( nn_timing == 1 ) CALL timing_start('crs_dom_uniq_crs') 330 323 ! 331 CALL wrk_alloc( jpi_crs, jpj_crs, ztstref )332 324 ! 333 325 ! build an array with different values for each element … … 345 337 puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 346 338 ! 347 CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref )348 339 ! 349 340 IF( nn_timing == 1 ) CALL timing_stop('crs_dom_uniq_crs') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r6140 r7910 25 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 26 USE timing ! preformance summary 27 USE wrk_nemo ! working array28 27 29 28 IMPLICIT NONE … … 59 58 REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars 60 59 ! 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e362 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt, zs 62 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zt_crs, zs_crs 64 63 !!---------------------------------------------------------------------- 65 64 ! … … 67 66 68 67 ! Initialize arrays 69 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3w ) 70 CALL wrk_alloc( jpi,jpj,jpk, ze3u, ze3v ) 71 CALL wrk_alloc( jpi,jpj,jpk, zt , zs ) 72 ! 73 CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs ) 68 ! 74 69 75 70 ! Depth work arrrays … … 232 227 233 228 ! free memory 234 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3w )235 CALL wrk_dealloc( jpi,jpj,jpk, ze3u, ze3v )236 CALL wrk_dealloc( jpi,jpj,jpk, zt , zs )237 CALL wrk_dealloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs )238 229 ! 239 230 CALL iom_swap( "nemo" ) ! return back on high-resolution grid -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r7646 r7910 22 22 USE in_out_manager 23 23 USE lib_mpp 24 USE wrk_nemo25 24 USE timing ! Timing 26 25 … … 73 72 INTEGER :: ierr ! allocation error status 74 73 INTEGER :: ios ! Local integer output status for namelist read 75 REAL(wp), DIMENSION( :,:,:), POINTER:: ze3t, ze3u, ze3v, ze3w74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w 76 75 77 76 NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn … … 183 182 184 183 ! 185 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3u, ze3v, ze3w )186 184 ! 187 185 ze3t(:,:,:) = e3t_n(:,:,:) … … 248 246 ! 7. Finish and clean-up 249 247 !--------------------------------------------------------- 250 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3u, ze3v, ze3w )251 248 ! 252 249 END SUBROUTINE crs_init -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7753 r7910 16 16 USE iom ! I/O manager library 17 17 USE timing ! preformance summary 18 USE wrk_nemo ! working arrays19 18 USE fldread ! type FLD_N 20 19 USE phycst ! physical constant … … 76 75 REAL(wp) :: zaw, zbw, zrw 77 76 ! 78 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace79 REAL(wp), POINTER, DIMENSION(:,:) :: zpe ! 2D workspace80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace77 REAL(wp), DIMENSION(jpi,jpj) :: zarea_ssh , zbotpres ! 2D workspace 78 REAL(wp), DIMENSION(jpi,jpj) :: zpe ! 2D workspace 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd , zrhop ! 3D workspace 80 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: ztsn ! 4D workspace 82 81 !!-------------------------------------------------------------------- 83 82 IF( nn_timing == 1 ) CALL timing_start('dia_ar5') … … 86 85 87 86 IF( l_ar5 ) THEN 88 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres )89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop )90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn )91 87 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 92 88 ENDIF … … 212 208 ! Exclude points where rn2 is negative as convection kicks in here and 213 209 ! work is not being done against stratification 214 CALL wrk_alloc( jpi, jpj, zpe )215 210 zpe(:,:) = 0._wp 216 211 IF( lk_zdfddm ) THEN … … 242 237 CALL lbc_lnk( zpe, 'T', 1._wp) 243 238 CALL iom_put( 'tnpeo', zpe ) 244 CALL wrk_dealloc( jpi, jpj, zpe )245 239 ENDIF 246 240 ! 247 241 IF( l_ar5 ) THEN 248 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres )249 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop )250 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn )251 242 ENDIF 252 243 ! … … 268 259 ! 269 260 INTEGER :: ji, jj, jk 270 REAL(wp), POINTER, DIMENSION(:,:) :: z2d261 REAL(wp), DIMENSION(jpi,jpj) :: z2d 271 262 272 263 273 264 274 CALL wrk_alloc( jpi, jpj, z2d )275 265 z2d(:,:) = pua(:,:,1) 276 266 DO jk = 1, jpkm1 … … 309 299 ENDIF 310 300 311 CALL wrk_dealloc( jpi, jpj, z2d )312 301 313 302 END SUBROUTINE dia_ar5_hst … … 324 313 INTEGER :: ji, jj, jk ! dummy loop indices 325 314 REAL(wp) :: zztmp 326 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity315 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zsaldta ! Jan/Dec levitus salinity 327 316 ! 328 317 !!---------------------------------------------------------------------- … … 337 326 IF( l_ar5 ) THEN 338 327 ! 339 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )340 328 ! ! allocate dia_ar5 arrays 341 329 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 372 360 ENDIF 373 361 ! 374 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )375 362 ! 376 363 ENDIF -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r7646 r7910 40 40 USE domvvl 41 41 USE timing ! preformance summary 42 USE wrk_nemo ! working arrays43 42 44 43 IMPLICIT NONE … … 209 208 INTEGER , DIMENSION(1) :: ish ! tmp array for mpp_sum 210 209 INTEGER , DIMENSION(3) :: ish2 ! " 211 REAL(wp), POINTER, DIMENSION(:) :: zwork ! "212 REAL(wp), POINTER, DIMENSION(:,:,:):: zsum ! "210 REAL(wp), DIMENSION(itotal) :: zwork ! " 211 REAL(wp), DIMENSION(nb_sec_max,nb_type_class,nb_class_max):: zsum ! " 213 212 !!--------------------------------------------------------------------- 214 213 ! … … 217 216 IF( lk_mpp )THEN 218 217 itotal = nb_sec_max*nb_type_class*nb_class_max 219 CALL wrk_alloc( itotal , zwork )220 CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum )221 218 ENDIF 222 219 … … 289 286 IF( lk_mpp )THEN 290 287 itotal = nb_sec_max*nb_type_class*nb_class_max 291 CALL wrk_dealloc( itotal , zwork )292 CALL wrk_dealloc( nb_sec_max,nb_type_class,nb_class_max , zsum )293 288 ENDIF 294 289 … … 318 313 TYPE(POINT_SECTION),DIMENSION(nb_point_max) ::coordtemp !contains listpoints coordinates 319 314 !read in the file 320 INTEGER, POINTER, DIMENSION(:) :: directemp !contains listpoints directions315 INTEGER, DIMENSION(nb_point_max) :: directemp !contains listpoints directions 321 316 !read in the files 322 317 LOGICAL :: llbon ,&!local logical 323 318 lldebug !debug the section 324 319 !!------------------------------------------------------------------------------------- 325 CALL wrk_alloc( nb_point_max, directemp )326 320 327 321 !open input file … … 495 489 nb_sec = jsec-1 !number of section read in the file 496 490 497 CALL wrk_dealloc( nb_point_max, directemp )498 491 ! 499 492 END SUBROUTINE readsec … … 521 514 istart,iend !first and last points selected in listpoint 522 515 INTEGER :: jpoint !loop on list points 523 INTEGER, POINTER, DIMENSION(:) :: idirec !contains temporary sec%direction524 INTEGER, POINTER, DIMENSION(:,:) :: icoord !contains temporary sec%listpoint516 INTEGER, DIMENSION(nb_point_max) :: idirec !contains temporary sec%direction 517 INTEGER, DIMENSION(2,nb_point_max) :: icoord !contains temporary sec%listpoint 525 518 !---------------------------------------------------------------------------- 526 CALL wrk_alloc( nb_point_max, idirec )527 CALL wrk_alloc( 2, nb_point_max, icoord )528 519 529 520 IF( ld_debug )WRITE(numout,*)' -------------------------' … … 575 566 ENDIF 576 567 577 CALL wrk_dealloc( nb_point_max, idirec )578 CALL wrk_dealloc( 2, nb_point_max, icoord )579 568 END SUBROUTINE removepoints 580 569 … … 1019 1008 REAL(wp) :: zslope ! section's slope coeff 1020 1009 ! 1021 REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace1010 REAL(wp), DIMENSION(nb_type_class):: zsumclasses ! 1D workspace 1022 1011 !!------------------------------------------------------------- 1023 CALL wrk_alloc(nb_type_class , zsumclasses )1024 1012 1025 1013 zsumclasses(:)=0._wp … … 1133 1121 119 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6) 1134 1122 1135 CALL wrk_dealloc(nb_type_class , zsumclasses )1136 1123 ! 1137 1124 END SUBROUTINE dia_dct_wri -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r7646 r7910 22 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 23 USE timing ! preformance summary 24 USE wrk_nemo ! working arrays25 24 26 25 IMPLICIT NONE … … 226 225 REAL(wp) :: ztime, ztime_ini, ztime_end 227 226 REAL(wp) :: X1,X2 228 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ana_amp 229 !!-------------------------------------------------------------------- 230 CALL wrk_alloc( jpi , jpj , jpmax_harmo , 2 , ana_amp ) 227 REAL(wp), DIMENSION(jpi,jpj,jpmax_harmo,2) :: ana_amp 228 !!-------------------------------------------------------------------- 231 229 232 230 IF(lwp) WRITE(numout,*) … … 366 364 367 365 CALL dia_wri_harm ! Write results in files 368 CALL wrk_dealloc( jpi , jpj , jpmax_harmo , 2 , ana_amp )369 366 ! 370 367 END SUBROUTINE dia_harm_end … … 427 424 INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 428 425 REAL(wp) :: zval1, zval2, zx1 429 REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2430 INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot426 REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2 427 INTEGER , DIMENSION(jpincomax) :: ipos2, ipivot 431 428 !--------------------------------------------------------------------------------- 432 CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 )433 CALL wrk_alloc( jpincomax , ipos2 , ipivot )434 429 435 430 IF( init == 1 ) THEN … … 518 513 END DO 519 514 520 CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 )521 CALL wrk_dealloc( jpincomax , ipos2 , ipivot )522 515 ! 523 516 END SUBROUTINE SUR_DETERMINE -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r7753 r7910 31 31 USE lib_mpp ! distributed memory computing library 32 32 USE timing ! preformance summary 33 USE wrk_nemo ! work arrays34 33 35 34 IMPLICIT NONE … … 82 81 REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - - 83 82 REAL(wp) :: z_ssh_hc , z_ssh_sc ! - - 84 REAL(wp), DIMENSION( :,:), POINTER:: z2d0, z2d183 REAL(wp), DIMENSION(jpi,jpj) :: z2d0, z2d1 85 84 !!--------------------------------------------------------------------------- 86 85 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 87 86 ! 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 )89 87 ! 90 88 tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; … … 228 226 IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' ) 229 227 ! 230 CALL wrk_dealloc( jpi,jpj, z2d0, z2d1 )231 228 ! 232 229 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r7646 r7910 12 12 USE in_out_manager ! I/O units 13 13 USE iom ! I/0 library 14 USE wrk_nemo ! working arrays15 14 16 15 … … 105 104 !!-------------------------------------------------------------------- 106 105 REAL(wp) :: zmdi =1.e+20 ! land value 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb ! workspace106 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! workspace 108 107 !!-------------------------------------------------------------------- 109 108 ! 110 109 IF (ln_diatmb) THEN 111 CALL wrk_alloc( jpi,jpj,3 , zwtmb )112 110 CALL dia_calctmb( tsn(:,:,:,jp_tem),zwtmb ) 113 111 !ssh already output but here we output it masked … … 134 132 CALL iom_put( "bot_v" , zwtmb(:,:,3) ) ! tmb V Velocity 135 133 !Called in dynspg_ts.F90 CALL iom_put( "baro_v" , vn_b ) ! Barotropic V Velocity 136 CALL wrk_dealloc( jpi,jpj,3 , zwtmb )137 134 ELSE 138 135 CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7753 r7910 60 60 USE diurnal_bulk ! diurnal warm layer 61 61 USE cool_skin ! Cool skin 62 USE wrk_nemo ! working array63 62 64 63 IMPLICIT NONE … … 127 126 REAL(wp) :: zztmp, zztmpx, zztmpy ! 128 127 !! 129 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace130 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace128 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 129 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 131 130 !!---------------------------------------------------------------------- 132 131 ! 133 132 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 134 133 ! 135 CALL wrk_alloc( jpi , jpj , z2d )136 CALL wrk_alloc( jpi , jpj, jpk , z3d )137 134 ! 138 135 ! Output the initial state and forcings … … 408 405 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 409 406 ! 410 CALL wrk_dealloc( jpi , jpj , z2d )411 CALL wrk_dealloc( jpi , jpj, jpk , z3d )412 407 ! 413 408 ! If we want tmb values … … 452 447 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars 453 448 ! 454 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace455 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace449 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 450 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 456 451 !!---------------------------------------------------------------------- 457 452 ! 458 453 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 459 454 ! 460 CALL wrk_alloc( jpi,jpj , zw2d )461 IF( .NOT.ln_linssh ) CALL wrk_alloc( jpi,jpj,jpk , zw3d )462 455 ! 463 456 ! Output the initial state and forcings … … 894 887 ENDIF 895 888 ! 896 CALL wrk_dealloc( jpi , jpj , zw2d )897 IF( .NOT.ln_linssh ) CALL wrk_dealloc( jpi , jpj , jpk , zw3d )898 889 ! 899 890 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r7753 r7910 30 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 31 USE lib_mpp ! Massively Parallel Processing library 32 USE wrk_nemo ! Memory allocation33 32 USE timing ! Timing 34 33 … … 92 91 INTEGER :: iktop, ikbot ! - - 93 92 INTEGER :: ios, inum 94 REAL(wp), POINTER, DIMENSION(:,:) :: zwf ! 2D workspace93 REAL(wp), DIMENSION(jpi,jpj) :: zwf ! 2D workspace 95 94 !! 96 95 NAMELIST/namlbc/ rn_shlat, ln_vorlat … … 248 247 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition 249 248 ! 250 CALL wrk_alloc( jpi,jpj, zwf )251 249 ! 252 250 DO jk = 1, jpk … … 278 276 END DO 279 277 ! 280 CALL wrk_dealloc( jpi,jpj, zwf )281 278 ! 282 279 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
r7646 r7910 13 13 USE in_out_manager ! I/O manager 14 14 USE lib_mpp ! for mppsum 15 USE wrk_nemo ! Memory allocation16 15 USE timing ! Timing 17 16 … … 45 44 INTEGER , DIMENSION(2) :: iloc 46 45 REAL(wp) :: zlon, zmini 47 REAL(wp), POINTER, DIMENSION(:,:) :: zglam, zgphi, zmask, zdist46 REAL(wp), DIMENSION(jpi,jpj) :: zglam, zgphi, zmask, zdist 48 47 !!-------------------------------------------------------------------- 49 48 ! 50 49 IF( nn_timing == 1 ) CALL timing_start('dom_ngb') 51 50 ! 52 CALL wrk_alloc( jpi,jpj, zglam, zgphi, zmask, zdist )53 51 ! 54 52 zmask(:,:) = 0._wp … … 79 77 ENDIF 80 78 ! 81 CALL wrk_dealloc( jpi,jpj, zglam, zgphi, zmask, zdist )82 79 ! 83 80 IF( nn_timing == 1 ) CALL timing_stop('dom_ngb') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r7753 r7910 31 31 USE lib_mpp ! distributed memory computing library 32 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE wrk_nemo ! Memory allocation34 33 USE timing ! Timing 35 34 … … 276 275 REAL(wp) :: z2dt, z_tmin, z_tmax ! local scalars 277 276 LOGICAL :: ll_do_bclinic ! local logical 278 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t279 REAL(wp), POINTER, DIMENSION(:,:) :: zht, z_scale, zwu, zwv, zhdiv277 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 278 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 280 279 !!---------------------------------------------------------------------- 281 280 ! … … 284 283 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_nxt') 285 284 ! 286 CALL wrk_alloc( jpi,jpj,zht, z_scale, zwu, zwv, zhdiv )287 CALL wrk_alloc( jpi,jpj,jpk, ze3t )288 285 289 286 IF( kt == nit000 ) THEN … … 543 540 r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 544 541 ! 545 CALL wrk_dealloc( jpi,jpj, zht, z_scale, zwu, zwv, zhdiv )546 CALL wrk_dealloc( jpi,jpj,jpk, ze3t )547 542 ! 548 543 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_sf_nxt') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r7646 r7910 24 24 USE lbclnk ! lateral boundary conditions - mpp exchanges 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! Memory allocation27 26 USE timing ! Timing 28 27 … … 75 74 INTEGER :: izco, izps, isco, icav 76 75 ! 77 REAL(wp), POINTER, DIMENSION(:,:) :: zprt, zprw ! 2D workspace78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv ! 3D workspace76 REAL(wp), DIMENSION(jpi,jpj) :: zprt, zprw ! 2D workspace 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepu, zdepv ! 3D workspace 79 78 !!---------------------------------------------------------------------- 80 79 ! 81 80 IF( nn_timing == 1 ) CALL timing_start('dom_wri') 82 81 ! 83 CALL wrk_alloc( jpi,jpj, zprt , zprw )84 CALL wrk_alloc( jpi,jpj,jpk, zdepu, zdepv )85 82 ! 86 83 IF(lwp) WRITE(numout,*) … … 206 203 ! ! ============================ 207 204 ! 208 CALL wrk_dealloc( jpi, jpj, zprt, zprw )209 CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv )210 205 ! 211 206 IF( nn_timing == 1 ) CALL timing_stop('dom_wri') … … 229 224 INTEGER :: ji ! dummy loop indices 230 225 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not 231 REAL(wp), POINTER, DIMENSION(:,:) :: ztstref226 REAL(wp), DIMENSION(jpi,jpj) :: ztstref 232 227 !!---------------------------------------------------------------------- 233 228 ! 234 229 IF( nn_timing == 1 ) CALL timing_start('dom_uniq') 235 230 ! 236 CALL wrk_alloc( jpi, jpj, ztstref )237 231 ! 238 232 ! build an array with different values for each element … … 250 244 puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 251 245 ! 252 CALL wrk_dealloc( jpi, jpj, ztstref )253 246 ! 254 247 IF( nn_timing == 1 ) CALL timing_stop('dom_uniq') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7753 r7910 36 36 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 37 37 USE lib_mpp ! distributed memory computing library 38 USE wrk_nemo ! Memory allocation39 38 USE timing ! Timing 40 39 … … 284 283 ! 285 284 INTEGER :: ji, jj ! dummy loop indices 286 REAL(wp), POINTER, DIMENSION(:,:) :: zk285 REAL(wp), DIMENSION(jpi,jpj) :: zk 287 286 !!---------------------------------------------------------------------- 288 287 ! 289 288 IF( nn_timing == 1 ) CALL timing_start('zgr_top_bot') 290 289 ! 291 CALL wrk_alloc( jpi,jpj, zk )292 290 ! 293 291 IF(lwp) WRITE(numout,*) … … 319 317 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 320 318 ! 321 CALL wrk_dealloc( jpi,jpj, zk )322 319 ! 323 320 IF( nn_timing == 1 ) CALL timing_stop('zgr_top_bot') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r7753 r7910 21 21 USE phycst ! physical constants 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! Memory allocation24 23 USE timing ! Timing 25 24 … … 146 145 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 147 146 REAL(wp):: zl, zi 148 REAL(wp), POINTER, DIMENSION(:) :: ztp, zsp ! 1D workspace147 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 149 148 !!---------------------------------------------------------------------- 150 149 ! … … 186 185 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 187 186 ! 188 CALL wrk_alloc( jpk, ztp, zsp )189 187 ! 190 188 IF( kt == nit000 .AND. lwp )THEN … … 222 220 END DO 223 221 ! 224 CALL wrk_dealloc( jpk, ztp, zsp )225 222 ! 226 223 ELSE !== z- or zps- coordinate ==! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
r7646 r7910 21 21 USE lib_mpp ! MPP library 22 22 USE lib_fortran ! MPP library 23 USE wrk_nemo ! Memory allocation24 23 USE lbclnk ! 25 24 USE domngb ! … … 65 64 !! 66 65 REAL(wp):: zde3t, zdtem, zdsal 67 REAL(wp), DIMENSION( :,:), POINTER:: zdssh66 REAL(wp), DIMENSION(jpi,jpj) :: zdssh 68 67 !! 69 68 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat … … 72 71 INTEGER :: jpts, npts 73 72 74 CALL wrk_alloc(jpi,jpj, zdssh )75 73 76 74 ! get imbalance (volume heat and salt) … … 289 287 290 288 ! deallocate variables 291 CALL wrk_dealloc(jpi,jpj, zdssh )292 289 293 290 END SUBROUTINE iscpl_cons -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r7646 r7910 21 21 USE lib_mpp ! MPP library 22 22 USE lib_fortran ! MPP library 23 USE wrk_nemo ! Memory allocation24 23 USE lbclnk ! communication 25 24 USE iscplini ! ice sheet coupling: initialisation … … 50 49 !!---------------------------------------------------------------------- 51 50 INTEGER :: inum0 52 REAL(wp), DIMENSION( :,: ), POINTER:: zsmask_b53 REAL(wp), DIMENSION( :,:,:), POINTER:: ztmask_b, zumask_b, zvmask_b54 REAL(wp), DIMENSION( :,:,:), POINTER:: ze3t_b , ze3u_b , ze3v_b55 REAL(wp), DIMENSION( :,:,:), POINTER:: zdepw_b51 REAL(wp), DIMENSION(jpi,jpj) :: zsmask_b 52 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b, zumask_b, zvmask_b 53 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b , ze3u_b , ze3v_b 54 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepw_b 56 55 CHARACTER(20) :: cfile 57 56 !!---------------------------------------------------------------------- 58 57 59 CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before60 CALL wrk_alloc(jpi,jpj,jpk, ze3t_b , ze3u_b , ze3v_b ) ! e3 before61 CALL wrk_alloc(jpi,jpj,jpk, zdepw_b )62 CALL wrk_alloc(jpi,jpj, zsmask_b )63 58 64 59 … … 98 93 END IF 99 94 100 CALL wrk_dealloc(jpi,jpj,jpk, ztmask_b,zumask_b,zvmask_b )101 CALL wrk_dealloc(jpi,jpj,jpk, ze3t_b ,ze3u_b ,ze3v_b )102 CALL wrk_dealloc(jpi,jpj,jpk, zdepw_b )103 CALL wrk_dealloc(jpi,jpj, zsmask_b )104 95 105 96 !! next step is an euler time step … … 150 141 REAL(wp):: zdz, zdzm1, zdzp1 151 142 !! 152 REAL(wp), DIMENSION( :,: ), POINTER:: zdmask , zdsmask, zvcorr, zucorr, zde3t153 REAL(wp), DIMENSION( :,: ), POINTER:: zbub , zbvb , zbun , zbvn154 REAL(wp), DIMENSION( :,: ), POINTER:: zssh0 , zssh1, zhu1, zhv1155 REAL(wp), DIMENSION( :,: ), POINTER:: zsmask0, zsmask1156 REAL(wp), DIMENSION( :,:,: ), POINTER:: ztmask0, ztmask1, ztrp157 REAL(wp), DIMENSION( :,:,: ), POINTER:: zwmaskn, zwmaskb, ztmp3d158 REAL(wp), DIMENSION( :,:,:,:), POINTER:: zts0143 REAL(wp), DIMENSION(jpi,jpj) :: zdmask , zdsmask, zvcorr, zucorr, zde3t 144 REAL(wp), DIMENSION(jpi,jpj) :: zbub , zbvb , zbun , zbvn 145 REAL(wp), DIMENSION(jpi,jpj) :: zssh0 , zssh1, zhu1, zhv1 146 REAL(wp), DIMENSION(jpi,jpj) :: zsmask0, zsmask1 147 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask0, ztmask1, ztrp 148 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwmaskn, zwmaskb, ztmp3d 149 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zts0 159 150 !!---------------------------------------------------------------------- 160 151 161 152 !! allocate variables 162 CALL wrk_alloc(jpi,jpj,jpk,2, zts0 )163 CALL wrk_alloc(jpi,jpj,jpk, ztmask0, ztmask1 , ztrp, ztmp3d )164 CALL wrk_alloc(jpi,jpj,jpk, zwmaskn, zwmaskb )165 CALL wrk_alloc(jpi,jpj, zsmask0, zsmask1 )166 CALL wrk_alloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t)167 CALL wrk_alloc(jpi,jpj, zbub , zbvb , zbun , zbvn )168 CALL wrk_alloc(jpi,jpj, zssh0 , zssh1, zhu1, zhv1 )169 153 170 154 !! mask value to be sure … … 430 414 ! 431 415 ! deallocation tmp arrays 432 CALL wrk_dealloc(jpi,jpj,jpk,2, zts0 )433 CALL wrk_dealloc(jpi,jpj,jpk, ztmask0, ztmask1 , ztrp )434 CALL wrk_dealloc(jpi,jpj,jpk, zwmaskn, zwmaskb , ztmp3d )435 CALL wrk_dealloc(jpi,jpj, zsmask0, zsmask1 )436 CALL wrk_dealloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t)437 CALL wrk_dealloc(jpi,jpj, zbub , zbvb , zbun , zbvn )438 CALL wrk_dealloc(jpi,jpj, zssh0 , zssh1 , zhu1 , zhv1 )439 416 ! 440 417 END SUBROUTINE iscpl_rst_interpol -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r7753 r7910 60 60 !!---------------------------------------------------------------------- 61 61 INTEGER :: ji, jj, jk ! dummy loop indices 62 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace62 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zuvd ! U & V data workspace 63 63 !!---------------------------------------------------------------------- 64 64 ! … … 121 121 !!gm to be moved in usrdef of C1D case 122 122 ! IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 123 ! CALL wrk_alloc( jpi,jpj,jpk,2, zuvd )124 123 ! CALL dta_uvd( nit000, zuvd ) 125 124 ! ub(:,:,:) = zuvd(:,:,:,1) ; un(:,:,:) = ub(:,:,:) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r6750 r7910 20 20 USE lib_mpp ! MPP library 21 21 USE prtctl ! Print control 22 USE wrk_nemo ! Memory Allocation23 22 USE timing ! Timing 24 23 … … 51 50 ! 52 51 INTEGER :: ji, jj, jk ! dummy loop indices 53 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw54 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfv52 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 53 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu, zfv 55 54 !!---------------------------------------------------------------------- 56 55 ! 57 56 IF( nn_timing == 1 ) CALL timing_start('dyn_adv_cen2') 58 57 ! 59 CALL wrk_alloc( jpi,jpj,jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )60 58 ! 61 59 IF( kt == nit000 .AND. lwp ) THEN … … 148 146 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 149 147 ! 150 CALL wrk_dealloc( jpi, jpj, jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )151 148 ! 152 149 IF( nn_timing == 1 ) CALL timing_stop('dyn_adv_cen2') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r6750 r7910 23 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! Memory Allocation26 25 USE timing ! Timing 27 26 … … 74 73 INTEGER :: ji, jj, jk ! dummy loop indices 75 74 REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v ! local scalars 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfv77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw78 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlu_uu, zlv_vv, zlu_uv, zlv_vu75 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu, zfv 76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 77 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zlu_uu, zlv_vv, zlu_uv, zlv_vu 79 78 !!---------------------------------------------------------------------- 80 79 ! 81 80 IF( nn_timing == 1 ) CALL timing_start('dyn_adv_ubs') 82 81 ! 83 CALL wrk_alloc( jpi,jpj,jpk, zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )84 CALL wrk_alloc( jpi,jpj,jpk,jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu )85 82 ! 86 83 IF( kt == nit000 ) THEN … … 241 238 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 242 239 ! 243 CALL wrk_dealloc( jpi,jpj,jpk, zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )244 CALL wrk_dealloc( jpi,jpj,jpk,jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu )245 240 ! 246 241 IF( nn_timing == 1 ) CALL timing_stop('dyn_adv_ubs') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r7753 r7910 21 21 USE prtctl ! Print control 22 22 USE timing ! Timing 23 USE wrk_nemo ! Memory Allocation24 23 25 24 IMPLICIT NONE … … 50 49 INTEGER :: ikbu, ikbv ! local integers 51 50 REAL(wp) :: zm1_2dt ! local scalar 52 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv51 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 53 52 !!--------------------------------------------------------------------- 54 53 ! … … 64 63 65 64 IF( l_trddyn ) THEN ! trends: store the input trends 66 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )67 65 ztrdu(:,:,:) = ua(:,:,:) 68 66 ztrdv(:,:,:) = va(:,:,:) … … 102 100 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 103 101 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 104 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )105 102 ENDIF 106 103 ! ! print mean trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7761 r7910 44 44 USE lib_mpp ! MPP library 45 45 USE eosbn2 ! compute density 46 USE wrk_nemo ! Memory Allocation47 46 USE timing ! Timing 48 47 USE iom … … 84 83 !!---------------------------------------------------------------------- 85 84 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 87 86 !!---------------------------------------------------------------------- 88 87 ! … … 90 89 ! 91 90 IF( l_trddyn ) THEN ! Temporary saving of ua and va trends (l_trddyn) 92 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )93 91 ztrdu(:,:,:) = ua(:,:,:) 94 92 ztrdv(:,:,:) = va(:,:,:) … … 108 106 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 109 107 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 110 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )111 108 ENDIF 112 109 ! … … 134 131 INTEGER :: ji, jj, jk, ikt ! dummy loop indices ISF 135 132 REAL(wp) :: znad 136 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztstop, zrhd ! hypothesys on isf density 137 REAL(wp), POINTER, DIMENSION(:,:) :: zrhdtop_isf ! density at bottom of ISF 138 REAL(wp), POINTER, DIMENSION(:,:) :: ziceload ! density at bottom of ISF 133 REAL(wp), DIMENSION(jpi,jpj,2) :: ztstop ! hypothesys on isf density 134 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd ! hypothesys on isf density 135 REAL(wp), DIMENSION(jpi,jpj) :: zrhdtop_isf ! density at bottom of ISF 136 REAL(wp), DIMENSION(jpi,jpj) :: ziceload ! density at bottom of ISF 139 137 !! 140 138 NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, & … … 200 198 IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 201 199 IF ( ln_isfcav ) THEN 202 CALL wrk_alloc( jpi,jpj, 2, ztstop)203 CALL wrk_alloc( jpi,jpj,jpk, zrhd )204 CALL wrk_alloc( jpi,jpj, zrhdtop_isf, ziceload)205 200 ! 206 201 IF(lwp) WRITE(numout,*) … … 240 235 riceload(:,:)=ziceload(:,:) ! need to be saved for diaar5 241 236 242 CALL wrk_dealloc( jpi,jpj, 2, ztstop)243 CALL wrk_dealloc( jpi,jpj,jpk, zrhd )244 CALL wrk_dealloc( jpi,jpj, zrhdtop_isf, ziceload)245 237 END IF 246 238 ! … … 268 260 INTEGER :: ji, jj, jk ! dummy loop indices 269 261 REAL(wp) :: zcoef0, zcoef1 ! temporary scalars 270 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 271 !!---------------------------------------------------------------------- 272 ! 273 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 262 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 263 !!---------------------------------------------------------------------- 264 ! 274 265 ! 275 266 IF( kt == nit000 ) THEN … … 315 306 END DO 316 307 ! 317 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )318 308 ! 319 309 END SUBROUTINE hpg_zco … … 333 323 INTEGER :: iku, ikv ! temporary integers 334 324 REAL(wp) :: zcoef0, zcoef1, zcoef2, zcoef3 ! temporary scalars 335 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 336 !!---------------------------------------------------------------------- 337 ! 338 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 325 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 326 !!---------------------------------------------------------------------- 327 ! 339 328 ! 340 329 IF( kt == nit000 ) THEN … … 405 394 END DO 406 395 ! 407 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )408 396 ! 409 397 END SUBROUTINE hpg_zps … … 433 421 REAL(wp) :: zcoef0, zuap, zvap, znad, ztmp ! temporary scalars 434 422 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 435 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 436 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 437 !!---------------------------------------------------------------------- 438 ! 439 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 440 IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 423 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 424 REAL(wp), DIMENSION(jpi,jpj) :: zcpx, zcpy !W/D pressure filter 425 !!---------------------------------------------------------------------- 426 ! 441 427 ! 442 428 IF( kt == nit000 ) THEN … … 554 540 END DO 555 541 ! 556 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )557 IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )558 542 ! 559 543 END SUBROUTINE hpg_sco … … 583 567 INTEGER :: ji, jj, jk, ikt, iktp1i, iktp1j ! dummy loop indices 584 568 REAL(wp) :: zcoef0, zuap, zvap, znad ! temporary scalars 585 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 586 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztstop 587 REAL(wp), POINTER, DIMENSION(:,:) :: zrhdtop_oce 588 !!---------------------------------------------------------------------- 589 ! 590 CALL wrk_alloc( jpi,jpj, 2, ztstop) 591 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj) 592 CALL wrk_alloc( jpi,jpj, zrhdtop_oce ) 569 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 570 REAL(wp), DIMENSION(jpi,jpj,2) :: ztstop 571 REAL(wp), DIMENSION(jpi,jpj) :: zrhdtop_oce 572 !!---------------------------------------------------------------------- 573 ! 593 574 ! 594 575 ! Local constant initialization … … 668 649 END DO 669 650 ! 670 CALL wrk_dealloc( jpi,jpj,2 , ztstop)671 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj)672 CALL wrk_dealloc( jpi,jpj , zrhdtop_oce )673 651 ! 674 652 END SUBROUTINE hpg_isf … … 690 668 REAL(wp) :: z1_12, cffv, cffy ! " " 691 669 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 692 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 693 REAL(wp), POINTER, DIMENSION(:,:,:) :: dzx, dzy, dzz, dzu, dzv, dzw 694 REAL(wp), POINTER, DIMENSION(:,:,:) :: drhox, drhoy, drhoz, drhou, drhov, drhow 695 REAL(wp), POINTER, DIMENSION(:,:,:) :: rho_i, rho_j, rho_k 696 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 697 !!---------------------------------------------------------------------- 698 ! 699 CALL wrk_alloc( jpi, jpj, jpk, dzx , dzy , dzz , dzu , dzv , dzw ) 700 CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 701 CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj ) 702 IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 670 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 671 REAL(wp), DIMENSION(jpi,jpj,jpk) :: dzx, dzy, dzz, dzu, dzv, dzw 672 REAL(wp), DIMENSION(jpi,jpj,jpk) :: drhox, drhoy, drhoz, drhou, drhov, drhow 673 REAL(wp), DIMENSION(jpi,jpj,jpk) :: rho_i, rho_j, rho_k 674 REAL(wp), DIMENSION(jpi,jpj) :: zcpx, zcpy !W/D pressure filter 675 !!---------------------------------------------------------------------- 676 ! 703 677 ! 704 678 ! … … 949 923 END DO 950 924 ! 951 CALL wrk_dealloc( jpi, jpj, jpk, dzx , dzy , dzz , dzu , dzv , dzw )952 CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )953 CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj )954 IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )955 925 ! 956 926 END SUBROUTINE hpg_djc … … 980 950 REAL(wp) :: zrhdt1 981 951 REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 982 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdept, zrhh 983 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 984 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_n, zsshv_n 985 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 986 !!---------------------------------------------------------------------- 987 ! 988 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 989 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 990 CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n ) 991 IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 952 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdept, zrhh 953 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 954 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_n, zsshv_n 955 REAL(wp), DIMENSION(jpi,jpj) :: zcpx, zcpy !W/D pressure filter 956 !!---------------------------------------------------------------------- 957 ! 992 958 ! 993 959 IF( kt == nit000 ) THEN … … 1298 1264 END DO 1299 1265 ! 1300 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )1301 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh )1302 CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n )1303 IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )1304 1266 ! 1305 1267 END SUBROUTINE hpg_prj -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r7753 r7910 22 22 USE lib_mpp ! MPP library 23 23 USE prtctl ! Print control 24 USE wrk_nemo ! Memory Allocation25 24 USE timing ! Timing 26 25 USE bdy_oce ! ocean open boundary conditions … … 77 76 INTEGER :: ji, jj, jk ! dummy loop indices 78 77 REAL(wp) :: zu, zv ! temporary scalars 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke80 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv78 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhke 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 81 80 INTEGER :: jb ! dummy loop indices 82 81 INTEGER :: ii, ij, igrd, ib_bdy ! local integers … … 86 85 IF( nn_timing == 1 ) CALL timing_start('dyn_keg') 87 86 ! 88 CALL wrk_alloc( jpi,jpj,jpk, zhke )89 87 ! 90 88 IF( kt == nit000 ) THEN … … 95 93 96 94 IF( l_trddyn ) THEN ! Save ua and va trends 97 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )98 95 ztrdu(:,:,:) = ua(:,:,:) 99 96 ztrdv(:,:,:) = va(:,:,:) … … 187 184 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 188 185 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 189 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )190 186 ENDIF 191 187 ! … … 193 189 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 194 190 ! 195 CALL wrk_dealloc( jpi,jpj,jpk, zhke )196 191 ! 197 192 IF( nn_timing == 1 ) CALL timing_stop('dyn_keg') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r7753 r7910 27 27 USE lib_mpp ! distribued memory computing library 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 USE wrk_nemo ! Memory Allocation30 29 USE timing ! Timing 31 30 … … 62 61 INTEGER, INTENT(in) :: kt ! ocean time-step index 63 62 ! 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 65 64 !!---------------------------------------------------------------------- 66 65 ! … … 68 67 ! 69 68 IF( l_trddyn ) THEN ! temporary save of momentum trends 70 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )71 69 ztrdu(:,:,:) = ua(:,:,:) 72 70 ztrdv(:,:,:) = va(:,:,:) … … 85 83 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 86 84 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 87 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )88 85 ENDIF 89 86 ! ! print sum trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r6140 r7910 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 29 USE prtctl ! Print control 30 USE wrk_nemo ! Memory Allocation31 30 USE timing ! Timing 32 31 … … 112 111 REAL(wp) :: zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - 113 112 ! 114 REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v113 REAL(wp), DIMENSION(jpi,jpj) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 115 114 !!---------------------------------------------------------------------- 116 115 ! 117 116 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_iso') 118 117 ! 119 CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )120 118 ! 121 119 IF( kt == nit000 ) THEN … … 409 407 END DO ! End of slab 410 408 ! ! =============== 411 CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )412 409 ! 413 410 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_iso') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
r7753 r7910 19 19 USE in_out_manager ! I/O manager 20 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 USE wrk_nemo ! Memory Allocation22 21 USE timing ! Timing 23 22 … … 57 56 REAL(wp) :: zsign ! local scalars 58 57 REAL(wp) :: zua, zva ! local scalars 59 REAL(wp), POINTER, DIMENSION(:,:) :: zcur, zdiv58 REAL(wp), DIMENSION(jpi,jpj) :: zcur, zdiv 60 59 !!---------------------------------------------------------------------- 61 60 ! … … 68 67 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_lap') 69 68 ! 70 CALL wrk_alloc( jpi, jpj, zcur, zdiv )71 69 ! 72 70 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign … … 107 105 END DO ! End of slab 108 106 ! ! =============== 109 CALL wrk_dealloc( jpi, jpj, zcur, zdiv )110 107 ! 111 108 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_lap') … … 131 128 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend 132 129 ! 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: zulap, zvlap ! laplacian at u- and v-point130 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zulap, zvlap ! laplacian at u- and v-point 134 131 !!---------------------------------------------------------------------- 135 132 ! 136 133 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_blp') 137 134 ! 138 CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap )139 135 ! 140 136 IF( kt == nit000 ) THEN … … 154 150 CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 ) ! rotated laplacian applied to zlap (output in pta) 155 151 ! 156 CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap )157 152 ! 158 153 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_blp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r7753 r7910 44 44 USE lbclnk ! lateral boundary condition (or mpp link) 45 45 USE lib_mpp ! MPP library 46 USE wrk_nemo ! Memory Allocation47 46 USE prtctl ! Print control 48 47 USE timing ! Timing … … 97 96 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zcoef ! local scalars 98 97 REAL(wp) :: zve3a, zve3n, zve3b, zvf, z1_2dt ! - - 99 REAL(wp), POINTER, DIMENSION(:,:) :: zue, zve100 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f, zua, zva98 REAL(wp), DIMENSION(jpi,jpj) :: zue, zve 99 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3u_f, ze3v_f, zua, zva 101 100 !!---------------------------------------------------------------------- 102 101 ! 103 102 IF( nn_timing == 1 ) CALL timing_start('dyn_nxt') 104 103 ! 105 IF( ln_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zue, zve)106 IF( l_trddyn ) CALL wrk_alloc( jpi,jpj,jpk, zua, zva)107 104 ! 108 105 IF( kt == nit000 ) THEN … … 253 250 ELSE ! Asselin filter applied on thickness weighted velocity 254 251 ! 255 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f )256 252 ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 257 253 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) … … 280 276 e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 281 277 ! 282 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f )283 278 ENDIF 284 279 ! … … 346 341 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 347 342 ! 348 IF( ln_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zue, zve )349 IF( l_trddyn ) CALL wrk_dealloc( jpi,jpj,jpk, zua, zva )350 343 ! 351 344 IF( nn_timing == 1 ) CALL timing_stop('dyn_nxt') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7753 r7910 28 28 USE in_out_manager ! I/O manager 29 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! Memory Allocation31 30 USE timing ! Timing 32 31 … … 75 74 INTEGER :: ji, jj, jk ! dummy loop indices 76 75 REAL(wp) :: z2dt, zg_2, zintp, zgrau0r ! temporary scalar 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv78 REAL(wp), POINTER, DIMENSION(:,:) :: zpice76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 77 REAL(wp), DIMENSION(jpi,jpj) :: zpice 79 78 !!---------------------------------------------------------------------- 80 79 ! … … 82 81 ! 83 82 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 84 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )85 83 ztrdu(:,:,:) = ua(:,:,:) 86 84 ztrdv(:,:,:) = va(:,:,:) … … 124 122 ! 125 123 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 126 CALL wrk_alloc( jpi,jpj, zpice )127 124 ! 128 125 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) … … 136 133 END DO 137 134 ! 138 CALL wrk_dealloc( jpi,jpj, zpice )139 135 ENDIF 140 136 ! … … 161 157 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 162 158 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 163 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )164 159 ENDIF 165 160 ! ! print mean trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7831 r7910 47 47 USE iom ! IOM library 48 48 USE restart ! only for lrst_oce 49 USE wrk_nemo ! Memory Allocation50 49 USE timing ! Timing 51 50 USE diatmb ! Top,middle,bottom output … … 151 150 REAL(wp) :: za0, za1, za2, za3 ! - - 152 151 ! 153 REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e154 REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc155 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv156 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e157 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a158 REAL(wp), POINTER, DIMENSION(:,:) :: zhf159 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy ! Wetting/Dying gravity filter coef.152 REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e 153 REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 154 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zhdiv 155 REAL(wp), DIMENSION(jpi,jpj) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 156 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zsshv_a 157 REAL(wp), DIMENSION(jpi,jpj) :: zhf 158 REAL(wp), DIMENSION(jpi,jpj) :: zcpx, zcpy ! Wetting/Dying gravity filter coef. 160 159 !!---------------------------------------------------------------------- 161 160 ! … … 163 162 ! 164 163 ! !* Allocate temporary arrays 165 CALL wrk_alloc( jpi,jpj, zsshp2_e, zhdiv )166 CALL wrk_alloc( jpi,jpj, zu_trd, zv_trd)167 CALL wrk_alloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc)168 CALL wrk_alloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e)169 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a )170 CALL wrk_alloc( jpi,jpj, zhf )171 IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy )172 164 ! 173 165 zmdi=1.e+20 ! missing data indicator for masking … … 1091 1083 IF( lrst_oce .AND.ln_bt_fw ) CALL ts_rst( kt, 'WRITE' ) 1092 1084 ! 1093 CALL wrk_dealloc( jpi,jpj, zsshp2_e, zhdiv )1094 CALL wrk_dealloc( jpi,jpj, zu_trd, zv_trd )1095 CALL wrk_dealloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc )1096 CALL wrk_dealloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e )1097 CALL wrk_dealloc( jpi,jpj, zsshu_a, zsshv_a )1098 CALL wrk_dealloc( jpi,jpj, zhf )1099 IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy )1100 1085 ! 1101 1086 IF ( ln_diatmb ) THEN … … 1248 1233 INTEGER :: ji ,jj ! dummy loop indices 1249 1234 REAL(wp) :: zxr2, zyr2, zcmax ! local scalar 1250 REAL(wp), POINTER, DIMENSION(:,:) :: zcu1235 REAL(wp), DIMENSION(jpi,jpj) :: zcu 1251 1236 !!---------------------------------------------------------------------- 1252 1237 ! 1253 1238 ! Max courant number for ext. grav. waves 1254 1239 ! 1255 CALL wrk_alloc( jpi,jpj, zcu )1256 1240 ! 1257 1241 DO jj = 1, jpj … … 1320 1304 ENDIF 1321 1305 ! 1322 CALL wrk_dealloc( jpi,jpj, zcu )1323 1306 ! 1324 1307 END SUBROUTINE dyn_spg_ts_init -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7753 r7910 40 40 USE in_out_manager ! I/O manager 41 41 USE lib_mpp ! MPP library 42 USE wrk_nemo ! Memory Allocation43 42 USE timing ! Timing 44 43 … … 98 97 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 98 ! 100 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv99 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 101 100 !!---------------------------------------------------------------------- 102 101 ! 103 102 IF( nn_timing == 1 ) CALL timing_start('dyn_vor') 104 103 ! 105 IF( l_trddyn ) CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )106 104 ! 107 105 SELECT CASE ( nvor_scheme ) !== vorticity trend added to the general trend ==! … … 190 188 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 191 189 ! 192 IF( l_trddyn ) CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )193 190 ! 194 191 IF( nn_timing == 1 ) CALL timing_stop('dyn_vor') … … 225 222 INTEGER :: ji, jj, jk ! dummy loop indices 226 223 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars 227 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz ! 2D workspace224 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz ! 2D workspace 228 225 !!---------------------------------------------------------------------- 229 226 ! 230 227 IF( nn_timing == 1 ) CALL timing_start('vor_ene') 231 228 ! 232 CALL wrk_alloc( jpi,jpj, zwx, zwy, zwz )233 229 ! 234 230 IF( kt == nit000 ) THEN … … 311 307 END DO ! End of slab 312 308 ! ! =============== 313 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )314 309 ! 315 310 IF( nn_timing == 1 ) CALL timing_stop('vor_ene') … … 346 341 INTEGER :: ji, jj, jk ! dummy loop indices 347 342 REAL(wp) :: zuav, zvau ! local scalars 348 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww ! 2D workspace343 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz, zww ! 2D workspace 349 344 !!---------------------------------------------------------------------- 350 345 ! 351 346 IF( nn_timing == 1 ) CALL timing_start('vor_ens') 352 347 ! 353 CALL wrk_alloc( jpi,jpj, zwx, zwy, zwz )354 348 ! 355 349 IF( kt == nit000 ) THEN … … 431 425 END DO ! End of slab 432 426 ! ! =============== 433 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )434 427 ! 435 428 IF( nn_timing == 1 ) CALL timing_stop('vor_ens') … … 466 459 REAL(wp) :: zmsk, ze3 ! local scalars 467 460 ! 468 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, z1_e3f469 REAL(wp), POINTER, DIMENSION(:,:) :: ztnw, ztne, ztsw, ztse461 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz, z1_e3f 462 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 470 463 !!---------------------------------------------------------------------- 471 464 ! 472 465 IF( nn_timing == 1 ) CALL timing_start('vor_een') 473 466 ! 474 CALL wrk_alloc( jpi,jpj, zwx , zwy , zwz , z1_e3f )475 CALL wrk_alloc( jpi,jpj, ztnw, ztne, ztsw, ztse )476 467 ! 477 468 IF( kt == nit000 ) THEN … … 599 590 ! ! =============== 600 591 ! 601 CALL wrk_dealloc( jpi,jpj, zwx , zwy , zwz , z1_e3f )602 CALL wrk_dealloc( jpi,jpj, ztnw, ztne, ztsw, ztse )603 592 ! 604 593 IF( nn_timing == 1 ) CALL timing_stop('vor_een') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r7753 r7910 22 22 USE lib_mpp ! MPP library 23 23 USE prtctl ! Print control 24 USE wrk_nemo ! Memory Allocation25 24 USE timing ! Timing 26 25 … … 60 59 INTEGER :: ji, jj, jk ! dummy loop indices 61 60 REAL(wp) :: zua, zva ! temporary scalars 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwuw , zwvw63 REAL(wp), POINTER, DIMENSION(:,:) :: zww64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwuw , zwvw 62 REAL(wp), DIMENSION(jpi,jpj) :: zww 63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 65 64 !!---------------------------------------------------------------------- 66 65 ! 67 66 IF( nn_timing == 1 ) CALL timing_start('dyn_zad') 68 67 ! 69 CALL wrk_alloc( jpi,jpj, zww )70 CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw )71 68 ! 72 69 IF( kt == nit000 ) THEN … … 76 73 77 74 IF( l_trddyn ) THEN ! Save ua and va trends 78 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )79 75 ztrdu(:,:,:) = ua(:,:,:) 80 76 ztrdv(:,:,:) = va(:,:,:) … … 133 129 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 134 130 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 135 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )136 131 ENDIF 137 132 ! ! Control print … … 139 134 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 140 135 ! 141 CALL wrk_dealloc( jpi,jpj, zww )142 CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw )143 136 ! 144 137 IF( nn_timing == 1 ) CALL timing_stop('dyn_zad') … … 175 168 REAL(wp) :: z2dtzts ! length of Euler forward sub-timestep for vertical advection 176 169 REAL(wp) :: zts ! length of sub-timestep for vertical advection 177 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwuw , zwvw, zww178 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv179 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zus , zvs170 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwuw , zwvw, zww 171 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 172 REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zus , zvs 180 173 !!---------------------------------------------------------------------- 181 174 ! 182 175 IF( nn_timing == 1 ) CALL timing_start('dyn_zad_zts') 183 176 ! 184 CALL wrk_alloc( jpi,jpj,jpk, zwuw, zwvw, zww )185 CALL wrk_alloc( jpi,jpj,jpk,3, zus , zvs )186 177 ! 187 178 IF( kt == nit000 ) THEN … … 191 182 192 183 IF( l_trddyn ) THEN ! Save ua and va trends 193 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )194 184 ztrdu(:,:,:) = ua(:,:,:) 195 185 ztrdv(:,:,:) = va(:,:,:) … … 277 267 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 278 268 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 279 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )280 269 ENDIF 281 270 ! ! Control print … … 283 272 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 284 273 ! 285 CALL wrk_dealloc( jpi,jpj,jpk, zwuw, zwvw, zww )286 CALL wrk_dealloc( jpi,jpj,jpk,3, zus , zvs )287 274 ! 288 275 IF( nn_timing == 1 ) CALL timing_stop('dyn_zad_zts') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r7753 r7910 24 24 USE lib_mpp ! MPP library 25 25 USE prtctl ! Print control 26 USE wrk_nemo ! Memory Allocation27 26 USE timing ! Timing 28 27 … … 54 53 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 54 ! 56 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv55 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv 57 56 !!--------------------------------------------------------------------- 58 57 ! … … 65 64 66 65 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 67 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )68 66 ztrdu(:,:,:) = ua(:,:,:) 69 67 ztrdv(:,:,:) = va(:,:,:) … … 81 79 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 82 80 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 83 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )84 81 ENDIF 85 82 ! ! print mean trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r6140 r7910 24 24 USE in_out_manager ! I/O manager 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! Memory Allocation27 26 USE timing ! Timing 28 27 … … 66 65 INTEGER :: ji, jj, jk, jl ! dummy loop indices 67 66 REAL(wp) :: zlavmr, zua, zva ! local scalars 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy, zwz, zww67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zwy, zwz, zww 69 68 !!---------------------------------------------------------------------- 70 69 ! 71 70 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf_exp') 72 71 ! 73 CALL wrk_alloc( jpi,jpj,jpk, zwx, zwy, zwz, zww )74 72 ! 75 73 IF( kt == nit000 .AND. lwp ) THEN … … 140 138 ENDIF 141 139 ! 142 CALL wrk_dealloc( jpi,jpj,jpk, zwx, zwy, zwz, zww )143 140 ! 144 141 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_exp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r7753 r7910 26 26 USE in_out_manager ! I/O manager 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! Memory Allocation29 28 USE timing ! Timing 30 29 … … 72 71 REAL(wp) :: zzwi, ze3ua ! local scalars 73 72 REAL(wp) :: zzws, ze3va ! - - 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwd, zws73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwd, zws 75 74 !!---------------------------------------------------------------------- 76 75 ! 77 76 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf_imp') 78 77 ! 79 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws )80 78 ! 81 79 IF( kt == nit000 ) THEN … … 342 340 ENDIF 343 341 ! 344 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws)345 342 ! 346 343 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_imp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r7753 r7910 36 36 USE lbclnk ! ocean lateral boundary condition (or mpp link) 37 37 USE lib_mpp ! MPP library 38 USE wrk_nemo ! Memory Allocation39 38 USE timing ! Timing 40 39 USE wet_dry ! Wetting/Drying flux limting … … 74 73 INTEGER :: jk ! dummy loop indice 75 74 REAL(wp) :: z2dt, zcoef ! local scalars 76 REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv ! 2D workspace75 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv ! 2D workspace 77 76 !!---------------------------------------------------------------------- 78 77 ! 79 78 IF( nn_timing == 1 ) CALL timing_start('ssh_nxt') 80 79 ! 81 CALL wrk_alloc( jpi,jpj, zhdiv )82 80 ! 83 81 IF( kt == nit000 ) THEN … … 134 132 IF(ln_ctl) CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha - : ', mask1=tmask, ovlap=1 ) 135 133 ! 136 CALL wrk_dealloc( jpi, jpj, zhdiv )137 134 ! 138 135 IF( nn_timing == 1 ) CALL timing_stop('ssh_nxt') … … 161 158 REAL(wp) :: z1_2dt ! local scalars 162 159 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 163 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, zhdiv160 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d, zhdiv 164 161 !!---------------------------------------------------------------------- 165 162 ! … … 180 177 ! 181 178 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 182 CALL wrk_alloc( jpi, jpj, jpk, zhdiv )183 179 ! 184 180 DO jk = 1, jpkm1 … … 200 196 END DO 201 197 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 202 CALL wrk_dealloc( jpi, jpj, jpk, zhdiv )203 198 ELSE ! z_star and linear free surface cases 204 199 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
r7646 r7910 21 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! Memory Allocation24 23 USE timing ! Timing 25 24 … … 113 112 REAL(wp) :: zdepwd ! local scalar, always wet cell depth 114 113 REAL(wp) :: ztmp ! local scalars 115 REAL(wp), POINTER, DIMENSION(:,:) :: zwdlmtu, zwdlmtv !: W/D flux limiters116 REAL(wp), POINTER, DIMENSION(:,:) :: zflxp, zflxn ! local 2D workspace117 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu, zflxv ! local 2D workspace118 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! local 2D workspace114 REAL(wp), DIMENSION(jpi,jpj) :: zwdlmtu, zwdlmtv !: W/D flux limiters 115 REAL(wp), DIMENSION(jpi,jpj) :: zflxp, zflxn ! local 2D workspace 116 REAL(wp), DIMENSION(jpi,jpj) :: zflxu, zflxv ! local 2D workspace 117 REAL(wp), DIMENSION(jpi,jpj) :: zflxu1, zflxv1 ! local 2D workspace 119 118 !!---------------------------------------------------------------------- 120 119 ! … … 124 123 IF(ln_wd) THEN 125 124 126 CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )127 CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)128 125 ! 129 126 … … 254 251 ! 255 252 ! 256 CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )257 CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)258 253 ! 259 254 ENDIF … … 284 279 REAL(wp) :: zdepwd ! local scalar, always wet cell depth 285 280 REAL(wp) :: ztmp ! local scalars 286 REAL(wp), POINTER, DIMENSION(:,:) :: zwdlmtu, zwdlmtv !: W/D flux limiters287 REAL(wp), POINTER, DIMENSION(:,:) :: zflxp, zflxn ! local 2D workspace288 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! local 2D workspace281 REAL(wp), DIMENSION(jpi,jpj) :: zwdlmtu, zwdlmtv !: W/D flux limiters 282 REAL(wp), DIMENSION(jpi,jpj) :: zflxp, zflxn ! local 2D workspace 283 REAL(wp), DIMENSION(jpi,jpj) :: zflxu1, zflxv1 ! local 2D workspace 289 284 !!---------------------------------------------------------------------- 290 285 ! … … 293 288 IF(ln_wd) THEN 294 289 295 CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )296 CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)297 290 ! 298 291 … … 401 394 ! 402 395 ! 403 CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )404 CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)405 396 ! 406 397 END IF -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r6140 r7910 15 15 USE dom_oce ! ocean space and time domain 16 16 USE in_out_manager ! I/O manager 17 USE wrk_nemo ! working array18 17 19 18 IMPLICIT NONE … … 53 52 INTEGER :: ierror ! error value 54 53 55 REAL(wp), POINTER, DIMENSION(:) :: zgifl , zgjfl , zgkfl ! index RK positions56 REAL(wp), POINTER, DIMENSION(:) :: zufl , zvfl , zwfl ! interpolated velocity at the float position57 REAL(wp), POINTER, DIMENSION(:,:) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients54 REAL(wp), DIMENSION(jpnfl) :: zgifl , zgjfl , zgkfl ! index RK positions 55 REAL(wp), DIMENSION(jpnfl) :: zufl , zvfl , zwfl ! interpolated velocity at the float position 56 REAL(wp), DIMENSION(jpnfl,4) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients 58 57 !!--------------------------------------------------------------------- 59 CALL wrk_alloc( jpnfl, zgifl , zgjfl , zgkfl , zufl, zvfl, zwfl)60 CALL wrk_alloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl )61 58 ! 62 59 IF( ierror /= 0 ) THEN … … 154 151 END DO 155 152 ! 156 CALL wrk_dealloc( jpnfl, zgifl , zgjfl , zgkfl , zufl, zvfl, zwfl)157 CALL wrk_dealloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl )158 153 ! 159 154 END SUBROUTINE flo_4rk … … 178 173 INTEGER :: jfl, jind1, jind2, jind3 ! dummy loop indices 179 174 REAL(wp) :: zsumu, zsumv, zsumw ! local scalar 180 INTEGER , POINTER, DIMENSION(:) :: iilu, ijlu, iklu ! nearest neighbour INDEX-u181 INTEGER , POINTER, DIMENSION(:) :: iilv, ijlv, iklv ! nearest neighbour INDEX-v182 INTEGER , POINTER, DIMENSION(:) :: iilw, ijlw, iklw ! nearest neighbour INDEX-w183 INTEGER , POINTER, DIMENSION(:,:) :: iidu, ijdu, ikdu ! 64 nearest neighbour INDEX-u184 INTEGER , POINTER, DIMENSION(:,:) :: iidv, ijdv, ikdv ! 64 nearest neighbour INDEX-v185 INTEGER , POINTER, DIMENSION(:,:) :: iidw, ijdw, ikdw ! 64 nearest neighbour INDEX-w186 REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxu, zlagyu, zlagzu ! Lagrange coefficients187 REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxv, zlagyv, zlagzv ! - -188 REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxw, zlagyw, zlagzw ! - -189 REAL(wp) , POINTER, DIMENSION(:,:,:,:) :: ztufl , ztvfl , ztwfl ! velocity at choosen time step175 INTEGER , DIMENSION(jpnfl) :: iilu, ijlu, iklu ! nearest neighbour INDEX-u 176 INTEGER , DIMENSION(jpnfl) :: iilv, ijlv, iklv ! nearest neighbour INDEX-v 177 INTEGER , DIMENSION(jpnfl) :: iilw, ijlw, iklw ! nearest neighbour INDEX-w 178 INTEGER , DIMENSION(jpnfl,4) :: iidu, ijdu, ikdu ! 64 nearest neighbour INDEX-u 179 INTEGER , DIMENSION(jpnfl,4) :: iidv, ijdv, ikdv ! 64 nearest neighbour INDEX-v 180 INTEGER , DIMENSION(jpnfl,4) :: iidw, ijdw, ikdw ! 64 nearest neighbour INDEX-w 181 REAL(wp) , DIMENSION(jpnfl,4) :: zlagxu, zlagyu, zlagzu ! Lagrange coefficients 182 REAL(wp) , DIMENSION(jpnfl,4) :: zlagxv, zlagyv, zlagzv ! - - 183 REAL(wp) , DIMENSION(jpnfl,4) :: zlagxw, zlagyw, zlagzw ! - - 184 REAL(wp) , DIMENSION(jpnfl,4,4,4) :: ztufl , ztvfl , ztwfl ! velocity at choosen time step 190 185 !!--------------------------------------------------------------------- 191 CALL wrk_alloc( jpnfl, iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw )192 CALL wrk_alloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw )193 CALL wrk_alloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw )194 CALL wrk_alloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl )195 186 196 187 ! Interpolation of U velocity … … 451 442 END DO 452 443 ! 453 CALL wrk_dealloc( jpnfl, iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw )454 CALL wrk_dealloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw )455 CALL wrk_dealloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw )456 CALL wrk_dealloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl )457 444 ! 458 445 END SUBROUTINE flo_interp -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r7646 r7910 16 16 USE in_out_manager ! I/O manager 17 17 USE lib_mpp ! distribued memory computing library 18 USE wrk_nemo ! working array19 18 20 19 IMPLICIT NONE … … 54 53 REAL(wp), DIMENSION ( 2 ) :: zsurfx, zsurfy ! surface of the face of the mesh 55 54 56 INTEGER , POINTER, DIMENSION ( :) :: iil, ijl, ikl ! index of nearest mesh57 INTEGER , POINTER, DIMENSION ( :) :: iiloc , ijloc58 INTEGER , POINTER, DIMENSION ( :) :: iiinfl, ijinfl, ikinfl ! index of input mesh of the float.59 INTEGER , POINTER, DIMENSION ( :) :: iioutfl, ijoutfl, ikoutfl ! index of output mesh of the float.60 REAL(wp) , POINTER, DIMENSION ( :) :: zgifl, zgjfl, zgkfl ! position of floats, index on55 INTEGER , DIMENSION (jpnfl) :: iil, ijl, ikl ! index of nearest mesh 56 INTEGER , DIMENSION (jpnfl) :: iiloc , ijloc 57 INTEGER , DIMENSION (jpnfl) :: iiinfl, ijinfl, ikinfl ! index of input mesh of the float. 58 INTEGER , DIMENSION (jpnfl) :: iioutfl, ijoutfl, ikoutfl ! index of output mesh of the float. 59 REAL(wp) , DIMENSION (jpnfl) :: zgifl, zgjfl, zgkfl ! position of floats, index on 61 60 ! ! velocity mesh. 62 REAL(wp) , POINTER, DIMENSION ( :) :: ztxfl, ztyfl, ztzfl ! time for a float to quit the mesh61 REAL(wp) , DIMENSION (jpnfl) :: ztxfl, ztyfl, ztzfl ! time for a float to quit the mesh 63 62 ! ! across one of the face x,y and z 64 REAL(wp) , POINTER, DIMENSION ( :) :: zttfl ! time for a float to quit the mesh65 REAL(wp) , POINTER, DIMENSION ( :) :: zagefl ! time during which, trajectorie of63 REAL(wp) , DIMENSION (jpnfl) :: zttfl ! time for a float to quit the mesh 64 REAL(wp) , DIMENSION (jpnfl) :: zagefl ! time during which, trajectorie of 66 65 ! ! the float has been computed 67 REAL(wp) , POINTER, DIMENSION ( :) :: zagenewfl ! new age of float after calculation66 REAL(wp) , DIMENSION (jpnfl) :: zagenewfl ! new age of float after calculation 68 67 ! ! of new position 69 REAL(wp) , POINTER, DIMENSION ( :) :: zufl, zvfl, zwfl ! interpolated vel. at float position70 REAL(wp) , POINTER, DIMENSION ( :) :: zudfl, zvdfl, zwdfl ! velocity diff input/output of mesh71 REAL(wp) , POINTER, DIMENSION ( :) :: zgidfl, zgjdfl, zgkdfl ! direction index of float68 REAL(wp) , DIMENSION (jpnfl) :: zufl, zvfl, zwfl ! interpolated vel. at float position 69 REAL(wp) , DIMENSION (jpnfl) :: zudfl, zvdfl, zwdfl ! velocity diff input/output of mesh 70 REAL(wp) , DIMENSION (jpnfl) :: zgidfl, zgjdfl, zgkdfl ! direction index of float 72 71 !!--------------------------------------------------------------------- 73 CALL wrk_alloc( jpnfl , iil , ijl , ikl , iiloc , ijloc )74 CALL wrk_alloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl )75 CALL wrk_alloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl , ztyfl , ztzfl , zttfl , zagefl, zagenewfl)76 CALL wrk_alloc( jpnfl , zufl , zvfl , zwfl , zudfl , zvdfl , zwdfl , zgidfl, zgjdfl, zgkdfl )77 72 78 73 IF( kt == nit000 ) THEN … … 371 366 ENDIF 372 367 ! 373 CALL wrk_dealloc( jpnfl , iil , ijl , ikl , iiloc , ijloc )374 CALL wrk_dealloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl )375 CALL wrk_dealloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl , ztyfl , ztzfl , zttfl , zagefl, zagenewfl)376 CALL wrk_dealloc( jpnfl , zufl , zvfl , zwfl , zudfl , zvdfl , zwdfl , zgidfl, zgjdfl, zgkdfl )377 368 ! 378 369 END SUBROUTINE flo_blk -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r5025 r7910 13 13 USE in_out_manager ! I/O manager 14 14 USE lib_mpp ! distributed memory computing 15 USE wrk_nemo ! work arrays16 15 17 16 IMPLICIT NONE … … 94 93 INTEGER :: overlap, jn, sind, eind, kdir,j_id 95 94 REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 96 REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d_1, ztab2d_2 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask1, zmask2, ztab3d_1, ztab3d_2 98 !!---------------------------------------------------------------------- 99 100 CALL wrk_alloc( jpi,jpj, ztab2d_1, ztab2d_2 ) 101 CALL wrk_alloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 ) 95 REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2 96 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 97 !!---------------------------------------------------------------------- 98 102 99 103 100 ! Arrays, scalars initialization … … 208 205 ENDDO 209 206 210 CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 )211 CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 )212 207 ! 213 208 END SUBROUTINE prt_ctl … … 425 420 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 426 421 427 INTEGER, POINTER, DIMENSION(:,:) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace422 INTEGER, DIMENSION(isplt,jsplt) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace 428 423 REAL(wp) :: zidom, zjdom ! temporary scalars 429 424 !!---------------------------------------------------------------------- 430 425 431 426 ! 432 CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )433 427 ! 434 428 ! 1. Dimension arrays for subdomains … … 578 572 ! 579 573 ! 580 CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )581 574 ! 582 575 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7753 r7910 63 63 USE lbcnfd ! north fold treatment 64 64 USE in_out_manager ! I/O manager 65 USE wrk_nemo ! work arrays66 65 67 66 IMPLICIT NONE … … 2069 2068 !! 2070 2069 INTEGER :: ierror, localcomm 2071 REAL(wp) , POINTER , DIMENSION(:) :: zwork 2072 !!---------------------------------------------------------------------- 2073 ! 2074 CALL wrk_alloc(NUM , zwork) 2070 REAL(wp) , DIMENSION(NUM) :: zwork 2071 !!---------------------------------------------------------------------- 2072 ! 2075 2073 localcomm = mpi_comm_opa 2076 2074 IF( PRESENT(kcom) ) localcomm = kcom … … 2078 2076 CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror ) 2079 2077 ptab = zwork 2080 CALL wrk_dealloc(NUM , zwork)2081 2078 ! 2082 2079 END SUBROUTINE mppmax_real_multiple … … 2466 2463 ! 2467 2464 ! Since this is just an init routine and these arrays are of length jpnij 2468 ! then don't use wrk_nemo module - just allocate and deallocate.2469 2465 ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr ) 2470 2466 IF( ierr /= 0 ) THEN -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r7753 r7910 32 32 USE lib_mpp ! distribued memory computing library 33 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 34 USE wrk_nemo ! work arrays35 34 USE timing ! Timing 36 35 … … 118 117 REAL(wp) :: zck, zfk, zbw ! - - 119 118 REAL(wp) :: zdepu, zdepv ! - - 120 REAL(wp), POINTER, DIMENSION(:,:) :: zslpml_hmlpu, zslpml_hmlpv121 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww122 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr123 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgru, zgrv119 REAL(wp), DIMENSION(jpi,jpj) :: zslpml_hmlpu, zslpml_hmlpv 120 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz, zww 121 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdzr 122 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgru, zgrv 124 123 !!---------------------------------------------------------------------- 125 124 ! 126 125 IF( nn_timing == 1 ) CALL timing_start('ldf_slp') 127 126 ! 128 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )129 CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv )130 127 131 128 zeps = 1.e-20_wp !== Local constant initialization ==! … … 375 372 ENDIF 376 373 ! 377 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )378 CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv )379 374 ! 380 375 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') … … 409 404 REAL(wp) :: zdzrho_raw 410 405 REAL(wp) :: zbeta0, ze3_e1, ze3_e2 411 REAL(wp), POINTER, DIMENSION(:,:) :: z1_mlbw412 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbet413 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients414 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zti_mlb, ztj_mlb ! for Griffies operator only406 REAL(wp), DIMENSION(jpi,jpj) :: z1_mlbw 407 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalbet 408 REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 409 REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) :: zti_mlb, ztj_mlb ! for Griffies operator only 415 410 !!---------------------------------------------------------------------- 416 411 ! 417 412 IF( nn_timing == 1 ) CALL timing_start('ldf_slp_triad') 418 413 ! 419 CALL wrk_alloc( jpi,jpj, z1_mlbw )420 CALL wrk_alloc( jpi,jpj,jpk, zalbet )421 CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 )422 CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 )423 414 ! 424 415 !--------------------------------! … … 624 615 CALL lbc_lnk( wslp2, 'W', 1. ) ! lateral boundary confition on wslp2 only ==>>> gm : necessary ? to be checked 625 616 ! 626 CALL wrk_dealloc( jpi,jpj, z1_mlbw )627 CALL wrk_dealloc( jpi,jpj,jpk, zalbet )628 CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 )629 CALL wrk_dealloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 )630 617 ! 631 618 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp_triad') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r7753 r7910 30 30 USE lib_mpp ! distribued memory computing library 31 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! work arrays33 32 USE timing ! timing 34 33 … … 491 490 INTEGER :: ji, jj, jk ! dummy loop indices 492 491 REAL(wp) :: zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei ! local scalars 493 REAL(wp), DIMENSION( :,:), POINTER:: zn, zah, zhw, zross, zaeiw ! 2D workspace492 REAL(wp), DIMENSION(jpi,jpj) :: zn, zah, zhw, zross, zaeiw ! 2D workspace 494 493 !!---------------------------------------------------------------------- 495 494 ! 496 495 IF( nn_timing == 1 ) CALL timing_start('ldf_eiv') 497 496 ! 498 CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw )499 497 ! 500 498 zn (:,:) = 0._wp ! Local initialization … … 575 573 END DO 576 574 ! 577 CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross, zaeiw )578 575 ! 579 576 IF( nn_timing == 1 ) CALL timing_stop('ldf_eiv') … … 610 607 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 611 608 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 612 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw609 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 613 610 !!---------------------------------------------------------------------- 614 611 ! 615 612 IF( nn_timing == 1 ) CALL timing_start( 'ldf_eiv_trp') 616 613 ! 617 CALL wrk_alloc( jpi,jpj,jpk, zpsi_uw, zpsi_vw )618 614 619 615 IF( kt == kit000 ) THEN … … 658 654 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 659 655 ! 660 CALL wrk_dealloc( jpi,jpj,jpk, zpsi_uw, zpsi_vw )661 656 ! 662 657 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_trp') … … 679 674 INTEGER :: ji, jj, jk ! dummy loop indices 680 675 REAL(wp) :: zztmp ! local scalar 681 REAL(wp), DIMENSION( :,:) , POINTER:: zw2d ! 2D workspace682 REAL(wp), DIMENSION( :,:,:), POINTER:: zw3d ! 3D workspace676 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 677 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 683 678 !!---------------------------------------------------------------------- 684 679 ! … … 693 688 ! 694 689 ! !== eiv velocities: calculate and output ==! 695 CALL wrk_alloc( jpi,jpj,jpk, zw3d )696 690 ! 697 691 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 … … 720 714 ! 721 715 ! 722 CALL wrk_alloc( jpi,jpj, zw2d )723 716 ! 724 717 zztmp = 0.5_wp * rau0 * rcp … … 792 785 IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 793 786 ! 794 CALL wrk_dealloc( jpi,jpj, zw2d )795 CALL wrk_dealloc( jpi,jpj,jpk, zw3d )796 787 ! 797 788 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_dia') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r6140 r7910 15 15 !!---------------------------------------------------------------------- 16 16 !! * Modules used 17 USE wrk_nemo ! Memory Allocation18 17 USE par_kind ! Precision variables 19 18 USE in_out_manager ! I/O manager … … 144 143 REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS 145 144 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 146 REAL(wp), POINTER, DIMENSION(:,:) :: & 147 & zglam1, & ! Model longitudes for profile variable 1 148 & zglam2 ! Model longitudes for profile variable 2 149 REAL(wp), POINTER, DIMENSION(:,:) :: & 150 & zgphi1, & ! Model latitudes for profile variable 1 151 & zgphi2 ! Model latitudes for profile variable 2 152 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 153 & zmask1, & ! Model land/sea mask associated with variable 1 154 & zmask2 ! Model land/sea mask associated with variable 2 145 REAL(wp), DIMENSION(jpi,jpj) :: zglam1 ! Model longitudes for profile variable 1 146 REAL(wp), DIMENSION(jpi,jpj) :: zglam2 ! Model longitudes for profile variable 2 147 REAL(wp), DIMENSION(jpi,jpj) :: zgphi1 ! Model latitudes for profile variable 1 148 REAL(wp), DIMENSION(jpi,jpj) :: zgphi2 ! Model latitudes for profile variable 2 149 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1 ! Model land/sea mask associated with variable 1 150 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask2 ! Model land/sea mask associated with variable 2 155 151 156 152 NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla, & … … 168 164 169 165 INTEGER :: jnumsstbias 170 CALL wrk_alloc( jpi, jpj, zglam1 )171 CALL wrk_alloc( jpi, jpj, zglam2 )172 CALL wrk_alloc( jpi, jpj, zgphi1 )173 CALL wrk_alloc( jpi, jpj, zgphi2 )174 CALL wrk_alloc( jpi, jpj, jpk, zmask1 )175 CALL wrk_alloc( jpi, jpj, jpk, zmask2 )176 166 177 167 !----------------------------------------------------------------------- … … 492 482 ENDIF 493 483 494 CALL wrk_dealloc( jpi, jpj, zglam1 )495 CALL wrk_dealloc( jpi, jpj, zglam2 )496 CALL wrk_dealloc( jpi, jpj, zgphi1 )497 CALL wrk_dealloc( jpi, jpj, zgphi2 )498 CALL wrk_dealloc( jpi, jpj, jpk, zmask1 )499 CALL wrk_dealloc( jpi, jpj, jpk, zmask2 )500 484 501 485 END SUBROUTINE dia_obs_init … … 554 538 INTEGER :: jvar ! Variable number 555 539 INTEGER :: ji, jj ! Loop counters 556 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 557 & zprofvar1, & ! Model values for 1st variable in a prof ob 558 & zprofvar2 ! Model values for 2nd variable in a prof ob 559 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 560 & zprofmask1, & ! Mask associated with zprofvar1 561 & zprofmask2 ! Mask associated with zprofvar2 562 REAL(wp), POINTER, DIMENSION(:,:) :: & 563 & zsurfvar ! Model values equivalent to surface ob. 564 REAL(wp), POINTER, DIMENSION(:,:) :: & 565 & zglam1, & ! Model longitudes for prof variable 1 566 & zglam2, & ! Model longitudes for prof variable 2 567 & zgphi1, & ! Model latitudes for prof variable 1 568 & zgphi2 ! Model latitudes for prof variable 2 569 #if ! defined key_lim2 && ! defined key_lim3 570 REAL(wp), POINTER, DIMENSION(:,:) :: frld 540 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofvar1 ! Model values for 1st variable in a prof ob 541 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofvar2 ! Model values for 2nd variable in a prof ob 542 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofmask1 ! Mask associated with zprofvar1 543 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofmask2 ! Mask associated with zprofvar2 544 REAL(wp), DIMENSION(jpi,jpj) :: zsurfvar ! Model values equivalent to surface ob. 545 REAL(wp), DIMENSION(jpi,jpj) :: zglam1 ! Model longitudes for prof variable 1 546 REAL(wp), DIMENSION(jpi,jpj) :: zglam2 ! Model longitudes for prof variable 2 547 REAL(wp), DIMENSION(jpi,jpj) :: zgphi1 ! Model latitudes for prof variable 1 548 REAL(wp), DIMENSION(jpi,jpj) :: zgphi2 ! Model latitudes for prof variable 2 549 #if ! defined key_lim2 ! defined key_lim3 550 REAL(wp), DIMENSION(jpi,jpj) :: frld 571 551 #endif 572 552 LOGICAL :: llnightav ! Logical for calculating night-time average 573 553 574 554 !Allocate local work arrays 575 CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 )576 CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 )577 CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 )578 CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 )579 CALL wrk_alloc( jpi, jpj, zsurfvar )580 CALL wrk_alloc( jpi, jpj, zglam1 )581 CALL wrk_alloc( jpi, jpj, zglam2 )582 CALL wrk_alloc( jpi, jpj, zgphi1 )583 CALL wrk_alloc( jpi, jpj, zgphi2 )584 555 #if ! defined key_lim2 && ! defined key_lim3 585 CALL wrk_alloc(jpi,jpj,frld)586 556 #endif 587 557 … … 693 663 ENDIF 694 664 695 CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 )696 CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 )697 CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 )698 CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 )699 CALL wrk_dealloc( jpi, jpj, zsurfvar )700 CALL wrk_dealloc( jpi, jpj, zglam1 )701 CALL wrk_dealloc( jpi, jpj, zglam2 )702 CALL wrk_dealloc( jpi, jpj, zgphi1 )703 CALL wrk_dealloc( jpi, jpj, zgphi2 )704 665 #if ! defined key_lim2 && ! defined key_lim3 705 CALL wrk_dealloc(jpi,jpj,frld)706 666 #endif 707 667 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
r6140 r7910 10 10 !!--------------------------------------------------------------------- 11 11 !! * Modules used 12 USE wrk_nemo ! Memory Allocation13 12 USE par_kind ! Precision variables 14 13 USE dom_oce ! Domain variables … … 125 124 & pgval ! Stencil at each point 126 125 !! * Local declarations 127 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: zval126 REAL(KIND=wp), DIMENSION(jpi,jpj,1) :: zval 128 127 REAL(KIND=wp), DIMENSION(kptsi,kptsj,1,kobs) ::& 129 128 & zgval 130 129 131 130 ! Check workspace array and set-up pointer 132 CALL wrk_alloc(jpi,jpj,1,zval)133 131 134 132 ! Set up local "3D" buffer … … 154 152 155 153 ! 'Release' workspace array back to pool 156 CALL wrk_dealloc(jpi,jpj,1,zval)157 154 158 155 END SUBROUTINE obs_int_comm_2d -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r6140 r7910 33 33 USE obs_utils ! Various observation tools 34 34 USE obs_inter_sup 35 USE wrk_nemo ! Memory Allocation36 35 37 36 IMPLICIT NONE … … 99 98 & zglam, & 100 99 & zgphi 101 REAL(wp), POINTER, DIMENSION(:,:) :: z_altbias100 REAL(wp), DIMENSION(jpi,jpj) :: z_altbias 102 101 REAL(wp) :: zlam 103 102 REAL(wp) :: zphi … … 107 106 INTEGER :: numaltbias 108 107 109 CALL wrk_alloc(jpi,jpj,z_altbias)110 108 111 109 IF(lwp)WRITE(numout,*) … … 201 199 & ) 202 200 203 CALL wrk_dealloc(jpi,jpj,z_altbias)204 201 205 202 END SUBROUTINE obs_rea_altbias -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r6140 r7910 12 12 !! obs_offset_mdt : Remove the offset between the model MDT and the used one 13 13 !!---------------------------------------------------------------------- 14 USE wrk_nemo ! Memory Allocation15 14 USE par_kind ! Precision variables 16 15 USE par_oce ! Domain parameters … … 76 75 INTEGER , DIMENSION(:,:,:), ALLOCATABLE :: igrdi, igrdj 77 76 ! 78 REAL(wp), POINTER, DIMENSION(:,:) :: z_mdt, mdtmask77 REAL(wp), DIMENSION(jpi,jpj) :: z_mdt, mdtmask 79 78 80 79 REAL(wp) :: zlam, zphi, zfill, zinfill ! local scalar 81 80 !!---------------------------------------------------------------------- 82 81 83 CALL wrk_alloc(jpi,jpj,z_mdt,mdtmask)84 82 85 83 IF(lwp)WRITE(numout,*) … … 167 165 & ) 168 166 169 CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask)170 167 IF(lwp)WRITE(numout,*) ' ------------- ' 171 168 ! … … 192 189 INTEGER :: ji, jj 193 190 REAL(wp) :: zdxdy, zarea, zeta1, zeta2, zcorr_mdt, zcorr_bcketa, zcorr ! local scalar 194 REAL(wp), POINTER, DIMENSION(:,:) :: zpromsk191 REAL(wp), DIMENSION(jpi,jpj) :: zpromsk 195 192 CHARACTER(LEN=14), PARAMETER :: cpname = 'obs_offset_mdt' 196 193 !!---------------------------------------------------------------------- 197 194 198 CALL wrk_alloc( jpi,jpj, zpromsk )199 195 200 196 ! Initialize the local mask, for domain projection … … 258 254 IF ( nn_msshc == 2 ) WRITE(numout,*) ' User defined MSSH correction' 259 255 260 CALL wrk_dealloc( jpi,jpj, zpromsk )261 256 ! 262 257 END SUBROUTINE obs_offset_mdt -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r6140 r7910 9 9 !!---------------------------------------------------------------------- 10 10 !! * Modules used 11 USE wrk_nemo ! Memory Allocation12 11 USE par_kind ! Precision variables 13 12 USE par_oce ! Ocean parameters … … 83 82 REAL(wp) :: zcos 84 83 REAL(wp), DIMENSION(1) :: zobsmask 85 REAL(wp), POINTER, DIMENSION(:,:) :: zsingu,zcosgu,zsingv,zcosgv84 REAL(wp), DIMENSION(jpi,jpj) :: zsingu,zcosgu,zsingv,zcosgv 86 85 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 87 86 & igrdiu, & … … 92 91 INTEGER :: jk 93 92 94 CALL wrk_alloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv)95 93 96 94 !----------------------------------------------------------------------- … … 226 224 & ) 227 225 228 CALL wrk_dealloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv)229 226 230 227 END SUBROUTINE obs_rotvel -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r7813 r7910 20 20 USE in_out_manager ! I/O manager 21 21 USE lib_mpp ! MPP library 22 USE wrk_nemo ! work arrays23 22 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 24 23 … … 91 90 REAL(wp) :: zswitch, z1_c1, z1_c2 92 91 REAL(wp) :: zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total 93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalb_it ! intermediate variable & albedo of ice (snow free)92 REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) :: zalb, zalb_it ! intermediate variable & albedo of ice (snow free) 94 93 !!--------------------------------------------------------------------- 95 94 96 95 ijpl = SIZE( pt_ice, 3 ) ! number of ice categories 97 96 98 CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it )99 97 100 98 IF( albd_init == 0 ) CALL albedo_init ! initialization … … 206 204 END SELECT 207 205 208 CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it )209 206 ! 210 207 END SUBROUTINE albedo_ice -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
r7646 r7910 21 21 USE in_out_manager ! I/O manager 22 22 USE geo2ocean ! tools for projection on ORCA grid 23 USE wrk_nemo ! work arrays24 23 USE lib_mpp 25 24 … … 81 80 REAL(wp) :: zvmax ! timestep interpolated vmax 82 81 REAL(wp) :: zrlon, zrlat ! temporary 83 REAL(wp), DIMENSION( :,:), POINTER:: zwnd_x, zwnd_y ! zonal and meridional components of the wind82 REAL(wp), DIMENSION(jpi,jpj) :: zwnd_x, zwnd_y ! zonal and meridional components of the wind 84 83 REAL(wp), DIMENSION(14,5) :: ztct ! tropical cyclone track data at kt 85 84 ! … … 89 88 !!-------------------------------------------------------------------- 90 89 91 CALL wrk_alloc( jpi,jpj, zwnd_x, zwnd_y )92 90 93 91 ! ! ====================== ! … … 271 269 CALL rot_rep ( zwnd_x, zwnd_y, 'T', 'en->j', pwnd_j ) !rotation of components on ORCA grid 272 270 273 CALL wrk_dealloc( jpi,jpj, zwnd_x, zwnd_y )274 271 275 272 END SUBROUTINE wnd_cyc -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r7646 r7910 37 37 USE ioipsl , ONLY : ymds2ju, ju2ymds ! for calendar 38 38 USE lib_mpp ! MPP library 39 USE wrk_nemo ! work arrays40 39 USE lbclnk ! ocean lateral boundary conditions (C1D case) 41 40 … … 1145 1144 INTEGER :: iv ! indice of V component 1146 1145 CHARACTER (LEN=100) :: clcomp ! dummy weight name 1147 REAL(wp), POINTER, DIMENSION(:,:) :: utmp, vtmp ! temporary arrays for vector rotation 1148 !!--------------------------------------------------------------------- 1149 ! 1150 CALL wrk_alloc( jpi,jpj, utmp, vtmp ) 1146 REAL(wp), DIMENSION(jpi,jpj) :: utmp, vtmp ! temporary arrays for vector rotation 1147 !!--------------------------------------------------------------------- 1148 ! 1151 1149 ! 1152 1150 !! (sga: following code should be modified so that pairs arent searched for each time … … 1185 1183 END DO 1186 1184 ! 1187 CALL wrk_dealloc( jpi,jpj, utmp, vtmp )1188 1185 ! 1189 1186 END SUBROUTINE fld_rot … … 1438 1435 CHARACTER (len=5) :: aname ! 1439 1436 INTEGER , DIMENSION(:), ALLOCATABLE :: ddims 1440 INTEGER , POINTER, DIMENSION(:,:) :: data_src1441 REAL(wp), POINTER, DIMENSION(:,:) :: data_tmp1437 INTEGER , DIMENSION(jpi,jpj) :: data_src 1438 REAL(wp), DIMENSION(jpi,jpj) :: data_tmp 1442 1439 !!---------------------------------------------------------------------- 1443 1440 ! 1444 CALL wrk_alloc( jpi,jpj, data_src ) ! integer1445 CALL wrk_alloc( jpi,jpj, data_tmp )1446 1441 ! 1447 1442 IF( nxt_wgt > tot_wgts ) THEN … … 1562 1557 DEALLOCATE (ddims ) 1563 1558 1564 CALL wrk_dealloc( jpi,jpj, data_src ) ! integer1565 CALL wrk_dealloc( jpi,jpj, data_tmp )1566 1559 ! 1567 1560 END SUBROUTINE fld_weight -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
r7753 r7910 54 54 USE in_out_manager ! I/O manager 55 55 USE lib_mpp ! distribued memory computing library 56 USE wrk_nemo ! work arrays57 56 USE timing ! Timing 58 57 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 360 359 INTEGER :: ji, jj ! dummy loop indices 361 360 REAL(wp) :: zztmp ! local variable 362 REAL(wp), DIMENSION( :,:), POINTER:: zwnd_i, zwnd_j ! wind speed components at T-point363 REAL(wp), DIMENSION( :,:), POINTER:: zsq ! specific humidity at pst364 REAL(wp), DIMENSION( :,:), POINTER:: zqlw, zqsb ! long wave and sensible heat fluxes365 REAL(wp), DIMENSION( :,:), POINTER:: zqla, zevap ! latent heat fluxes and evaporation366 REAL(wp), DIMENSION( :,:), POINTER:: Cd ! transfer coefficient for momentum (tau)367 REAL(wp), DIMENSION( :,:), POINTER:: Ch ! transfer coefficient for sensible heat (Q_sens)368 REAL(wp), DIMENSION( :,:), POINTER:: Ce ! tansfert coefficient for evaporation (Q_lat)369 REAL(wp), DIMENSION( :,:), POINTER:: zst ! surface temperature in Kelvin370 REAL(wp), DIMENSION( :,:), POINTER:: zt_zu ! air temperature at wind speed height371 REAL(wp), DIMENSION( :,:), POINTER:: zq_zu ! air spec. hum. at wind speed height372 REAL(wp), DIMENSION( :,:), POINTER:: zU_zu ! bulk wind speed at height zu [m/s]373 REAL(wp), DIMENSION( :,:), POINTER:: ztpot ! potential temperature of air at z=rn_zqt [K]374 REAL(wp), DIMENSION( :,:), POINTER:: zrhoa ! density of air [kg/m^3]361 REAL(wp), DIMENSION(jpi,jpj) :: zwnd_i, zwnd_j ! wind speed components at T-point 362 REAL(wp), DIMENSION(jpi,jpj) :: zsq ! specific humidity at pst 363 REAL(wp), DIMENSION(jpi,jpj) :: zqlw, zqsb ! long wave and sensible heat fluxes 364 REAL(wp), DIMENSION(jpi,jpj) :: zqla, zevap ! latent heat fluxes and evaporation 365 REAL(wp), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) 366 REAL(wp), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens) 367 REAL(wp), DIMENSION(jpi,jpj) :: Ce ! tansfert coefficient for evaporation (Q_lat) 368 REAL(wp), DIMENSION(jpi,jpj) :: zst ! surface temperature in Kelvin 369 REAL(wp), DIMENSION(jpi,jpj) :: zt_zu ! air temperature at wind speed height 370 REAL(wp), DIMENSION(jpi,jpj) :: zq_zu ! air spec. hum. at wind speed height 371 REAL(wp), DIMENSION(jpi,jpj) :: zU_zu ! bulk wind speed at height zu [m/s] 372 REAL(wp), DIMENSION(jpi,jpj) :: ztpot ! potential temperature of air at z=rn_zqt [K] 373 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa ! density of air [kg/m^3] 375 374 !!--------------------------------------------------------------------- 376 375 ! 377 376 IF( nn_timing == 1 ) CALL timing_start('blk_oce') 378 377 ! 379 CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap )380 CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu )381 CALL wrk_alloc( jpi,jpj, zU_zu, ztpot, zrhoa )382 378 ! 383 379 … … 565 561 ENDIF 566 562 ! 567 CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap )568 CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu )569 CALL wrk_dealloc( jpi,jpj, zU_zu, ztpot, zrhoa )570 563 ! 571 564 IF( nn_timing == 1 ) CALL timing_stop('blk_oce') … … 587 580 INTEGER :: ji, jj ! dummy loop indices 588 581 ! 589 REAL(wp), DIMENSION( :,:) , POINTER:: zrhoa582 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa 590 583 ! 591 584 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 592 585 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 593 REAL(wp), DIMENSION( :,:), POINTER:: Cd ! transfer coefficient for momentum (tau)586 REAL(wp), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) 594 587 !!--------------------------------------------------------------------- 595 588 ! 596 589 IF( nn_timing == 1 ) CALL timing_start('blk_ice_tau') 597 590 ! 598 CALL wrk_alloc( jpi,jpj, zrhoa )599 CALL wrk_alloc( jpi,jpj, Cd )600 591 601 592 Cd(:,:) = Cd_ice … … 699 690 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 700 691 REAL(wp) :: zztmp, z1_lsub ! - - 701 REAL(wp), DIMENSION( :,:,:), POINTER:: z_qlw ! long wave heat flux over ice702 REAL(wp), DIMENSION( :,:,:), POINTER:: z_qsb ! sensible heat flux over ice703 REAL(wp), DIMENSION( :,:,:), POINTER:: z_dqlw ! long wave heat sensitivity over ice704 REAL(wp), DIMENSION( :,:,:), POINTER:: z_dqsb ! sensible heat sensitivity over ice705 REAL(wp), DIMENSION( :,:) , POINTER:: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3)706 REAL(wp), DIMENSION( :,:) , POINTER:: zrhoa707 REAL(wp), DIMENSION( :,:) , POINTER:: Cd ! transfer coefficient for momentum (tau)692 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice 693 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qsb ! sensible heat flux over ice 694 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqlw ! long wave heat sensitivity over ice 695 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqsb ! sensible heat sensitivity over ice 696 REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 697 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa 698 REAL(wp), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) 708 699 !!--------------------------------------------------------------------- 709 700 ! 710 701 IF( nn_timing == 1 ) CALL timing_start('blk_ice_flx') 711 702 ! 712 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )713 CALL wrk_alloc( jpi,jpj, zrhoa)714 CALL wrk_alloc( jpi,jpj, Cd )715 703 716 704 Cd(:,:) = Cd_ice … … 787 775 788 776 #if defined key_lim3 789 CALL wrk_alloc( jpi,jpj, zevap, zsnw )790 777 791 778 ! --- evaporation --- ! … … 823 810 END DO 824 811 825 CALL wrk_dealloc( jpi,jpj, zevap, zsnw )826 812 #endif 827 813 … … 844 830 ENDIF 845 831 846 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )847 CALL wrk_dealloc( jpi,jpj, zrhoa )848 CALL wrk_dealloc( jpi,jpj, Cd )849 832 ! 850 833 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_flx') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90
r7646 r7910 39 39 USE iom ! I/O manager library 40 40 USE lib_mpp ! distribued memory computing library 41 USE wrk_nemo ! work arrays42 41 USE timing ! Timing 43 42 USE prtctl ! Print control … … 111 110 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 112 111 113 REAL(wp), DIMENSION(:,:), POINTER :: & 114 & u_star, t_star, q_star, & 115 & dt_zu, dq_zu, & 116 & znu_a, & !: Nu_air, Viscosity of air 117 & z0, z0t 118 REAL(wp), DIMENSION(:,:), POINTER :: zeta_u ! stability parameter at height zu 119 REAL(wp), DIMENSION(:,:), POINTER :: zeta_t ! stability parameter at height zt 120 REAL(wp), DIMENSION(:,:), POINTER :: ztmp0, ztmp1, ztmp2 112 REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star 113 REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 114 REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 115 REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t 116 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 117 REAL(wp), DIMENSION(jpi,jpj) :: zeta_t ! stability parameter at height zt 118 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 121 119 !!---------------------------------------------------------------------- 122 120 ! 123 121 IF( nn_timing == 1 ) CALL timing_start('turb_coare') 124 122 125 CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu)126 CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )127 123 128 124 l_zt_equal_zu = .FALSE. 129 125 IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 130 126 131 IF( .NOT. l_zt_equal_zu ) CALL wrk_alloc( jpi,jpj, zeta_t )132 127 133 128 !! First guess of temperature and humidity at height zu: … … 246 241 Ce = ztmp0*q_star/dq_zu 247 242 ! 248 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu )249 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )250 IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t )251 243 252 244 IF( nn_timing == 1 ) CALL timing_stop('turb_coare') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90
r7646 r7910 38 38 USE iom ! I/O manager library 39 39 USE lib_mpp ! distribued memory computing library 40 USE wrk_nemo ! work arrays41 40 USE timing ! Timing 42 41 USE in_out_manager ! I/O manager … … 110 109 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 111 110 ! 112 REAL(wp), DIMENSION(:,:), POINTER :: & 113 & u_star, t_star, q_star, &114 & dt_zu, dq_zu, &115 & znu_a, &!: Nu_air, Viscosity of air116 &z0, z0t117 REAL(wp), DIMENSION( :,:), POINTER:: zeta_u ! stability parameter at height zu118 REAL(wp), DIMENSION( :,:), POINTER:: zeta_t ! stability parameter at height zt119 REAL(wp), DIMENSION( :,:), POINTER:: ztmp0, ztmp1, ztmp2111 112 REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star 113 REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 114 REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 115 REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t 116 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 117 REAL(wp), DIMENSION(jpi,jpj) :: zeta_t ! stability parameter at height zt 118 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 120 119 !!---------------------------------------------------------------------------------- 121 120 ! 122 121 IF( nn_timing == 1 ) CALL timing_start('turb_coare3p5') 123 122 124 CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu)125 CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )126 123 127 124 l_zt_equal_zu = .FALSE. 128 125 IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 129 126 130 IF( .NOT. l_zt_equal_zu ) CALL wrk_alloc( jpi,jpj, zeta_t )131 127 132 128 !! First guess of temperature and humidity at height zu: … … 252 248 Ce = ztmp0*q_star/dq_zu 253 249 ! 254 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu )255 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )256 IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t )257 250 258 251 IF( nn_timing == 1 ) CALL timing_stop('turb_coare3p5') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90
r7646 r7910 32 32 USE iom ! I/O manager library 33 33 USE lib_mpp ! distribued memory computing library 34 USE wrk_nemo ! work arrays35 34 USE timing ! Timing 36 35 USE in_out_manager ! I/O manager … … 117 116 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 118 117 ! 119 REAL(wp), DIMENSION( :,:), POINTER :: u_star, t_star, q_star, &120 & dt_zu, dq_zu, &121 & znu_a, &!: Nu_air, Viscosity of air122 & Linv, &!: 1/L (inverse of Monin Obukhov length...123 &z0, z0t, z0q124 REAL(wp), DIMENSION( :,:), POINTER:: func_m, func_h125 REAL(wp), DIMENSION( :,:), POINTER:: ztmp0, ztmp1, ztmp2118 REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star 119 REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 120 REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 121 REAL(wp), DIMENSION(jpi,jpj) :: Linv !: 1/L (inverse of Monin Obukhov length... 122 REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 123 REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h 124 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 126 125 !!---------------------------------------------------------------------------------- 127 126 ! 128 127 IF( nn_timing == 1 ) CALL timing_start('turb_ecmwf') 129 128 ! 130 CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv )131 CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, z0q, ztmp0, ztmp1, ztmp2 )132 129 ! 133 130 ! Identical first gess as in COARE, with IFS parameter values though … … 281 278 Ce = vkarmn*vkarmn/(func_m*ztmp1) 282 279 283 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv )284 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, z0q, ztmp0, ztmp1, ztmp2 )285 280 ! 286 281 IF( nn_timing == 1 ) CALL timing_stop('turb_ecmwf') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90
r7753 r7910 34 34 USE iom ! I/O manager library 35 35 USE lib_mpp ! distribued memory computing library 36 USE wrk_nemo ! work arrays37 36 USE timing ! Timing 38 37 USE in_out_manager ! I/O manager … … 117 116 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 118 117 ! 119 REAL(wp), DIMENSION( :,:), POINTER:: Cx_n10 ! 10m neutral latent/sensible coefficient120 REAL(wp), DIMENSION( :,:), POINTER:: sqrt_Cd_n10 ! root square of Cd_n10121 REAL(wp), DIMENSION( :,:), POINTER:: zeta_u ! stability parameter at height zu122 REAL(wp), DIMENSION( :,:), POINTER:: zpsi_h_u123 REAL(wp), DIMENSION( :,:), POINTER:: ztmp0, ztmp1, ztmp2124 REAL(wp), DIMENSION( :,:), POINTER:: stab ! stability test integer118 REAL(wp), DIMENSION(jpi,jpj) :: Cx_n10 ! 10m neutral latent/sensible coefficient 119 REAL(wp), DIMENSION(jpi,jpj) :: sqrt_Cd_n10 ! root square of Cd_n10 120 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 121 REAL(wp), DIMENSION(jpi,jpj) :: zpsi_h_u 122 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 123 REAL(wp), DIMENSION(jpi,jpj) :: stab ! stability test integer 125 124 !!---------------------------------------------------------------------------------- 126 125 ! 127 126 IF( nn_timing == 1 ) CALL timing_start('turb_ncar') 128 127 ! 129 CALL wrk_alloc( jpi,jpj, Cx_n10, sqrt_Cd_n10, zeta_u, stab )130 CALL wrk_alloc( jpi,jpj, zpsi_h_u, ztmp0, ztmp1, ztmp2 )131 128 ! 132 129 l_zt_equal_zu = .FALSE. … … 221 218 END DO 222 219 223 CALL wrk_dealloc( jpi,jpj, Cx_n10, sqrt_Cd_n10, zeta_u, stab )224 CALL wrk_dealloc( jpi,jpj, zpsi_h_u, ztmp0, ztmp1, ztmp2 )225 220 226 221 IF( nn_timing == 1 ) CALL timing_stop('turb_ncar') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7815 r7910 50 50 USE iom ! NetCDF library 51 51 USE lib_mpp ! distribued memory computing library 52 USE wrk_nemo ! work arrays53 52 USE timing ! Timing 54 53 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 237 236 INTEGER :: jn ! dummy loop index 238 237 INTEGER :: ios, inum ! Local integer 239 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos238 REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos 240 239 !! 241 240 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & … … 251 250 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') 252 251 ! 253 CALL wrk_alloc( jpi,jpj, zacs, zaos )254 252 255 253 ! ================================ ! … … 922 920 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq 923 921 924 CALL wrk_dealloc( jpi,jpj, zacs, zaos )925 922 ! 926 923 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') … … 990 987 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 991 988 REAL(wp) :: zzx, zzy ! temporary variables 992 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr989 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 993 990 !!---------------------------------------------------------------------- 994 991 ! 995 992 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 996 993 ! 997 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )998 994 ! 999 995 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1311 1307 ENDIF 1312 1308 ! 1313 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1314 1309 ! 1315 1310 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1356 1351 INTEGER :: ji, jj ! dummy loop indices 1357 1352 INTEGER :: itx ! index of taux over ice 1358 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty1353 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1359 1354 !!---------------------------------------------------------------------- 1360 1355 ! 1361 1356 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau') 1362 1357 ! 1363 CALL wrk_alloc( jpi,jpj, ztx, zty )1364 1358 1365 1359 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1521 1515 ENDIF 1522 1516 ! 1523 CALL wrk_dealloc( jpi,jpj, ztx, zty )1524 1517 ! 1525 1518 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau') … … 1584 1577 ! 1585 1578 INTEGER :: jl ! dummy loop index 1586 REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw1587 REAL(wp), POINTER, DIMENSION(:,:) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice1588 REAL(wp), POINTER, DIMENSION(:,:) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice1589 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice1579 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw 1580 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1581 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1582 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1590 1583 !!---------------------------------------------------------------------- 1591 1584 ! 1592 1585 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1593 1586 ! 1594 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw )1595 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )1596 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )1597 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )1598 1587 1599 1588 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1980 1969 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1981 1970 1982 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw )1983 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )1984 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )1985 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )1986 1971 ! 1987 1972 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 2004 1989 INTEGER :: isec, info ! local integer 2005 1990 REAL(wp) :: zumax, zvmax 2006 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz12007 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp41991 REAL(wp), DIMENSION(jpi,jpj) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1992 REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4 2008 1993 !!---------------------------------------------------------------------- 2009 1994 ! 2010 1995 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd') 2011 1996 ! 2012 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )2013 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )2014 1997 2015 1998 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges … … 2490 2473 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2491 2474 2492 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )2493 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )2494 2475 ! 2495 2476 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r6140 r7910 24 24 USE in_out_manager ! I/O manager 25 25 USE lib_mpp ! distribued memory computing library 26 USE wrk_nemo ! work arrays27 26 USE timing ! Timing 28 27 USE lbclnk ! ocean lateral boundary conditions … … 69 68 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars 70 69 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread, zcoef ! - - 71 REAL(wp), POINTER, DIMENSION(:,:) :: ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces72 REAL(wp), POINTER, DIMENSION(:,:) :: ztmsk_tospread, zerp_cor ! - -70 REAL(wp), DIMENSION(jpi,jpj) :: ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 71 REAL(wp), DIMENSION(jpi,jpj) :: ztmsk_tospread, zerp_cor ! - - 73 72 !!---------------------------------------------------------------------- 74 73 ! 75 74 IF( nn_timing == 1 ) CALL timing_start('sbc_fwb') 76 75 ! 77 CALL wrk_alloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor )78 76 ! 79 77 IF( kt == nit000 ) THEN … … 208 206 END SELECT 209 207 ! 210 CALL wrk_dealloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor )211 208 ! 212 209 IF( nn_timing == 1 ) CALL timing_stop('sbc_fwb') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r7646 r7910 18 18 USE lib_mpp ! distributed memory computing library 19 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 USE wrk_nemo ! work arrays21 20 USE timing ! Timing 22 21 USE daymod ! calendar … … 160 159 !!--------------------------------------------------------------------- 161 160 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 162 REAL(wp), DIMENSION( :,:), POINTER:: ztmp1, ztmp2161 REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 163 162 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 164 163 INTEGER :: ji, jj, jl, jk ! dummy loop indices … … 167 166 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_init') 168 167 ! 169 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 )170 168 ! 171 169 IF(lwp) WRITE(numout,*)'cice_sbc_init' … … 284 282 ENDIF 285 283 ! 286 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )287 284 ! 288 285 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_init') … … 300 297 ! 301 298 INTEGER :: ji, jj, jl ! dummy loop indices 302 REAL(wp), DIMENSION( :,:), POINTER:: ztmp, zpice303 REAL(wp), DIMENSION( :,:,:), POINTER:: ztmpn299 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, zpice 300 REAL(wp), DIMENSION(jpi,jpj,ncat) :: ztmpn 304 301 REAL(wp) :: zintb, zintn ! dummy argument 305 302 !!--------------------------------------------------------------------- … … 307 304 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_in') 308 305 ! 309 CALL wrk_alloc( jpi,jpj, ztmp, zpice )310 CALL wrk_alloc( jpi,jpj,ncat, ztmpn )311 306 312 307 IF( kt == nit000 ) THEN … … 509 504 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 510 505 511 CALL wrk_dealloc( jpi,jpj, ztmp, zpice )512 CALL wrk_dealloc( jpi,jpj,ncat, ztmpn )513 506 ! 514 507 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_in') … … 526 519 527 520 INTEGER :: ji, jj, jl ! dummy loop indices 528 REAL(wp), DIMENSION( :,:), POINTER:: ztmp1, ztmp2521 REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 529 522 !!--------------------------------------------------------------------- 530 523 531 524 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_out') 532 525 ! 533 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 )534 526 535 527 IF( kt == nit000 ) THEN … … 687 679 ! Release work space 688 680 689 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )690 681 ! 691 682 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_out') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7777 r7910 58 58 USE lbclnk ! lateral boundary condition - MPP link 59 59 USE lib_mpp ! MPP library 60 USE wrk_nemo ! work arrays61 60 USE timing ! Timing 62 61 … … 110 109 !! 111 110 INTEGER :: jl ! dummy loop index 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky113 REAL(wp), POINTER, DIMENSION(:,:) :: zutau_ice, zvtau_ice111 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 112 REAL(wp), DIMENSION(jpi,jpj) :: zutau_ice, zvtau_ice 114 113 !!---------------------------------------------------------------------- 115 114 … … 152 151 153 152 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 154 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice)155 153 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 156 154 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 157 155 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 158 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice)159 156 ENDIF 160 157 … … 206 203 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 207 204 !---------------------------------------------------------------------------------------- 208 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs )209 205 210 206 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos … … 224 220 END SELECT 225 221 226 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs )227 222 228 223 !----------------------------! … … 524 519 INTEGER :: jl ! dummy loop index 525 520 ! 526 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m ! Mean albedo over all categories527 REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m ! Mean temperature over all categories528 ! 529 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories530 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories531 REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m ! Mean sublimation over all categories532 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories533 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories521 REAL(wp), DIMENSION(jpi,jpj) :: zalb_m ! Mean albedo over all categories 522 REAL(wp), DIMENSION(jpi,jpj) :: ztem_m ! Mean temperature over all categories 523 ! 524 REAL(wp), DIMENSION(jpi,jpj) :: z_qsr_m ! Mean solar heat flux over all categories 525 REAL(wp), DIMENSION(jpi,jpj) :: z_qns_m ! Mean non solar heat flux over all categories 526 REAL(wp), DIMENSION(jpi,jpj) :: z_evap_m ! Mean sublimation over all categories 527 REAL(wp), DIMENSION(jpi,jpj) :: z_dqn_m ! Mean d(qns)/dT over all categories 528 REAL(wp), DIMENSION(jpi,jpj) :: z_devap_m ! Mean d(evap)/dT over all categories 534 529 !!---------------------------------------------------------------------- 535 530 ! … … 538 533 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! 539 534 CASE( 0 , 1 ) 540 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)541 535 ! 542 536 z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) … … 556 550 END DO 557 551 ! 558 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)559 552 END SELECT 560 553 ! 561 554 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==! 562 555 CASE( 1 , 2 ) 563 CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m )564 556 ! 565 557 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) … … 571 563 END DO 572 564 ! 573 CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m )574 565 END SELECT 575 566 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r7646 r7910 43 43 USE lbclnk ! lateral boundary condition - MPP link 44 44 USE lib_mpp ! MPP library 45 USE wrk_nemo ! work arrays46 45 USE iom ! I/O manager library 47 46 USE in_out_manager ! I/O manager … … 94 93 !! 95 94 INTEGER :: ji, jj ! dummy loop indices 96 REAL(wp), DIMENSION( :,:,:), POINTER:: zalb_os ! ice albedo under overcast sky97 REAL(wp), DIMENSION( :,:,:), POINTER:: zalb_cs ! ice albedo under clear sky98 REAL(wp), DIMENSION( :,:,:), POINTER:: zalb_ice ! mean ice albedo99 REAL(wp), DIMENSION( :,:,:), POINTER:: zsist ! ice surface temperature (K)100 REAL(wp), DIMENSION( :,: ), POINTER:: zutau_ice, zvtau_ice95 REAL(wp), DIMENSION(jpi,jpj,1) :: zalb_os ! ice albedo under overcast sky 96 REAL(wp), DIMENSION(jpi,jpj,1) :: zalb_cs ! ice albedo under clear sky 97 REAL(wp), DIMENSION(jpi,jpj,1) :: zalb_ice ! mean ice albedo 98 REAL(wp), DIMENSION(jpi,jpj,1) :: zsist ! ice surface temperature (K) 99 REAL(wp), DIMENSION(jpi,jpj) :: zutau_ice, zvtau_ice 101 100 !!---------------------------------------------------------------------- 102 101 … … 121 120 # endif 122 121 123 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice)124 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )125 122 126 123 ! Bulk Formulea ! … … 245 242 # endif 246 243 ! 247 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice)248 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )249 244 ! 250 245 ENDIF ! End sea-ice time step only -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r7816 r7910 24 24 USE fldread ! read input field at current time step 25 25 USE lbclnk ! 26 USE wrk_nemo ! Memory allocation27 26 USE timing ! Timing 28 27 USE lib_fortran ! glob_sum … … 94 93 INTEGER :: ji, jj, jk ! loop index 95 94 INTEGER :: ikt, ikb ! loop index 96 REAL(wp), DIMENSION ( :,:), POINTER:: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep)97 REAL(wp), DIMENSION( :,:,:), POINTER:: zfwfisf3d, zqhcisf3d, zqlatisf3d98 REAL(wp), DIMENSION( :,: ), POINTER:: zqhcisf2d95 REAL(wp), DIMENSION (jpi,jpj) :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep) 96 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfwfisf3d, zqhcisf3d, zqlatisf3d 97 REAL(wp), DIMENSION(jpi,jpj) :: zqhcisf2d 99 98 !!--------------------------------------------------------------------- 100 99 ! 101 100 IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 102 101 ! allocation 103 CALL wrk_alloc( jpi,jpj, zt_frz, zdep )104 102 105 103 ! compute salt and heat flux … … 173 171 ! Diagnostics 174 172 IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 175 CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d )176 CALL wrk_alloc( jpi,jpj, zqhcisf2d )177 173 178 174 zfwfisf3d(:,:,:) = 0.0_wp ! 3d ice shelf melting (kg/m2/s) … … 201 197 CALL iom_put('qhcisf' , zqhcisf2d (:,: )) 202 198 203 CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d )204 CALL wrk_dealloc( jpi,jpj, zqhcisf2d )205 199 END IF 206 200 ! deallocation 207 CALL wrk_dealloc( jpi,jpj, zt_frz, zdep )208 201 ! 209 202 END IF … … 472 465 REAL(wp) :: zeps = 1.e-20_wp 473 466 REAL(wp) :: zerr 474 REAL(wp), DIMENSION( :,:), POINTER:: zfrz475 REAL(wp), DIMENSION( :,:), POINTER:: zgammat, zgammas476 REAL(wp), DIMENSION( :,:), POINTER:: zfwflx, zhtflx, zhtflx_b467 REAL(wp), DIMENSION(jpi,jpj) :: zfrz 468 REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas 469 REAL(wp), DIMENSION(jpi,jpj) :: zfwflx, zhtflx, zhtflx_b 477 470 LOGICAL :: lit 478 471 !!--------------------------------------------------------------------- … … 484 477 IF( nn_timing == 1 ) CALL timing_start('sbc_isf_cav') 485 478 ! 486 CALL wrk_alloc( jpi,jpj, zfrz , zgammat, zgammas )487 CALL wrk_alloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )488 479 489 480 ! initialisation … … 578 569 CALL iom_put('isfgammas', zgammas) 579 570 ! 580 CALL wrk_dealloc( jpi,jpj, zfrz , zgammat, zgammas )581 CALL wrk_dealloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )582 571 ! 583 572 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_cav') … … 600 589 INTEGER :: ikt 601 590 INTEGER :: ji, jj ! loop index 602 REAL(wp), DIMENSION( :,:), POINTER:: zustar ! U, V at T point and friction velocity591 REAL(wp), DIMENSION(jpi,jpj) :: zustar ! U, V at T point and friction velocity 603 592 REAL(wp) :: zdku, zdkv ! U, V shear 604 593 REAL(wp) :: zPr, zSc, zRc ! Prandtl, Scmidth and Richardson number … … 615 604 REAL(wp), DIMENSION(2) :: zts, zab 616 605 !!--------------------------------------------------------------------- 617 CALL wrk_alloc( jpi,jpj, zustar )618 606 ! 619 607 SELECT CASE ( nn_gammablk ) … … 703 691 CALL lbc_lnk(pgs(:,:),'T',1.) 704 692 END SELECT 705 CALL wrk_dealloc( jpi,jpj, zustar )706 693 ! 707 694 END SUBROUTINE sbc_isf_gammats … … 719 706 ! 720 707 REAL(wp) :: ze3, zhk 721 REAL(wp), DIMENSION( :,:), POINTER:: zhisf_tbl ! thickness of the tbl708 REAL(wp), DIMENSION(jpi,jpj) :: zhisf_tbl ! thickness of the tbl 722 709 723 710 INTEGER :: ji, jj, jk ! loop index … … 725 712 !!---------------------------------------------------------------------- 726 713 ! allocation 727 CALL wrk_alloc( jpi,jpj, zhisf_tbl)728 714 729 715 ! initialisation … … 816 802 817 803 ! deallocation 818 CALL wrk_dealloc( jpi,jpj, zhisf_tbl )819 804 ! 820 805 END SUBROUTINE sbc_isf_tbl -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r7753 r7910 27 27 USE iom ! I/O module 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory allocation30 29 31 30 IMPLICIT NONE … … 106 105 INTEGER :: z_err = 0 ! dummy integer for error handling 107 106 !!---------------------------------------------------------------------- 108 REAL(wp), DIMENSION(:,:), POINTER :: ztfrz ! freezing point used for temperature correction 109 ! 110 CALL wrk_alloc( jpi,jpj, ztfrz) 107 REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing point used for temperature correction 108 ! 111 109 ! 112 110 ! !-------------------! … … 168 166 ENDIF 169 167 ! 170 CALL wrk_dealloc( jpi,jpj, ztfrz)171 168 ! 172 169 END SUBROUTINE sbc_rnf -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r7864 r7910 27 27 USE lib_mpp ! distribued memory computing library 28 28 USE fldread ! read input fields 29 USE wrk_nemo !30 29 31 30 IMPLICIT NONE … … 89 88 REAL(wp) :: ztransp, zfac, ztemp, zsp0 90 89 REAL(wp) :: zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v 91 REAL(wp), DIMENSION(:,:) , POINTER :: zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace 92 REAL(wp), DIMENSION(:,:,:), POINTER :: ze3divh ! 3D workspace 93 !!--------------------------------------------------------------------- 94 ! 95 CALL wrk_alloc( jpi,jpj,jpk, ze3divh ) 96 CALL wrk_alloc( jpi,jpj, zk_t, zk_u, zk_v, zu0_sd, zv0_sd ) 90 REAL(wp), DIMENSION(jpi,jpj) :: zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3divh ! 3D workspace 92 !!--------------------------------------------------------------------- 93 ! 97 94 ! 98 95 ! … … 183 180 CALL iom_put( "wstokes", wsd ) 184 181 ! 185 CALL wrk_dealloc( jpi,jpj,jpk, ze3divh )186 CALL wrk_dealloc( jpi,jpj, zk_t, zk_u, zk_v, zu0_sd, zv0_sd )187 182 ! 188 183 END SUBROUTINE sbc_stokes -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r7753 r7910 34 34 USE prtctl ! Print control 35 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! Memory Allocation37 36 USE timing ! Timing 38 37 USE sbcwave ! wave module … … 89 88 ! 90 89 INTEGER :: jk ! dummy loop index 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn92 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds ! 3D workspace 93 92 !!---------------------------------------------------------------------- 94 93 ! 95 94 IF( nn_timing == 1 ) CALL timing_start('tra_adv') 96 95 ! 97 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn )98 96 ! 99 97 ! ! set time step … … 146 144 ! 147 145 IF( l_trdtra ) THEN !* Save ta and sa trends 148 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )149 146 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 150 147 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 175 172 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 176 173 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 177 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )178 174 ENDIF 179 175 ! ! print mean trends (used for debugging) … … 183 179 IF( nn_timing == 1 ) CALL timing_stop( 'tra_adv' ) 184 180 ! 185 CALL wrk_dealloc( jpi,jpj,jpk, zun, zvn, zwn )186 181 ! 187 182 END SUBROUTINE tra_adv -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
r7646 r7910 24 24 USE trc_oce ! share passive tracers/Ocean variables 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! Memory Allocation27 26 USE timing ! Timing 28 27 … … 80 79 REAL(wp) :: zC2t_u, zC4t_u ! local scalars 81 80 REAL(wp) :: zC2t_v, zC4t_v ! - - 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy, zwz, ztu, ztv, ztw81 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zwy, zwz, ztu, ztv, ztw 83 82 !!---------------------------------------------------------------------- 84 83 ! 85 84 IF( nn_timing == 1 ) CALL timing_start('tra_adv_cen') 86 85 ! 87 CALL wrk_alloc( jpi,jpj,jpk, zwx, zwy, zwz, ztu, ztv, ztw )88 86 ! 89 87 IF( kt == kit000 ) THEN … … 209 207 END DO 210 208 ! 211 CALL wrk_dealloc( jpi,jpj,jpk, zwx, zwy, zwz, ztu, ztv, ztw )212 209 ! 213 210 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_cen') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r7753 r7910 28 28 USE lbclnk ! ocean lateral boundary condition (or mpp link) 29 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 USE wrk_nemo ! Memory Allocation31 30 USE timing ! Timing 32 31 … … 88 87 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - - 89 88 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw91 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdx, ztrdy, ztrdz, zptry 92 91 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 93 92 !!---------------------------------------------------------------------- … … 95 94 IF( nn_timing == 1 ) CALL timing_start('tra_adv_fct') 96 95 ! 97 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )98 96 ! 99 97 IF( kt == kit000 ) THEN … … 112 110 ! 113 111 IF( l_trd .OR. l_hst ) THEN 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )115 112 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 116 113 ENDIF 117 114 ! 118 115 IF( l_ptr ) THEN 119 CALL wrk_alloc( jpi, jpj, jpk, zptry )120 116 zptry(:,:,:) = 0._wp 121 117 ENDIF … … 331 327 END DO ! end of tracer loop 332 328 ! 333 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )334 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )335 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry )336 329 ! 337 330 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct') … … 376 369 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk ! - - 377 370 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 378 REAL(wp), POINTER, DIMENSION(:,:) :: zwx_sav , zwy_sav379 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav380 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz381 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry382 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs371 REAL(wp), DIMENSION(jpi,jpj) :: zwx_sav , zwy_sav 372 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 373 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdx, ztrdy, ztrdz 374 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zptry 375 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt+1) :: ztrs 383 376 !!---------------------------------------------------------------------- 384 377 ! 385 378 IF( nn_timing == 1 ) CALL timing_start('tra_adv_fct_zts') 386 379 ! 387 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav )388 CALL wrk_alloc( jpi,jpj,jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )389 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs )390 380 ! 391 381 IF( kt == kit000 ) THEN … … 404 394 ! 405 395 IF( l_trd .OR. l_hst ) THEN 406 CALL wrk_alloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz )407 396 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 408 397 ENDIF 409 398 ! 410 399 IF( l_ptr ) THEN 411 CALL wrk_alloc( jpi, jpj,jpk, zptry )412 400 zptry(:,:,:) = 0._wp 413 401 ENDIF … … 621 609 END DO 622 610 ! 623 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav )624 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )625 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs )626 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )627 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry )628 611 ! 629 612 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct_zts') … … 653 636 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 654 637 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 655 REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo638 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 656 639 !!---------------------------------------------------------------------- 657 640 ! 658 641 IF( nn_timing == 1 ) CALL timing_start('nonosc') 659 642 ! 660 CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )661 643 ! 662 644 zbig = 1.e+40_wp … … 734 716 CALL lbc_lnk( paa, 'U', -1. ) ; CALL lbc_lnk( pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 735 717 ! 736 CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )737 718 ! 738 719 IF( nn_timing == 1 ) CALL timing_stop('nonosc') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r7753 r7910 19 19 USE iom ! IOM library 20 20 USE lib_mpp ! MPP library 21 USE wrk_nemo ! work arrays22 21 USE timing ! Timing 23 22 … … 95 94 INTEGER, DIMENSION(3) :: ilocu ! 96 95 INTEGER, DIMENSION(2) :: ilocs ! 97 REAL(wp), POINTER, DIMENSION(:,:) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH98 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw99 INTEGER, POINTER, DIMENSION(:,:) :: inml_mle96 REAL(wp), DIMENSION(jpi,jpj) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 97 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 98 INTEGER, DIMENSION(jpi,jpj) :: inml_mle 100 99 !!---------------------------------------------------------------------- 101 100 ! 102 101 IF( nn_timing == 1 ) CALL timing_start('tra_adv_mle') 103 CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)104 CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw)105 CALL wrk_alloc( jpi, jpj, inml_mle)106 102 ! 107 103 ! !== MLD used for MLE ==! … … 256 252 CALL iom_put( "psiv_mle", zpsi_vw ) ! j-mle streamfunction 257 253 ENDIF 258 CALL wrk_dealloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)259 CALL wrk_dealloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw)260 CALL wrk_dealloc( jpi, jpj, inml_mle)261 254 262 255 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_mle') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r7753 r7910 27 27 ! 28 28 USE iom 29 USE wrk_nemo ! Memory Allocation30 29 USE timing ! Timing 31 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 90 89 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 91 90 REAL(wp) :: zalpha ! - - 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy ! 3D workspace93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx , zwy ! - -91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zslpx, zslpy ! 3D workspace 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx , zwy ! - - 94 93 !!---------------------------------------------------------------------- 95 94 ! 96 95 IF( nn_timing == 1 ) CALL timing_start('tra_adv_mus') 97 96 ! 98 CALL wrk_alloc( jpi,jpj,jpk, zslpx, zslpy, zwx, zwy )99 97 ! 100 98 IF( kt == kit000 ) THEN … … 279 277 END DO ! end of tracer loop 280 278 ! 281 CALL wrk_dealloc( jpi,jpj,jpk, zslpx, zslpy, zwx, zwy )282 279 ! 283 280 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_mus') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r7646 r7910 25 25 USE lbclnk ! ocean lateral boundary condition (or mpp link) 26 26 USE in_out_manager ! I/O manager 27 USE wrk_nemo ! Memory Allocation28 27 USE timing ! Timing 29 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 138 137 INTEGER :: ji, jj, jk, jn ! dummy loop indices 139 138 REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars 140 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zfu, zfc, zfd139 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zfu, zfc, zfd 141 140 !---------------------------------------------------------------------- 142 141 ! 143 CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd )144 142 ! ! =========== 145 143 DO jn = 1, kjpt ! tracer loop … … 234 232 END DO 235 233 ! 236 CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd )237 234 ! 238 235 END SUBROUTINE tra_adv_qck_i … … 254 251 INTEGER :: ji, jj, jk, jn ! dummy loop indices 255 252 REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars 256 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd253 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwy, zfu, zfc, zfd 257 254 !---------------------------------------------------------------------- 258 255 ! 259 CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd )260 256 ! 261 257 ! ! =========== … … 359 355 END DO 360 356 ! 361 CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd )362 357 ! 363 358 END SUBROUTINE tra_adv_qck_j … … 377 372 ! 378 373 INTEGER :: ji, jj, jk, jn ! dummy loop indices 379 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 380 !!---------------------------------------------------------------------- 381 ! 382 CALL wrk_alloc( jpi,jpj,jpk, zwz ) 374 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz 375 !!---------------------------------------------------------------------- 376 ! 383 377 ! 384 378 zwz(:,:, 1 ) = 0._wp ! surface & bottom values set to zero for all tracers … … 421 415 END DO 422 416 ! 423 CALL wrk_dealloc( jpi,jpj,jpk, zwz )424 417 ! 425 418 END SUBROUTINE tra_adv_cen2_k -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r7646 r7910 26 26 USE lbclnk ! ocean lateral boundary condition (or mpp link) 27 27 USE in_out_manager ! I/O manager 28 USE wrk_nemo ! Memory Allocation29 28 USE timing ! Timing 30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 101 100 REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - - 102 101 REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - - 103 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zltu, zltv, zti, ztw102 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv, zti, ztw 104 103 !!---------------------------------------------------------------------- 105 104 ! 106 105 IF( nn_timing == 1 ) CALL timing_start('tra_adv_ubs') 107 106 ! 108 CALL wrk_alloc( jpi,jpj,jpk, ztu, ztv, zltu, zltv, zti, ztw )109 107 ! 110 108 IF( kt == kit000 ) THEN … … 285 283 END DO 286 284 ! 287 CALL wrk_dealloc( jpi,jpj,jpk, ztu, ztv, zltu, zltv, zti, ztw )288 285 ! 289 286 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_ubs') … … 313 310 INTEGER :: ikm1 ! local integer 314 311 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 315 REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo312 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo 316 313 !!---------------------------------------------------------------------- 317 314 ! 318 315 IF( nn_timing == 1 ) CALL timing_start('nonosc_z') 319 316 ! 320 CALL wrk_alloc( jpi,jpj,jpk, zbetup, zbetdo )321 317 ! 322 318 zbig = 1.e+40_wp … … 387 383 END DO 388 384 ! 389 CALL wrk_dealloc( jpi,jpj,jpk, zbetup, zbetdo )390 385 ! 391 386 IF( nn_timing == 1 ) CALL timing_stop('nonosc_z') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r7753 r7910 27 27 USE lib_mpp ! distributed memory computing library 28 28 USE prtctl ! Print control 29 USE wrk_nemo ! Memory Allocation30 29 USE timing ! Timing 31 30 … … 77 76 ! 78 77 INTEGER :: ji, jj ! dummy loop indices 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt78 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt 80 79 !!---------------------------------------------------------------------- 81 80 ! … … 83 82 ! 84 83 IF( l_trdtra ) THEN ! Save the input temperature trend 85 CALL wrk_alloc( jpi,jpj,jpk, ztrdt )86 84 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 87 85 ENDIF … … 98 96 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 99 97 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 100 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt )101 98 ENDIF 102 99 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7753 r7910 36 36 USE lbclnk ! ocean lateral boundary conditions 37 37 USE prtctl ! Print control 38 USE wrk_nemo ! Memory Allocation39 38 USE timing ! Timing 40 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 106 105 INTEGER, INTENT( in ) :: kt ! ocean time-step 107 106 ! 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds107 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds 109 108 !!---------------------------------------------------------------------- 110 109 ! … … 112 111 ! 113 112 IF( l_trdtra ) THEN !* Save the input trends 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )115 113 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 116 114 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 150 148 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 151 149 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 152 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )153 150 ENDIF 154 151 ! … … 186 183 INTEGER :: ik ! local integers 187 184 REAL(wp) :: zbtr ! local scalars 188 REAL(wp), POINTER, DIMENSION(:,:) :: zptb185 REAL(wp), DIMENSION(jpi,jpj) :: zptb 189 186 !!---------------------------------------------------------------------- 190 187 ! 191 188 IF( nn_timing == 1 ) CALL timing_start('tra_bbl_dif') 192 189 ! 193 CALL wrk_alloc( jpi, jpj, zptb )194 190 ! 195 191 DO jn = 1, kjpt ! tracer loop … … 216 212 END DO ! end tracer 217 213 ! ! =========== 218 CALL wrk_dealloc( jpi, jpj, zptb )219 214 ! 220 215 IF( nn_timing == 1 ) CALL timing_stop('tra_bbl_dif') … … 497 492 INTEGER :: ii0, ii1, ij0, ij1 ! local integer 498 493 INTEGER :: ios ! - - 499 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk494 REAL(wp), DIMENSION(jpi,jpj) :: zmbk 500 495 ! 501 496 NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl … … 540 535 END DO 541 536 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 542 CALL wrk_alloc( jpi, jpj, zmbk )543 537 zmbk(:,:) = REAL( mbku_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 544 538 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 545 CALL wrk_dealloc( jpi, jpj, zmbk )546 539 547 540 ! !* sign of grad(H) at u- and v-points -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r7753 r7910 35 35 USE lib_mpp ! MPP library 36 36 USE prtctl ! Print control 37 USE wrk_nemo ! Memory allocation38 37 USE timing ! Timing 39 38 USE iom … … 94 93 ! 95 94 INTEGER :: ji, jj, jk, jn ! dummy loop indices 96 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta, ztrdts95 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts_dta, ztrdts 97 96 !!---------------------------------------------------------------------- 98 97 ! 99 98 IF( nn_timing == 1 ) CALL timing_start('tra_dmp') 100 99 ! 101 CALL wrk_alloc( jpi,jpj,jpk,jpts, zts_dta )102 100 IF( l_trdtra ) THEN !* Save ta and sa trends 103 CALL wrk_alloc( jpi,jpj,jpk,jpts, ztrdts )104 101 ztrdts(:,:,:,:) = tsa(:,:,:,:) 105 102 ENDIF … … 154 151 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 155 152 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 156 CALL wrk_dealloc( jpi,jpj,jpk,jpts, ztrdts )157 153 ENDIF 158 154 ! ! Control print … … 160 156 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 161 157 ! 162 CALL wrk_dealloc( jpi,jpj,jpk,jpts, zts_dta )163 158 ! 164 159 IF( nn_timing == 1 ) CALL timing_stop('tra_dmp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r7765 r7910 30 30 USE lib_mpp ! distribued memory computing library 31 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! Memory allocation33 32 USE timing ! Timing 34 33 … … 58 57 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 58 !! 60 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds59 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds 61 60 !!---------------------------------------------------------------------- 62 61 ! … … 64 63 ! 65 64 IF( l_trdtra ) THEN !* Save ta and sa trends 66 CALL wrk_alloc( jpi,jpj,jpk, ztrdt, ztrds )67 65 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 68 66 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 85 83 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 86 84 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 87 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt, ztrds )88 85 ENDIF 89 86 ! !* print mean trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r7753 r7910 30 30 USE phycst ! physical constants 31 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! Memory Allocation33 32 USE timing ! Timing 34 33 … … 111 110 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 112 111 REAL(wp) :: zcoef0, ze3w_2, zsign, z2dt, z1_2dt ! - - 113 REAL(wp), POINTER, DIMENSION(:,:) :: zdkt, zdk1t, z2d114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw112 REAL(wp), DIMENSION(jpi,jpj) :: zdkt, zdk1t, z2d 113 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw 115 114 !!---------------------------------------------------------------------- 116 115 ! 117 116 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_iso') 118 117 ! 119 CALL wrk_alloc( jpi,jpj, zdkt, zdk1t, z2d )120 CALL wrk_alloc( jpi,jpj,jpk, zdit, zdjt , zftu, zftv, ztfw )121 118 ! 122 119 IF( kt == kit000 ) THEN … … 388 385 ! ! =============== 389 386 ! 390 CALL wrk_dealloc( jpi, jpj, zdkt, zdk1t, z2d )391 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw )392 387 ! 393 388 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
r7646 r7910 25 25 USE lib_mpp ! distribued memory computing library 26 26 USE timing ! Timing 27 USE wrk_nemo ! Memory allocation28 27 USE iom 29 28 … … 87 86 INTEGER :: ji, jj, jk, jn ! dummy loop indices 88 87 REAL(wp) :: zsign ! local scalars 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zaheeu, zaheev88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zaheeu, zaheev 90 89 !!---------------------------------------------------------------------- 91 90 ! … … 98 97 ENDIF 99 98 ! 100 CALL wrk_alloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev )101 99 ! 102 100 l_hst = .FALSE. … … 169 167 ! ! ================== 170 168 ! 171 CALL wrk_dealloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev )172 169 ! 173 170 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') … … 203 200 ! 204 201 INTEGER :: ji, jj, jk, jn ! dummy loop indices 205 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap ! laplacian at t-point206 REAL(wp), POINTER, DIMENSION(:,:,:) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points)207 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points)202 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap ! laplacian at t-point 203 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points) 204 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points) 208 205 !!--------------------------------------------------------------------- 209 206 ! 210 207 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_blp') 211 208 ! 212 CALL wrk_alloc( jpi,jpj,jpk,kjpt, zlap )213 CALL wrk_alloc( jpi,jpj, kjpt, zglu, zglv, zgui, zgvi )214 209 ! 215 210 IF( kt == kit000 .AND. lwp ) THEN … … 253 248 END SELECT 254 249 ! 255 CALL wrk_dealloc( jpi,jpj,jpk,kjpt, zlap )256 CALL wrk_dealloc( jpi,jpj ,kjpt, zglu, zglv, zgui, zgvi )257 250 ! 258 251 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_blp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r7646 r7910 27 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory Allocation30 29 USE timing ! Timing 31 30 … … 94 93 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 95 94 REAL(wp) :: zah, zah_slp, zaei_slp 96 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ! 3D -95 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 96 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ! 3D - 98 97 !!---------------------------------------------------------------------- 99 98 ! 100 99 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_triad') 101 100 ! 102 CALL wrk_alloc( jpi,jpj, z2d )103 CALL wrk_alloc( jpi,jpj,jpk, zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw )104 101 ! 105 102 IF( .NOT.ALLOCATED(zdkt3d) ) THEN … … 435 432 ! ! =============== 436 433 ! 437 CALL wrk_dealloc( jpi,jpj, z2d )438 CALL wrk_dealloc( jpi,jpj,jpk, zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw )439 434 ! 440 435 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_triad') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
r6140 r7910 26 26 USE in_out_manager ! I/O manager 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! Memory Allocation29 28 USE timing ! Timing 30 29 … … 68 67 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 69 68 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0) 70 REAL(wp), POINTER, DIMENSION(:) :: zvn2 ! vertical profile of N2 at 1 given point...71 REAL(wp), POINTER, DIMENSION(:,:) :: zvts ! vertical profile of T and S at 1 given point...72 REAL(wp), POINTER, DIMENSION(:,:) :: zvab ! vertical profile of alpha and beta73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zn2 ! N^274 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zab ! alpha and beta75 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace69 REAL(wp), DIMENSION(jpk) :: zvn2 ! vertical profile of N2 at 1 given point... 70 REAL(wp), DIMENSION(jpk,2) :: zvts ! vertical profile of T and S at 1 given point... 71 REAL(wp), DIMENSION(jpk,2) :: zvab ! vertical profile of alpha and beta 72 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zn2 ! N^2 73 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zab ! alpha and beta 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds ! 3D workspace 76 75 ! 77 76 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is … … 84 83 IF( MOD( kt, nn_npc ) == 0 ) THEN 85 84 ! 86 CALL wrk_alloc( jpi, jpj, jpk, zn2 ) ! N287 CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta88 CALL wrk_alloc( jpk, 2, zvts, zvab ) ! 1D column vector at point ji,jj89 CALL wrk_alloc( jpk, zvn2 ) ! 1D column vector at point ji,jj90 85 91 86 IF( l_trdtra ) THEN !* Save initial after fields 92 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )93 87 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 94 88 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 313 307 CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 314 308 CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 315 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )316 309 ENDIF 317 310 ! … … 323 316 ENDIF 324 317 ! 325 CALL wrk_dealloc(jpi, jpj, jpk, zn2 )326 CALL wrk_dealloc(jpi, jpj, jpk, 2, zab )327 CALL wrk_dealloc(jpk, zvn2 )328 CALL wrk_dealloc(jpk, 2, zvts, zvab )329 318 ! 330 319 ENDIF ! IF( MOD( kt, nn_npc ) == 0 ) THEN -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r7753 r7910 43 43 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 44 44 USE prtctl ! Print control 45 USE wrk_nemo ! Memory allocation46 45 USE timing ! Timing 47 46 #if defined key_agrif … … 91 90 INTEGER :: ji, jj, jk, jn ! dummy loop indices 92 91 REAL(wp) :: zfact ! local scalars 93 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds 94 93 !!---------------------------------------------------------------------- 95 94 ! … … 120 119 ! trends computation initialisation 121 120 IF( l_trdtra ) THEN 122 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )123 121 ztrdt(:,:,jk) = 0._wp 124 122 ztrds(:,:,jk) = 0._wp … … 170 168 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 171 169 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 172 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )173 170 END IF 174 171 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r7753 r7910 34 34 USE lib_mpp ! MPP library 35 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 USE wrk_nemo ! Memory Allocation37 36 USE timing ! Timing 38 37 … … 113 112 REAL(wp) :: zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 114 113 REAL(wp) :: zlogc, zlogc2, zlogc3 115 REAL(wp), POINTER, DIMENSION(:,:) :: zekb, zekg, zekr116 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt117 REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d114 REAL(wp), DIMENSION(jpi,jpj) :: zekb, zekg, zekr 115 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze0, ze1, ze2, ze3, zea, ztrdt 116 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zetot, zchl3d 118 117 !!---------------------------------------------------------------------- 119 118 ! … … 127 126 ! 128 127 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 CALL wrk_alloc( jpi,jpj,jpk, ztrdt )130 128 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 131 129 ENDIF … … 161 159 CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==! 162 160 ! 163 CALL wrk_alloc( jpi,jpj, zekb, zekg, zekr )164 CALL wrk_alloc( jpi,jpj,jpk, ze0, ze1, ze2, ze3, zea, zchl3d )165 161 ! 166 162 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll … … 240 236 END DO 241 237 ! 242 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr )243 CALL wrk_dealloc( jpi,jpj,jpk, ze0, ze1, ze2, ze3, zea, zchl3d )244 238 ! 245 239 CASE( np_2BD ) !== 2-bands fluxes ==! … … 282 276 ! 283 277 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 284 CALL wrk_alloc( jpi,jpj,jpk, zetot )285 278 ! 286 279 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero … … 290 283 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 291 284 ! 292 CALL wrk_dealloc( jpi,jpj,jpk, zetot )293 285 ENDIF 294 286 ! … … 301 293 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 302 294 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 303 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt )304 295 ENDIF 305 296 ! ! print mean trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r7788 r7910 32 32 USE iom ! xIOS server 33 33 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 34 USE wrk_nemo ! Memory Allocation35 34 USE timing ! Timing 36 35 … … 75 74 INTEGER :: ikt, ikb ! local integers 76 75 REAL(wp) :: zfact, z1_e3t, zdep ! local scalar 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds 78 77 !!---------------------------------------------------------------------- 79 78 ! … … 87 86 ! 88 87 IF( l_trdtra ) THEN !* Save ta and sa trends 89 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )90 88 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 91 89 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 232 230 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 233 231 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 234 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )235 232 ENDIF 236 233 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r7753 r7910 29 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 30 USE lib_mpp ! MPP library 31 USE wrk_nemo ! Memory allocation32 31 USE timing ! Timing 33 32 … … 59 58 ! 60 59 INTEGER :: jk ! Dummy loop indices 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds ! 3D workspace 62 61 !!--------------------------------------------------------------------- 63 62 ! … … 71 70 ! 72 71 IF( l_trdtra ) THEN !* Save ta and sa trends 73 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )74 72 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 75 73 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 98 96 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 99 97 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 100 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )101 98 ENDIF 102 99 ! ! print mean trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r6140 r7910 32 32 USE in_out_manager ! I/O manager 33 33 USE lib_mpp ! MPP library 34 USE wrk_nemo ! Memory Allocation35 34 USE timing ! Timing 36 35 … … 84 83 REAL(wp) :: z1_ksts, ze3tr ! local scalars 85 84 REAL(wp) :: ztra, ze3tb ! - - 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztb, zwf85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztb, zwf 87 86 !!--------------------------------------------------------------------- 88 87 ! 89 88 IF( nn_timing == 1 ) CALL timing_start('tra_zdf_exp') 90 89 ! 91 CALL wrk_alloc( jpi,jpj,jpk, ztb, zwf )92 90 ! 93 91 IF( kt == kit000 ) THEN … … 144 142 END DO ! end of tracer loop 145 143 ! 146 CALL wrk_dealloc( jpi,jpj,jpk, ztb, zwf )147 144 ! 148 145 IF( nn_timing == 1 ) CALL timing_stop('tra_zdf_exp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r7753 r7910 35 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 36 USE lib_mpp ! MPP library 37 USE wrk_nemo ! Memory Allocation38 37 USE timing ! Timing 39 38 … … 83 82 INTEGER :: ji, jj, jk, jn ! dummy loop indices 84 83 REAL(wp) :: zrhs ! local scalars 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwt, zwd, zws84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwt, zwd, zws 86 85 !!--------------------------------------------------------------------- 87 86 ! 88 87 IF( nn_timing == 1 ) CALL timing_start('tra_zdf_imp') 89 88 ! 90 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwt, zwd, zws )91 89 ! 92 90 IF( kt == kit000 ) THEN … … 208 206 ! ! ================= ! 209 207 ! 210 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwt, zwd, zws )211 208 ! 212 209 IF( nn_timing == 1 ) CALL timing_stop('tra_zdf_imp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r6140 r7910 28 28 USE iom ! I/O manager library 29 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! Memory allocation31 30 32 31 IMPLICIT NONE … … 103 102 INTEGER :: ji, jj, jk ! dummy loop indices 104 103 INTEGER :: ikbu, ikbv ! local integers 105 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace106 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace104 REAL(wp), DIMENSION(jpi,jpj) :: z2dx, z2dy ! 2D workspace 105 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3dx, z3dy ! 3D workspace 107 106 !!---------------------------------------------------------------------- 108 107 ! … … 118 117 CASE( jpdyn_keg ) ; CALL iom_put( "utrd_keg", putrd ) ! Kinetic Energy gradient (or had) 119 118 CALL iom_put( "vtrd_keg", pvtrd ) 120 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )121 119 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 122 120 z3dy(:,:,:) = 0._wp … … 133 131 CALL iom_put( "utrd_udx", z3dx ) 134 132 CALL iom_put( "vtrd_vdy", z3dy ) 135 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )136 133 CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical advection 137 134 CALL iom_put( "vtrd_zad", pvtrd ) … … 141 138 CALL iom_put( "vtrd_zdf", pvtrd ) 142 139 ! ! wind stress trends 143 CALL wrk_alloc( jpi, jpj, z2dx, z2dy )144 140 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 145 141 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 146 142 CALL iom_put( "utrd_tau", z2dx ) 147 143 CALL iom_put( "vtrd_tau", z2dy ) 148 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )149 144 CASE( jpdyn_bfr ) ! called if ln_bfrimp=T 150 145 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) … … 153 148 CALL iom_put( "vtrd_atf", pvtrd ) 154 149 CASE( jpdyn_bfri ) ; IF( ln_bfrimp ) THEN ! bottom friction (implicit case) 155 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )156 150 z3dx(:,:,:) = 0._wp ; z3dy(:,:,:) = 0._wp ! after velocity known (now filed at this stage) 157 151 DO jk = 1, jpkm1 … … 168 162 CALL iom_put( "utrd_bfri", z3dx ) 169 163 CALL iom_put( "vtrd_bfri", z3dy ) 170 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )171 164 ENDIF 172 165 END SELECT -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r6140 r7910 30 30 USE in_out_manager ! I/O manager 31 31 USE iom ! I/O manager library 32 USE wrk_nemo ! Memory allocation33 32 34 33 IMPLICIT NONE … … 78 77 INTEGER :: ikbu, ikbv ! local integers 79 78 REAL(wp):: zvm, zvt, zvs, z1_2rau0 ! local scalars 80 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 81 !!---------------------------------------------------------------------- 82 83 CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 79 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 80 !!---------------------------------------------------------------------- 81 84 82 85 83 IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN … … 179 177 ENDIF 180 178 ! 181 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )182 179 ! 183 180 END SUBROUTINE trd_glo … … 194 191 INTEGER :: ji, jj, jk ! dummy loop indices 195 192 REAL(wp) :: zcof ! local scalar 196 REAL(wp), POINTER, DIMENSION(:,:,:) :: zkx, zky, zkz, zkepe 197 !!---------------------------------------------------------------------- 198 199 CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe ) 193 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkx, zky, zkz, zkepe 194 !!---------------------------------------------------------------------- 195 200 196 201 197 ! I. Momentum trends … … 373 369 ENDIF 374 370 ! 375 CALL wrk_dealloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )376 371 ! 377 372 END SUBROUTINE glo_dyn_wri -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r7646 r7910 27 27 USE iom ! I/O manager library 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory allocation30 29 USE ldfslp ! Isopycnal slopes 31 30 … … 86 85 INTEGER :: ikbu , ikbv ! local integers 87 86 INTEGER :: ikbum1, ikbvm1 ! - - 88 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy, zke2d ! 2D workspace 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zke ! 3D workspace 90 !!---------------------------------------------------------------------- 91 ! 92 CALL wrk_alloc( jpi, jpj, jpk, zke ) 87 REAL(wp), DIMENSION(jpi,jpj) :: z2dx, z2dy, zke2d ! 2D workspace 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zke ! 3D workspace 89 !!---------------------------------------------------------------------- 90 ! 93 91 ! 94 92 CALL lbc_lnk( putrd, 'U', -1. ) ; CALL lbc_lnk( pvtrd, 'V', -1. ) ! lateral boundary conditions … … 125 123 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion 126 124 ! ! ! wind stress trends 127 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )128 125 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 129 126 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) … … 136 133 END DO 137 134 CALL iom_put( "ketrd_tau" , zke2d ) ! 138 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d )139 135 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case) 140 136 !!gm TO BE DONE properly … … 192 188 END SELECT 193 189 ! 194 CALL wrk_dealloc( jpi, jpj, jpk, zke )195 190 ! 196 191 END SUBROUTINE trd_ken … … 214 209 INTEGER :: iku, ikv ! temporary integers 215 210 REAL(wp) :: zcoef ! temporary scalars 216 REAL(wp), POINTER, DIMENSION(:,:,:) :: zconv ! temporary conv on W-grid 217 !!---------------------------------------------------------------------- 218 ! 219 CALL wrk_alloc( jpi,jpj,jpk, zconv ) 211 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zconv ! temporary conv on W-grid 212 !!---------------------------------------------------------------------- 213 ! 220 214 ! 221 215 ! Local constant initialization … … 240 234 END DO 241 235 ! 242 CALL wrk_dealloc( jpi,jpj,jpk, zconv )243 236 ! 244 237 END SUBROUTINE ken_p2k -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r6140 r7910 37 37 USE restart ! for lrst_oce 38 38 USE lib_mpp ! MPP library 39 USE wrk_nemo ! Memory allocation40 39 USE iom 41 40 … … 256 255 ! 257 256 INTEGER :: ji, jj, jk, isum 258 REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk 259 !!---------------------------------------------------------------------- 260 261 CALL wrk_alloc( jpi, jpj, zvlmsk ) 257 REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk 258 !!---------------------------------------------------------------------- 259 262 260 263 261 ! I. Definition of control surface and associated fields … … 284 282 END IF 285 283 ! 286 CALL wrk_dealloc( jpi, jpj, zvlmsk )287 284 ! 288 285 END SUBROUTINE trd_mxl_zint … … 342 339 ! ! z(ts)mltot : dT/dt over the anlysis window (including Asselin) 343 340 ! ! z(ts)mlres : residual = dh/dt entrainment term 344 REAL(wp), POINTER, DIMENSION(:,:) :: ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf345 REAL(wp), POINTER, DIMENSION(:,:) :: ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2346 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics341 REAL(wp), DIMENSION(jpi,jpj) :: ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf 342 REAL(wp), DIMENSION(jpi,jpj) :: ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 343 REAL(wp), DIMENSION(jpi,jpj,jpltrd) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 347 344 !!---------------------------------------------------------------------- 348 345 349 CALL wrk_alloc( jpi, jpj, ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf )350 CALL wrk_alloc( jpi, jpj, ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 )351 CALL wrk_alloc( jpi, jpj, jpltrd, ztmltrd2, zsmltrd2 )352 346 353 347 ! ====================================================================== … … 724 718 IF( lrst_oce ) CALL trd_mxl_rst_write( kt ) 725 719 726 CALL wrk_dealloc( jpi, jpj, ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf )727 CALL wrk_dealloc( jpi, jpj, ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 )728 CALL wrk_dealloc( jpi, jpj, jpltrd, ztmltrd2, zsmltrd2 )729 720 ! 730 721 END SUBROUTINE trd_mxl -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r6140 r7910 24 24 USE iom ! I/O manager library 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! Memory allocation27 26 28 27 IMPLICIT NONE … … 71 70 ! 72 71 INTEGER :: jk ! dummy loop indices 73 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpe ! 3D workspace72 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpe ! 3D workspace 75 74 !!---------------------------------------------------------------------- 76 75 ! 77 CALL wrk_alloc( jpi, jpj, jpk, zpe )78 76 zpe(:,:,:) = 0._wp 79 77 ! … … 97 95 CASE ( jptra_zad ) ; CALL iom_put( "petrd_zad", zpe ) ! vertical advection 98 96 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 99 CALL wrk_alloc( jpi, jpj, z2d )100 97 z2d(:,:) = wn(:,:,1) * ( & 101 98 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem) & … … 103 100 & ) / e3t_n(:,:,1) 104 101 CALL iom_put( "petrd_sad" , z2d ) 105 CALL wrk_dealloc( jpi, jpj, z2d )106 102 ENDIF 107 103 CASE ( jptra_ldf ) ; CALL iom_put( "petrd_ldf" , zpe ) ! lateral diffusion … … 116 112 CASE ( jptra_atf ) ; CALL iom_put( "petrd_atf" , zpe ) ! asselin time filter (last trend) 117 113 !IF( ln_linssh ) THEN ! cst volume : ssh term (otherwise include in e3t variation) 118 ! CALL wrk_alloc( jpi, jpj, z2d )119 114 ! z2d(:,:) = ( ssha(:,:) - sshb(:,:) ) & 120 115 ! & * ( dPE_dt(:,:,1) * tsn(:,:,1,jp_tem) & 121 116 ! & + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal) ) / ( e3t_n(:,:,1) * pdt ) 122 117 ! CALL iom_put( "petrd_sad" , z2d ) 123 ! CALL wrk_dealloc( jpi, jpj, z2d )124 118 !ENDIF 125 119 ! 126 120 END SELECT 127 121 ! 128 CALL wrk_dealloc( jpi, jpj, jpk, zpe )129 122 ! 130 123 END SUBROUTINE trd_pen -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r7646 r7910 31 31 USE iom ! I/O manager library 32 32 USE lib_mpp ! MPP library 33 USE wrk_nemo ! Memory allocation34 33 35 34 IMPLICIT NONE … … 84 83 ! 85 84 INTEGER :: jk ! loop indices 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwt, zws, ztrdt, ztrds ! 3D workspace 87 !!---------------------------------------------------------------------- 88 ! 89 CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwt, zws, ztrdt, ztrds ! 3D workspace 86 !!---------------------------------------------------------------------- 87 ! 90 88 ! 91 89 IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays … … 123 121 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 124 122 ! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 125 CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt )126 123 ! 127 124 zwt(:,:, 1 ) = 0._wp ; zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes … … 153 150 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt ) 154 151 ! 155 CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt )156 152 ! 157 153 CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng … … 176 172 ENDIF 177 173 ! 178 CALL wrk_dealloc( jpi, jpj, jpk, ztrds )179 174 ! 180 175 END SUBROUTINE trd_tra … … 306 301 INTEGER :: ji, jj, jk ! dummy loop indices 307 302 INTEGER :: ikbu, ikbv ! local integers 308 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace303 REAL(wp), DIMENSION(jpi,jpj) :: z2dx, z2dy ! 2D workspace 309 304 !!---------------------------------------------------------------------- 310 305 ! … … 319 314 CALL iom_put( "strd_zad" , ptrdy ) 320 315 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 321 CALL wrk_alloc( jpi, jpj, z2dx, z2dy )322 316 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 323 317 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 324 318 CALL iom_put( "ttrd_sad", z2dx ) 325 319 CALL iom_put( "strd_sad", z2dy ) 326 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )327 320 ENDIF 328 321 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad" , ptrdx ) ! total advection -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r6140 r7910 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! Memory allocation31 30 32 31 IMPLICIT NONE … … 91 90 ! 92 91 INTEGER :: ji, jj ! dummy loop indices 93 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv ! 2D workspace 94 !!---------------------------------------------------------------------- 95 96 CALL wrk_alloc( jpi, jpj, ztswu, ztswv ) 92 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv ! 2D workspace 93 !!---------------------------------------------------------------------- 94 97 95 98 96 SELECT CASE( ktrd ) … … 122 120 END SELECT 123 121 ! 124 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv )125 122 ! 126 123 END SUBROUTINE trd_vor … … 160 157 INTEGER :: ji, jj ! dummy loop indices 161 158 INTEGER :: ikbu, ikbv ! local integers 162 REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends 163 !!---------------------------------------------------------------------- 164 165 ! 166 CALL wrk_alloc( jpi, jpj, zudpvor, zvdpvor ) ! Memory allocation 159 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 160 !!---------------------------------------------------------------------- 161 162 ! 167 163 ! 168 164 … … 211 207 ENDIF 212 208 ! 213 CALL wrk_dealloc( jpi, jpj, zudpvor, zvdpvor )214 209 ! 215 210 END SUBROUTINE trd_vor_zint_2d … … 249 244 ! 250 245 INTEGER :: ji, jj, jk ! dummy loop indices 251 REAL(wp), POINTER, DIMENSION(:,:) :: zubet , zvbet ! Beta.V252 REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends246 REAL(wp), DIMENSION(jpi,jpj) :: zubet , zvbet ! Beta.V 247 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 253 248 !!---------------------------------------------------------------------- 254 249 255 CALL wrk_alloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )256 250 257 251 ! Initialization … … 307 301 ENDIF 308 302 ! 309 CALL wrk_dealloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )310 303 ! 311 304 END SUBROUTINE trd_vor_zint_3d … … 324 317 INTEGER :: it, itmod ! local integers 325 318 REAL(wp) :: zmean ! local scalars 326 REAL(wp), POINTER, DIMENSION(:,:) :: zun, zvn 327 !!---------------------------------------------------------------------- 328 329 CALL wrk_alloc( jpi, jpj, zun, zvn ) 319 REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn 320 !!---------------------------------------------------------------------- 321 330 322 331 323 ! ================= … … 460 452 IF( kt == nitend ) CALL histclo( nidvor ) 461 453 ! 462 CALL wrk_dealloc( jpi, jpj, zun, zvn )463 454 ! 464 455 END SUBROUTINE trd_vor_iom -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r7753 r7910 24 24 USE prtctl ! Print control 25 25 USE timing ! Timing 26 USE wrk_nemo ! Memory Allocation27 26 USE phycst, ONLY: vkarmn 28 27 … … 95 94 INTEGER :: ikbt, ikbu, ikbv ! local integers 96 95 REAL(wp) :: zvu, zuv, zecu, zecv, ztmp ! temporary scalars 97 REAL(wp), POINTER, DIMENSION(:,:) :: zbfrt, ztfrt96 REAL(wp), DIMENSION(jpi,jpj) :: zbfrt, ztfrt 98 97 !!---------------------------------------------------------------------- 99 98 ! … … 102 101 IF( nn_bfr == 2 ) THEN ! quadratic bottom friction only 103 102 ! 104 CALL wrk_alloc( jpi, jpj, zbfrt, ztfrt )105 103 106 104 IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient … … 203 201 IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr - u: ', mask1=umask, & 204 202 & tab2d_2=bfrva, clinfo2= ' v: ', mask2=vmask,ovlap=1 ) 205 CALL wrk_dealloc( jpi,jpj,zbfrt, ztfrt )206 203 ENDIF 207 204 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r7753 r7910 25 25 USE prtctl ! Print control 26 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays28 27 USE timing ! Timing 29 28 … … 100 99 REAL(wp) :: zavft, zavfs ! - - 101 100 REAL(wp) :: zavdt, zavds ! - - 102 REAL(wp), POINTER, DIMENSION(:,:) :: zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3101 REAL(wp), DIMENSION(jpi,jpj) :: zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 103 102 !!---------------------------------------------------------------------- 104 103 ! 105 104 IF( nn_timing == 1 ) CALL timing_start('zdf_ddm') 106 105 ! 107 CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )108 106 ! 109 107 ! ! =============== … … 215 213 ENDIF 216 214 ! 217 CALL wrk_dealloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )218 215 ! 219 216 IF( nn_timing == 1 ) CALL timing_stop('zdf_ddm') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r7753 r7910 23 23 USE iom ! for iom_put 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 USE wrk_nemo ! work arrays26 25 USE timing ! Timing 27 26 … … 56 55 ! 57 56 INTEGER :: ji, jj, jk ! dummy loop indices 58 REAL(wp), POINTER, DIMENSION(:,:,:) :: zavt_evd, zavm_evd57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zavt_evd, zavm_evd 59 58 !!---------------------------------------------------------------------- 60 59 ! … … 68 67 ENDIF 69 68 ! 70 CALL wrk_alloc( jpi,jpj,jpk, zavt_evd, zavm_evd )71 69 ! 72 70 zavt_evd(:,:,:) = avt(:,:,:) ! set avt prior to evd application … … 115 113 IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 116 114 ! 117 CALL wrk_dealloc( jpi,jpj,jpk, zavt_evd, zavm_evd )118 115 ! 119 116 IF( nn_timing == 1 ) CALL timing_stop('zdf_evd') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r7646 r7910 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 29 USE lib_mpp ! MPP manager 30 USE wrk_nemo ! work arrays31 30 USE prtctl ! Print control 32 31 USE in_out_manager ! I/O manager … … 138 137 REAL(wp) :: prod, buoy, diss, zdiss, sm ! - - 139 138 REAL(wp) :: gh, gm, shr, dif, zsqen, zav ! - - 140 REAL(wp), POINTER, DIMENSION(:,:) :: zdep141 REAL(wp), POINTER, DIMENSION(:,:) :: zkar142 REAL(wp), POINTER, DIMENSION(:,:) :: zflxs ! Turbulence fluxed induced by internal waves143 REAL(wp), POINTER, DIMENSION(:,:) :: zhsro ! Surface roughness (surface waves)144 REAL(wp), POINTER, DIMENSION(:,:,:) :: eb ! tke at time before145 REAL(wp), POINTER, DIMENSION(:,:,:) :: mxlb ! mixing length at time before146 REAL(wp), POINTER, DIMENSION(:,:,:) :: shear ! vertical shear147 REAL(wp), POINTER, DIMENSION(:,:,:) :: eps ! dissipation rate148 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi)149 REAL(wp), POINTER, DIMENSION(:,:,:) :: psi ! psi at time now150 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_a ! element of the first matrix diagonal151 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_b ! element of the second matrix diagonal152 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_c ! element of the third matrix diagonal139 REAL(wp), DIMENSION(jpi,jpj) :: zdep 140 REAL(wp), DIMENSION(jpi,jpj) :: zkar 141 REAL(wp), DIMENSION(jpi,jpj) :: zflxs ! Turbulence fluxed induced by internal waves 142 REAL(wp), DIMENSION(jpi,jpj) :: zhsro ! Surface roughness (surface waves) 143 REAL(wp), DIMENSION(jpi,jpj,jpk) :: eb ! tke at time before 144 REAL(wp), DIMENSION(jpi,jpj,jpk) :: mxlb ! mixing length at time before 145 REAL(wp), DIMENSION(jpi,jpj,jpk) :: shear ! vertical shear 146 REAL(wp), DIMENSION(jpi,jpj,jpk) :: eps ! dissipation rate 147 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi) 148 REAL(wp), DIMENSION(jpi,jpj,jpk) :: psi ! psi at time now 149 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_elem_a ! element of the first matrix diagonal 150 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_elem_b ! element of the second matrix diagonal 151 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_elem_c ! element of the third matrix diagonal 153 152 !!-------------------------------------------------------------------- 154 153 ! 155 154 IF( nn_timing == 1 ) CALL timing_start('zdf_gls') 156 155 ! 157 CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )158 CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )159 156 160 157 ! Preliminary computing … … 824 821 avmv_k(:,:,:) = avmv(:,:,:) 825 822 ! 826 CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro )827 CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )828 823 ! 829 824 IF( nn_timing == 1 ) CALL timing_stop('zdf_gls') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r7753 r7910 20 20 USE iom ! I/O library 21 21 USE lib_mpp ! MPP library 22 USE wrk_nemo ! work arrays23 22 USE timing ! Timing 24 23 … … 80 79 INTEGER :: iikn, iiki, ikt ! local integer 81 80 REAL(wp) :: zN2_c ! local scalar 82 INTEGER, POINTER, DIMENSION(:,:) :: imld ! 2D workspace81 INTEGER, DIMENSION(jpi,jpj) :: imld ! 2D workspace 83 82 !!---------------------------------------------------------------------- 84 83 ! 85 84 IF( nn_timing == 1 ) CALL timing_start('zdf_mxl') 86 85 ! 87 CALL wrk_alloc( jpi,jpj, imld )88 86 89 87 IF( kt == nit000 ) THEN … … 144 142 IF(ln_ctl) CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 145 143 ! 146 CALL wrk_dealloc( jpi,jpj, imld )147 144 ! 148 145 IF( nn_timing == 1 ) CALL timing_stop('zdf_mxl') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r7646 r7910 27 27 USE lbclnk ! ocean lateral boundary condition (or mpp link) 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays30 29 USE timing ! Timing 31 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 121 120 REAL(wp) :: zcoef, zdku, zdkv, zri, z05alp, zflageos ! temporary scalars 122 121 REAL(wp) :: zrhos, zustar 123 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, ekm_dep122 REAL(wp), DIMENSION(jpi,jpj) :: zwx, ekm_dep 124 123 !!---------------------------------------------------------------------- 125 124 ! 126 125 IF( nn_timing == 1 ) CALL timing_start('zdf_ric') 127 126 ! 128 CALL wrk_alloc( jpi,jpj, zwx, ekm_dep )129 127 ! ! =============== 130 128 DO jk = 2, jpkm1 ! Horizontal slab … … 229 227 CALL lbc_lnk( avmu, 'U', 1. ) ; CALL lbc_lnk( avmv, 'V', 1. ) 230 228 ! 231 CALL wrk_dealloc( jpi,jpj, zwx, ekm_dep )232 229 ! 233 230 IF( nn_timing == 1 ) CALL timing_stop('zdf_ric') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r7813 r7910 50 50 USE iom ! I/O manager library 51 51 USE lib_mpp ! MPP library 52 USE wrk_nemo ! work arrays53 52 USE timing ! Timing 54 53 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 231 230 REAL(wp) :: zzd_up, zzd_lw ! - - 232 231 !!bfr REAL(wp) :: zebot ! - - 233 INTEGER , POINTER, DIMENSION(:,:) :: imlc234 REAL(wp), POINTER, DIMENSION(:,:) :: zhlc235 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv232 INTEGER , DIMENSION(jpi,jpj) :: imlc 233 REAL(wp), DIMENSION(jpi,jpj) :: zhlc 234 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv 236 235 REAL(wp) :: zri ! local Richardson number 237 236 !!-------------------------------------------------------------------- … … 239 238 IF( nn_timing == 1 ) CALL timing_start('tke_tke') 240 239 ! 241 CALL wrk_alloc( jpi,jpj, imlc ) ! integer242 CALL wrk_alloc( jpi,jpj, zhlc )243 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )244 240 ! 245 241 zbbrau = rn_ebb / rau0 ! Local constant initialisation … … 483 479 CALL lbc_lnk( en, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 484 480 ! 485 CALL wrk_dealloc( jpi,jpj, imlc ) ! integer486 CALL wrk_dealloc( jpi,jpj, zhlc )487 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )488 481 ! 489 482 IF( nn_timing == 1 ) CALL timing_stop('tke_tke') … … 531 524 REAL(wp) :: zdku, zri, zsqen ! - - 532 525 REAL(wp) :: zdkv, zemxl, zemlm, zemlp ! - - 533 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld526 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmpdl, zmxlm, zmxld 534 527 !!-------------------------------------------------------------------- 535 528 ! 536 529 IF( nn_timing == 1 ) CALL timing_start('tke_avn') 537 530 538 CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )539 531 540 532 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 701 693 ENDIF 702 694 ! 703 CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )704 695 ! 705 696 IF( nn_timing == 1 ) CALL timing_stop('tke_avn') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r7779 r7910 25 25 USE iom ! I/O Manager 26 26 USE lib_mpp ! MPP library 27 USE wrk_nemo ! work arrays28 27 USE timing ! Timing 29 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 108 107 INTEGER :: ji, jj, jk ! dummy loop indices 109 108 REAL(wp) :: ztpc ! scalar workspace 110 REAL(wp), POINTER, DIMENSION(:,:) :: zkz111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zav_tide109 REAL(wp), DIMENSION(jpi,jpj) :: zkz 110 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zav_tide 112 111 !!---------------------------------------------------------------------- 113 112 ! 114 113 IF( nn_timing == 1 ) CALL timing_start('zdf_tmx') 115 114 ! 116 CALL wrk_alloc( jpi,jpj, zkz )117 CALL wrk_alloc( jpi,jpj,jpk, zav_tide )118 115 ! 119 116 ! ! ----------------------- ! … … 179 176 IF(ln_ctl) CALL prt_ctl(tab3d_1=zav_tide , clinfo1=' tmx - av_tide: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) 180 177 ! 181 CALL wrk_dealloc( jpi,jpj, zkz )182 CALL wrk_dealloc( jpi,jpj,jpk, zav_tide )183 178 ! 184 179 IF( nn_timing == 1 ) CALL timing_stop('zdf_tmx') … … 212 207 INTEGER :: ji, jj, jk ! dummy loop indices 213 208 REAL(wp) :: zcoef, ztpc ! temporary scalar 214 REAL(wp), DIMENSION( :,:) , POINTER:: zkz ! 2D workspace215 REAL(wp), DIMENSION( :,:) , POINTER:: zsum1 , zsum2 , zsum ! - -216 REAL(wp), DIMENSION( :,:,:), POINTER:: zempba_3d_1, zempba_3d_2 ! 3D workspace217 REAL(wp), DIMENSION( :,:,:), POINTER:: zempba_3d , zdn2dz ! - -218 REAL(wp), DIMENSION( :,:,:), POINTER:: zavt_itf ! - -209 REAL(wp), DIMENSION(jpi,jpj) :: zkz ! 2D workspace 210 REAL(wp), DIMENSION(jpi,jpj) :: zsum1 , zsum2 , zsum ! - - 211 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zempba_3d_1, zempba_3d_2 ! 3D workspace 212 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zempba_3d , zdn2dz ! - - 213 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zavt_itf ! - - 219 214 !!---------------------------------------------------------------------- 220 215 ! 221 216 IF( nn_timing == 1 ) CALL timing_start('tmx_itf') 222 217 ! 223 CALL wrk_alloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum )224 CALL wrk_alloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf )225 218 226 219 ! ! compute the form function using N2 at each time step … … 308 301 END DO 309 302 ! 310 CALL wrk_dealloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum )311 CALL wrk_dealloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf )312 303 ! 313 304 IF( nn_timing == 1 ) CALL timing_stop('tmx_itf') … … 355 346 INTEGER :: ios 356 347 REAL(wp) :: ztpc, ze_z ! local scalars 357 REAL(wp), DIMENSION( :,:) , POINTER:: zem2, zek1 ! read M2 and K1 tidal energy358 REAL(wp), DIMENSION( :,:) , POINTER:: zkz ! total M2, K1 and S2 tidal energy359 REAL(wp), DIMENSION( :,:) , POINTER:: zfact ! used for vertical structure function360 REAL(wp), DIMENSION( :,:) , POINTER:: zhdep ! Ocean depth361 REAL(wp), DIMENSION( :,:,:), POINTER:: zpc, zav_tide ! power consumption348 REAL(wp), DIMENSION(jpi,jpj) :: zem2, zek1 ! read M2 and K1 tidal energy 349 REAL(wp), DIMENSION(jpi,jpj) :: zkz ! total M2, K1 and S2 tidal energy 350 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! used for vertical structure function 351 REAL(wp), DIMENSION(jpi,jpj) :: zhdep ! Ocean depth 352 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpc, zav_tide ! power consumption 362 353 !! 363 354 NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf … … 366 357 IF( nn_timing == 1 ) CALL timing_start('zdf_tmx_init') 367 358 ! 368 CALL wrk_alloc( jpi,jpj, zem2, zek1, zkz, zfact, zhdep )369 CALL wrk_alloc( jpi,jpj,jpk, zpc, zav_tide )370 359 ! 371 360 REWIND( numnam_ref ) ! Namelist namzdf_tmx in reference namelist : Tidal Mixing … … 534 523 ENDIF 535 524 ! 536 CALL wrk_dealloc( jpi,jpj, zem2, zek1, zkz, zfact, zhdep )537 CALL wrk_dealloc( jpi,jpj,jpk, zpc, zav_tide )538 525 ! 539 526 IF( nn_timing == 1 ) CALL timing_stop('zdf_tmx_init') … … 559 546 USE iom ! I/O Manager 560 547 USE lib_mpp ! MPP library 561 USE wrk_nemo ! work arrays562 548 USE timing ! Timing 563 549 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 669 655 INTEGER :: ji, jj, jk ! dummy loop indices 670 656 REAL(wp) :: ztpc ! scalar workspace 671 REAL(wp), DIMENSION( :,:) , POINTER:: zfact ! Used for vertical structure672 REAL(wp), DIMENSION( :,:) , POINTER:: zhdep ! Ocean depth673 REAL(wp), DIMENSION( :,:,:), POINTER:: zwkb ! WKB-stretched height above bottom674 REAL(wp), DIMENSION( :,:,:), POINTER:: zweight ! Weight for high mode vertical distribution675 REAL(wp), DIMENSION( :,:,:), POINTER:: znu_t ! Molecular kinematic viscosity (T grid)676 REAL(wp), DIMENSION( :,:,:), POINTER:: znu_w ! Molecular kinematic viscosity (W grid)677 REAL(wp), DIMENSION( :,:,:), POINTER:: zReb ! Turbulence intensity parameter657 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! Used for vertical structure 658 REAL(wp), DIMENSION(jpi,jpj) :: zhdep ! Ocean depth 659 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwkb ! WKB-stretched height above bottom 660 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zweight ! Weight for high mode vertical distribution 661 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znu_t ! Molecular kinematic viscosity (T grid) 662 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znu_w ! Molecular kinematic viscosity (W grid) 663 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zReb ! Turbulence intensity parameter 678 664 !!---------------------------------------------------------------------- 679 665 ! 680 666 IF( nn_timing == 1 ) CALL timing_start('zdf_tmx') 681 667 ! 682 CALL wrk_alloc( jpi,jpj, zfact, zhdep )683 CALL wrk_alloc( jpi,jpj,jpk, zwkb, zweight, znu_t, znu_w, zReb )684 668 685 669 ! ! ----------------------------- ! … … 900 884 CALL iom_put( "emix_tmx", emix_tmx ) 901 885 902 CALL wrk_dealloc( jpi,jpj, zfact, zhdep )903 CALL wrk_dealloc( jpi,jpj,jpk, zwkb, zweight, znu_t, znu_w, zReb )904 886 905 887 IF(ln_ctl) CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' tmx - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/C14/trcatm_c14.F90
r7192 r7910 45 45 REAL(wp) :: yn20 = 20. ! 20 degrees north 46 46 REAL(wp) :: yn40 = 40. ! 40 degrees north 47 REAL(wp), POINTER, DIMENSION(:) :: zco2, zyrco2 ! temporary arrays for swap47 REAL(wp), DIMENSION(nrecco2) :: zco2, zyrco2 ! temporary arrays for swap 48 48 ! 49 49 !!---------------------------------------------------------------------- … … 78 78 ! 79 79 IF(kc14typ==2) THEN 80 CALL wrk_alloc( nrecco2,zco2)81 CALL wrk_alloc( nrecco2,zyrco2)82 80 zco2(:)=spco2(:) 83 81 zyrco2(:)=tyrco2(:) … … 88 86 tyrco2(izco2)=1950._wp-zyrco2(jn) ! BP to AD dates 89 87 END DO 90 CALL wrk_dealloc(nrecco2,zco2)91 CALL wrk_dealloc(nrecco2,zyrco2)92 88 ENDIF 93 89 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/C14/trcwri_c14.F90
r7068 r7910 36 36 INTEGER :: ji,jj,jk,jn ! dummy loop indexes 37 37 REAL(wp) :: zage,zarea,ztemp ! temporary 38 REAL(wp), POINTER, DIMENSION(:,:) :: zres, z2d ! temporary storage 2D39 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d , zz3d ! temporary storage 3D38 REAL(wp), DIMENSION(jpi,jpj) :: zres, z2d ! temporary storage 2D 39 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d , zz3d ! temporary storage 3D 40 40 !!--------------------------------------------------------------------- 41 41 … … 50 50 IF( iom_use("DeltaC14") .OR. iom_use("C14Age") .OR. iom_use("RAge") ) THEN 51 51 ! 52 CALL wrk_alloc( jpi, jpj , z2d, zres )53 CALL wrk_alloc( jpi, jpj, jpk, z3d, zz3d )54 52 ! 55 53 zage = -1._wp / rlam14 / rsiyea ! factor for radioages in year … … 87 85 CALL iom_put( "RAge" , zage * z2d(:,:) ) ! Reservoir age [yr] 88 86 ! 89 CALL wrk_dealloc( jpi, jpj , z2d, zres )90 CALL wrk_dealloc( jpi, jpj, jpk, z3d, zz3d )91 87 ! 92 88 ENDIF -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r7646 r7910 43 43 INTEGER, INTENT(in) :: kt ! ocean time-step index 44 44 INTEGER :: jn ! dummy loop index 45 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt45 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrmyt 46 46 !!---------------------------------------------------------------------- 47 47 ! … … 52 52 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 53 53 54 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrmyt )55 54 56 55 CALL trc_bc ( kt ) ! tracers: surface and lateral Boundary Conditions … … 64 63 CALL trd_trc( ztrmyt, jn, jptra_sms, kt ) ! save trends 65 64 END DO 66 CALL wrk_dealloc( jpi, jpj, jpk, ztrmyt )67 65 END IF 68 66 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r7646 r7910 96 96 REAL(wp) :: znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 97 97 REAL(wp) :: ze3t 98 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw2d99 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zw3d98 REAL(wp), DIMENSION(jpi,jpj,17) :: zw2d 99 REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zw3d 100 100 CHARACTER (len=25) :: charout 101 101 !!--------------------------------------------------------------------- … … 104 104 ! 105 105 IF( lk_iomput ) THEN 106 CALL wrk_alloc( jpi, jpj, 17, zw2d )107 CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d )108 106 ENDIF 109 107 … … 384 382 ! 385 383 IF( lk_iomput ) THEN 386 CALL wrk_dealloc( jpi, jpj, 17, zw2d )387 CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d )388 384 ENDIF 389 385 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r7646 r7910 64 64 INTEGER :: ji, jj, jk, jl, ikt 65 65 REAL(wp) :: zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt 66 REAL(wp), POINTER, DIMENSION(:,:) :: zsedpoca66 REAL(wp), DIMENSION(jpi,jpj) :: zsedpoca 67 67 CHARACTER (len=25) :: charout 68 68 !!--------------------------------------------------------------------- … … 72 72 IF( kt == nittrc000 ) CALL p2z_exp_init 73 73 74 CALL wrk_alloc( jpi, jpj, zsedpoca )75 74 zsedpoca(:,:) = 0. 76 75 … … 147 146 ENDIF 148 147 ! 149 CALL wrk_dealloc( jpi, jpj, zsedpoca) ! temporary save of trends150 148 151 149 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 166 164 INTEGER :: ji, jj, jk 167 165 REAL(wp) :: zmaskt, zfluo, zfluu 168 REAL(wp), POINTER, DIMENSION(:,:) :: zrro169 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdm0166 REAL(wp), DIMENSION(jpi,jpj) :: zrro 167 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm0 170 168 !!--------------------------------------------------------------------- 171 169 … … 178 176 ! 179 177 ! Allocate temporary workspace 180 CALL wrk_alloc( jpi, jpj, zrro )181 CALL wrk_alloc( jpi, jpj, jpk, zdm0 )182 178 183 179 … … 246 242 ENDIF 247 243 ! 248 CALL wrk_dealloc( jpi, jpj, zrro )249 CALL wrk_dealloc( jpi, jpj, jpk, zdm0 )250 244 ! 251 245 END SUBROUTINE p2z_exp_init -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r7681 r7910 65 65 REAL(wp) :: zkr, zkg ! total absorption coefficient in red and green 66 66 REAL(wp) :: zcoef ! temporary scalar 67 REAL(wp), POINTER, DIMENSION(:,:) :: zpar100, zpar0m68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zparr, zparg67 REAL(wp), DIMENSION(jpi,jpj) :: zpar100, zpar0m 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg 69 69 !!--------------------------------------------------------------------- 70 70 ! … … 72 72 ! 73 73 ! Allocate temporary workspace 74 CALL wrk_alloc( jpi, jpj, zpar100, zpar0m )75 CALL wrk_alloc( jpi, jpj, jpk, zparr, zparg )76 74 77 75 IF( kt == nittrc000 ) THEN … … 140 138 ENDIF 141 139 ! 142 CALL wrk_dealloc( jpi, jpj, zpar100, zpar0m )143 CALL wrk_dealloc( jpi, jpj, jpk, zparr, zparg )144 140 ! 145 141 IF( nn_timing == 1 ) CALL timing_stop('p2z_opt') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r7646 r7910 61 61 INTEGER :: ji, jj, jk, jl, ierr 62 62 CHARACTER (len=25) :: charout 63 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra63 REAL(wp), DIMENSION(jpi,jpj) :: zw2d 64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork, ztra 65 65 !!--------------------------------------------------------------------- 66 66 ! … … 74 74 75 75 ! Allocate temporary workspace 76 CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )77 76 78 77 ! sedimentation of detritus : upstream scheme … … 100 99 IF( lk_iomput ) THEN 101 100 IF( iom_use( "TDETSED" ) ) THEN 102 CALL wrk_alloc( jpi, jpj, zw2d )103 101 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 104 102 DO jk = 2, jpkm1 … … 106 104 END DO 107 105 CALL iom_put( "TDETSED", zw2d ) 108 CALL wrk_dealloc( jpi, jpj, zw2d )109 106 ENDIF 110 107 ENDIF 111 108 ! 112 CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )113 109 ! 114 110 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r7753 r7910 562 562 LOGICAL :: l_exitnow 563 563 REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 564 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin564 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 565 565 566 566 IF( nn_timing == 1 ) CALL timing_start('solve_at_general') 567 567 ! Allocate temporary workspace 568 CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )569 CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )570 568 571 569 CALL anw_infsup( zalknw_inf, zalknw_sup ) … … 797 795 END DO 798 796 ! 799 CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )800 CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )801 797 802 798 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r7753 r7910 74 74 REAL(wp) :: dissol, zligco 75 75 CHARACTER (len=25) :: charout 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig, precip77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP78 REAL(wp), POINTER, DIMENSION(:,:) :: zstrn, zstrn276 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTL1, zFe3, ztotlig, precip 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 78 REAL(wp), DIMENSION(jpi,jpj) :: zstrn, zstrn2 79 79 !!--------------------------------------------------------------------- 80 80 ! … … 82 82 ! 83 83 ! Allocate temporary workspace 84 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )85 84 zFe3 (:,:,:) = 0. 86 85 zFeL1(:,:,:) = 0. 87 86 zTL1 (:,:,:) = 0. 88 87 IF( ln_fechem ) THEN 89 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2 )90 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )91 88 zFe2 (:,:,:) = 0. 92 89 zFeL2(:,:,:) = 0. … … 360 357 ENDIF 361 358 ! 362 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )363 359 IF( ln_fechem ) THEN 364 CALL wrk_dealloc( jpi, jpj, zstrn, zstrn2 )365 CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )366 360 ENDIF 367 361 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r7753 r7910 80 80 REAL(wp) :: zyr_dec, zdco2dt 81 81 CHARACTER (len=25) :: charout 82 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d, zpco2atm82 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d, zpco2atm 83 83 !!--------------------------------------------------------------------- 84 84 ! 85 85 IF( nn_timing == 1 ) CALL timing_start('p4z_flx') 86 86 ! 87 CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm )88 87 ! 89 88 … … 187 186 188 187 IF( lk_iomput .AND. knt == nrdttrc ) THEN 189 CALL wrk_alloc( jpi, jpj, zw2d )190 188 IF( iom_use( "Cflx" ) ) THEN 191 189 zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r … … 211 209 CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum ) ! molC 212 210 ! 213 CALL wrk_dealloc( jpi, jpj, zw2d ) 214 ENDIF 215 ! 216 CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm ) 211 ENDIF 212 ! 217 213 ! 218 214 IF( nn_timing == 1 ) CALL timing_stop('p4z_flx') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r7753 r7910 62 62 REAL(wp) :: zomegaca, zexcess, zexcess0 63 63 CHARACTER (len=25) :: charout 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3, zcaldiss, zhinit, zhi, zco3sat 65 65 !!--------------------------------------------------------------------- 66 66 ! 67 67 IF( nn_timing == 1 ) CALL timing_start('p4z_lys') 68 68 ! 69 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )70 69 ! 71 70 zco3 (:,:,:) = 0. … … 139 138 ENDIF 140 139 ! 141 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )142 140 ! 143 141 IF( nn_timing == 1 ) CALL timing_stop('p4z_lys') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r7753 r7910 72 72 REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 73 73 CHARACTER (len=25) :: charout 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zw3d 75 75 76 76 !!--------------------------------------------------------------------- … … 78 78 IF( nn_timing == 1 ) CALL timing_start('p4z_meso') 79 79 ! 80 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )81 80 zgrazing(:,:,:) = 0._wp 82 81 … … 218 217 ! 219 218 IF( lk_iomput .AND. knt == nrdttrc ) THEN 220 CALL wrk_alloc( jpi, jpj, jpk, zw3d )221 219 IF( iom_use( "GRAZ2" ) ) THEN 222 220 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton … … 227 225 CALL iom_put( "PCAL", zw3d ) 228 226 ENDIF 229 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )230 227 ENDIF 231 228 ! … … 236 233 ENDIF 237 234 ! 238 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )239 235 ! 240 236 IF( nn_timing == 1 ) CALL timing_stop('p4z_meso') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r7753 r7910 71 71 REAL(wp) :: zgrazp, zgrazm, zgrazsd 72 72 REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zw3d 74 74 CHARACTER (len=25) :: charout 75 75 !!--------------------------------------------------------------------- … … 77 77 IF( nn_timing == 1 ) CALL timing_start('p4z_micro') 78 78 ! 79 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )80 79 ! 81 80 DO jk = 1, jpkm1 … … 179 178 IF( lk_iomput ) THEN 180 179 IF( knt == nrdttrc ) THEN 181 CALL wrk_alloc( jpi, jpj, jpk, zw3d )182 180 IF( iom_use( "GRAZ1" ) ) THEN 183 181 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 184 182 CALL iom_put( "GRAZ1", zw3d ) 185 183 ENDIF 186 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )187 184 ENDIF 188 185 ENDIF … … 194 191 ENDIF 195 192 ! 196 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )197 193 ! 198 194 IF( nn_timing == 1 ) CALL timing_stop('p4z_micro') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r7753 r7910 66 66 REAL(wp) :: zchl 67 67 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 68 REAL(wp), POINTER, DIMENSION(:,:) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp469 REAL(wp), POINTER, DIMENSION(:,:) :: zetmp570 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr100, zqsr_corr71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d68 REAL(wp), DIMENSION(jpi,jpj) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 69 REAL(wp), DIMENSION(jpi,jpj) :: zetmp5 70 REAL(wp), DIMENSION(jpi,jpj) :: zqsr100, zqsr_corr 71 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpar, ze0, ze1, ze2, ze3, zchl3d 72 72 !!--------------------------------------------------------------------- 73 73 ! … … 75 75 ! 76 76 ! Allocate temporary workspace 77 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )78 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr )79 IF( ln_p5z ) CALL wrk_alloc( jpi, jpj, zetmp5 )80 CALL wrk_alloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d )81 77 82 78 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) … … 245 241 ENDIF 246 242 ! 247 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )248 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr )249 IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj, zetmp5 )250 CALL wrk_dealloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d )251 243 ! 252 244 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r7753 r7910 64 64 REAL(wp) :: zrfact2 65 65 CHARACTER (len=25) :: charout 66 REAL(wp), POINTER, DIMENSION(:,:) :: totprod, totthick, totcons67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zremipoc, zremigoc, zorem3, ztremint66 REAL(wp), DIMENSION(jpi,jpj) :: totprod, totthick, totcons 67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zremipoc, zremigoc, zorem3, ztremint 68 68 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: alphag 69 69 !!--------------------------------------------------------------------- … … 72 72 ! 73 73 ! Allocate temporary workspace 74 CALL wrk_alloc( jpi, jpj, totprod, totthick, totcons )75 CALL wrk_alloc( jpi, jpj, jpk, zremipoc, zremigoc, zorem3, ztremint )76 74 ALLOCATE( alphag(jpi,jpj,jpk,jcpoc) ) 77 75 … … 466 464 ENDIF 467 465 ! 468 CALL wrk_dealloc( jpi, jpj, totprod, totthick, totcons )469 CALL wrk_dealloc( jpi, jpj, jpk, zremipoc, zremigoc, zorem3, ztremint )470 466 DEALLOCATE( alphag ) 471 467 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r7753 r7910 77 77 REAL(wp) :: zfact 78 78 CHARACTER (len=25) :: charout 79 REAL(wp), POINTER, DIMENSION(:,:) :: zstrn, zw2d, zmixnano, zmixdiat80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl79 REAL(wp), DIMENSION(jpi,jpj) :: zstrn, zw2d, zmixnano, zmixdiat 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadd, zysopt, zw3d 81 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprdia, zprbio, zprdch, zprnch 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcad, zprofed, zprofen 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewd 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl 85 85 !!--------------------------------------------------------------------- 86 86 ! … … 88 88 ! 89 89 ! Allocate temporary workspace 90 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn )91 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )92 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )93 CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )94 90 ! 95 91 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp … … 368 364 IF( lk_iomput ) THEN 369 365 IF( knt == nrdttrc ) THEN 370 CALL wrk_alloc( jpi, jpj, zw2d )371 CALL wrk_alloc( jpi, jpj, jpk, zw3d )372 366 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 373 367 ! … … 470 464 IF( iom_use( "tintpp" ) ) CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s 471 465 ! 472 CALL wrk_dealloc( jpi, jpj, zw2d )473 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )474 466 ENDIF 475 467 ENDIF … … 481 473 ENDIF 482 474 ! 483 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn )484 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )485 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )486 CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )487 475 ! 488 476 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r7753 r7910 67 67 REAL(wp) :: zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp 68 68 CHARACTER (len=25) :: charout 69 REAL(wp), POINTER, DIMENSION(:,:) :: ztempbac70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zfacsi, zw3d, zfacsib69 REAL(wp), DIMENSION(jpi,jpj) :: ztempbac 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zolimi, zdepprod, zfacsi, zw3d, zfacsib 71 71 !!--------------------------------------------------------------------- 72 72 ! … … 74 74 ! 75 75 ! Allocate temporary workspace 76 CALL wrk_alloc( jpi, jpj, ztempbac )77 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib )78 76 79 77 ! Initialisation of temprary arrys … … 267 265 268 266 IF( knt == nrdttrc ) THEN 269 CALL wrk_alloc( jpi, jpj, jpk, zw3d )270 267 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 271 268 ! … … 279 276 ENDIF 280 277 ! 281 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )282 278 ENDIF 283 279 ! 284 CALL wrk_dealloc( jpi, jpj, ztempbac )285 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib )286 280 ! 287 281 IF( nn_timing == 1 ) CALL timing_stop('p4z_rem') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r7753 r7910 62 62 ! 63 63 CHARACTER (len=25) :: charout 64 REAL(wp), POINTER, DIMENSION(:,:) :: zsidep, zwork1, zwork2, zwork365 REAL(wp), POINTER, DIMENSION(:,:) :: zdenit2d, zironice, zbureff66 REAL(wp), POINTER, DIMENSION(:,:) :: zwsbio3, zwsbio4, zwscal67 REAL(wp), POINTER, DIMENSION(:,:) :: zsedcal, zsedsi, zsedc68 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zsoufer, zpdep, zlight69 REAL(wp), POINTER, DIMENSION(:,:) :: zwsfep64 REAL(wp), DIMENSION(jpi,jpj) :: zsidep, zwork1, zwork2, zwork3 65 REAL(wp), DIMENSION(jpi,jpj) :: zdenit2d, zironice, zbureff 66 REAL(wp), DIMENSION(jpi,jpj) :: zwsbio3, zwsbio4, zwscal 67 REAL(wp), DIMENSION(jpi,jpj) :: zsedcal, zsedsi, zsedc 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrpo4, ztrdop, zirondep, zsoufer, zpdep, zlight 69 REAL(wp), DIMENSION(jpi,jpj) :: zwsfep 70 70 71 71 !!--------------------------------------------------------------------- … … 76 76 ! 77 77 ! Allocate temporary workspace 78 CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )79 CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )80 CALL wrk_alloc( jpi, jpj, zsedcal, zsedsi, zsedc )81 CALL wrk_alloc( jpi, jpj, jpk, zlight, zsoufer )82 IF( ln_p5z ) CALL wrk_alloc( jpi, jpj, jpk, ztrpo4, ztrdop )83 IF( ln_ligand ) CALL wrk_alloc( jpi, jpj, zwsfep )84 78 85 79 … … 98 92 IF( ln_ironice ) THEN 99 93 ! 100 CALL wrk_alloc( jpi, jpj, zironice )101 94 ! 102 95 DO jj = 1, jpj … … 115 108 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 116 109 ! 117 CALL wrk_dealloc( jpi, jpj, zironice )118 110 ! 119 111 ENDIF … … 123 115 IF( ln_dust ) THEN 124 116 ! 125 CALL wrk_alloc( jpi, jpj, zsidep )126 CALL wrk_alloc( jpi, jpj, jpk, zpdep, zirondep )127 117 ! ! Iron and Si deposition at the surface 128 118 IF( ln_solub ) THEN … … 153 143 ENDIF 154 144 ENDIF 155 CALL wrk_dealloc( jpi, jpj, zsidep )156 CALL wrk_dealloc( jpi, jpj, jpk, zpdep, zirondep )157 145 ! 158 146 ENDIF … … 516 504 ENDIF 517 505 ! 518 CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )519 CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )520 CALL wrk_dealloc( jpi, jpj, zsedcal, zsedsi, zsedc )521 CALL wrk_dealloc( jpi, jpj, jpk, zlight, zsoufer )522 IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj, jpk, ztrpo4, ztrdop )523 IF( ln_ligand ) CALL wrk_dealloc( jpi, jpj, zwsfep )524 506 ! 525 507 IF( nn_timing == 1 ) CALL timing_stop('p4z_sed') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r7753 r7910 65 65 REAL(wp) :: zfact, zwsmax, zmax 66 66 CHARACTER (len=25) :: charout 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d68 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 68 REAL(wp), DIMENSION(jpi,jpj) :: zw2d 69 69 !!--------------------------------------------------------------------- 70 70 ! … … 212 212 IF( lk_iomput ) THEN 213 213 IF( knt == nrdttrc ) THEN 214 CALL wrk_alloc( jpi, jpj, zw2d )215 CALL wrk_alloc( jpi, jpj, jpk, zw3d )216 214 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 217 215 ! … … 250 248 IF( iom_use( "tcexp" ) ) CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s 251 249 ! 252 CALL wrk_dealloc( jpi, jpj, zw2d )253 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )254 250 ENDIF 255 251 ENDIF … … 302 298 INTEGER :: ji, jj, jk, jn 303 299 REAL(wp) :: zigma,zew,zign, zflx, zstep 304 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2, ztrb300 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztraz, zakz, zwsink2, ztrb 305 301 !!--------------------------------------------------------------------- 306 302 ! … … 308 304 ! 309 305 ! Allocate temporary workspace 310 CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb )311 306 312 307 zstep = rfact2 / REAL( kiter, wp ) / 2. … … 389 384 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 390 385 ! 391 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb )392 386 ! 393 387 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink2') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r7753 r7910 424 424 CHARACTER(LEN=100) :: cltxt 425 425 INTEGER :: jk 426 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork426 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork 427 427 !!---------------------------------------------------------------------- 428 428 … … 444 444 ENDIF 445 445 446 CALL wrk_alloc( jpi, jpj, jpk, zwork )447 446 ! 448 447 IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN … … 510 509 ENDIF 511 510 ! 512 CALL wrk_dealloc( jpi, jpj, jpk, zwork )513 511 ! 514 512 ! Global budget of N SMS : denitrification in the water column and in the sediment -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmeso.F90
r7646 r7910 85 85 CHARACTER (len=25) :: charout 86 86 REAL(wp) :: zrfact2, zmetexcess 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zw3d 88 88 89 89 !!--------------------------------------------------------------------- … … 91 91 IF( nn_timing == 1 ) CALL timing_start('p5z_meso') 92 92 ! 93 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )94 93 zgrazing(:,:,:) = 0._wp 95 94 … … 342 341 ! 343 342 IF( lk_iomput .AND. knt == nrdttrc ) THEN 344 CALL wrk_alloc( jpi, jpj, jpk, zw3d )345 343 IF( iom_use( "GRAZ2" ) ) THEN 346 344 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton … … 351 349 CALL iom_put( "PCAL", zw3d ) 352 350 ENDIF 353 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )354 351 ENDIF 355 352 ! … … 360 357 ENDIF 361 358 ! 362 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )363 359 ! 364 360 IF( nn_timing == 1 ) CALL timing_stop('p5z_meso') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmicro.F90
r7646 r7910 82 82 REAL(wp) :: zgrazdc, zgrazdn, zgrazdp, zgrazdf, zgraznf, zgrazz 83 83 REAL(wp) :: zgrazpc, zgrazpn, zgrazpp, zgrazpf, zbeta, zrfact2, zmetexcess 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zw3d 85 85 CHARACTER (len=25) :: charout 86 86 !!--------------------------------------------------------------------- … … 88 88 IF( nn_timing == 1 ) CALL timing_start('p5z_micro') 89 89 ! 90 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )91 90 ! 92 91 zmetexcess = 0.0 … … 290 289 ! 291 290 IF( lk_iomput .AND. knt == nrdttrc ) THEN 292 CALL wrk_alloc( jpi, jpj, jpk, zw3d )293 291 IF( iom_use( "GRAZ1" ) ) THEN 294 292 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 295 293 CALL iom_put( "GRAZ1", zw3d ) 296 294 ENDIF 297 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )298 295 ENDIF 299 296 ! … … 304 301 ENDIF 305 302 ! 306 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )307 303 ! 308 304 IF( nn_timing == 1 ) CALL timing_stop('p5z_micro') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zprod.F90
r7646 r7910 81 81 REAL(wp) :: zfact, zrfact2 82 82 CHARACTER (len=25) :: charout 83 REAL(wp), POINTER, DIMENSION(:,:) :: zmixnano, zmixpico, zmixdiat, zstrn84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadp, zpislopeadd85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprbio, zprpic, zprdia, zysopt86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprchln, zprchlp, zprchld87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcap, zprorcad88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprofed, zprofep, zprofen89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewp, zpronewd90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zproregn, zproregp, zproregd91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpropo4n, zpropo4p, zpropo4d92 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprodopn, zprodopp, zprodopd93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrespn, zrespp, zrespd, zprnut94 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcroissn, zcroissp, zcroissd95 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl96 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d97 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d83 REAL(wp), DIMENSION(jpi,jpj) :: zmixnano, zmixpico, zmixdiat, zstrn 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadp, zpislopeadd 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprbio, zprpic, zprdia, zysopt 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprchln, zprchlp, zprchld 87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcap, zprorcad 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofed, zprofep, zprofen 89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewp, zpronewd 90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zproregn, zproregp, zproregd 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpropo4n, zpropo4p, zpropo4d 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprodopn, zprodopp, zprodopd 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespn, zrespp, zrespd, zprnut 94 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcroissn, zcroissp, zcroissd 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl 96 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 97 REAL(wp), DIMENSION(jpi,jpj) :: zw2d 98 98 !!--------------------------------------------------------------------- 99 99 ! … … 101 101 ! 102 102 ! Allocate temporary workspace 103 CALL wrk_alloc( jpi, jpj, zmixnano, zmixpico, zmixdiat, zstrn )104 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )105 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopeadd, zysopt )106 CALL wrk_alloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad )107 CALL wrk_alloc( jpi, jpj, jpk, zprofed, zprofep, zprofen )108 CALL wrk_alloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd )109 CALL wrk_alloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut )110 CALL wrk_alloc( jpi, jpj, jpk, zprchln, zprchlp, zprchld, zprodopn, zprodopp, zprodopd )111 CALL wrk_alloc( jpi, jpj, jpk, zcroissp, zcroissn, zcroissd )112 103 ! 113 104 zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp … … 474 465 IF( lk_iomput ) THEN 475 466 IF( knt == nrdttrc ) THEN 476 CALL wrk_alloc( jpi, jpj, zw2d )477 CALL wrk_alloc( jpi, jpj, jpk, zw3d )478 467 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 479 468 ! … … 550 539 IF( iom_use( "tintpp" ) ) CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s 551 540 ! 552 CALL wrk_dealloc( jpi, jpj, zw2d )553 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )554 541 ENDIF 555 542 ENDIF … … 561 548 ENDIF 562 549 ! 563 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixpico, zmixdiat, zstrn )564 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )565 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopeadd, zysopt )566 CALL wrk_dealloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad )567 CALL wrk_dealloc( jpi, jpj, jpk, zprofed, zprofep, zprofen )568 CALL wrk_dealloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd )569 CALL wrk_dealloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut )570 CALL wrk_dealloc( jpi, jpj, jpk, zprchln, zprchlp, zprchld, zprodopn, zprodopp, zprodopd )571 CALL wrk_dealloc( jpi, jpj, jpk, zcroissp, zcroissn, zcroissd )572 550 ! 573 551 IF( nn_timing == 1 ) CALL timing_stop('p5z_prod') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r7753 r7910 78 78 INTEGER :: jk ! dummy loop index 79 79 CHARACTER (len=22) :: charout 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective velocity 81 81 !!---------------------------------------------------------------------- 82 82 ! 83 83 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 84 84 ! 85 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn )86 85 ! !== effective transport ==! 87 86 IF( l_offline ) THEN … … 135 134 END IF 136 135 ! 137 CALL wrk_dealloc( jpi,jpj,jpk, zun, zvn, zwn )138 136 ! 139 137 IF( nn_timing == 1 ) CALL timing_stop('trc_adv') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r7753 r7910 49 49 INTEGER, INTENT( in ) :: kt ! ocean time-step 50 50 CHARACTER (len=22) :: charout 51 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd51 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztrtrd 52 52 !!---------------------------------------------------------------------- 53 53 ! … … 60 60 61 61 IF( l_trdtrc ) THEN 62 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends63 62 ztrtrd(:,:,:,:) = tra(:,:,:,:) 64 63 ENDIF … … 91 90 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 92 91 END DO 93 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends94 92 ENDIF 95 93 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r7646 r7910 85 85 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 86 86 CHARACTER (len=22) :: charout 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd88 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrtrd 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrcdta ! 3D workspace 89 89 !!---------------------------------------------------------------------- 90 90 ! 91 91 IF( nn_timing == 1 ) CALL timing_start('trc_dmp') 92 92 ! 93 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) ! temporary save of trends94 93 ! 95 94 IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 96 95 ! 97 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation98 96 ! ! =========== 99 97 DO jn = 1, jptra ! tracer loop … … 150 148 END DO ! tracer loop 151 149 ! ! =========== 152 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 153 ENDIF 154 ! 155 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 150 ENDIF 151 ! 156 152 ! ! print mean trends (used for debugging) 157 153 IF( ln_ctl ) THEN … … 243 239 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 244 240 INTEGER :: isrow ! local index 245 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace241 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrcdta ! 3D workspace 246 242 247 243 !!---------------------------------------------------------------------- … … 355 351 IF(lwp) WRITE(numout,*) 356 352 ! 357 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation358 353 ! 359 354 DO jn = 1, jptra … … 373 368 ENDIF 374 369 ENDDO 375 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )376 370 ENDIF 377 371 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r7753 r7910 68 68 REAL(wp) :: zdep 69 69 CHARACTER (len=22) :: charout 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zahu, zahv71 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zahu, zahv 71 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztrtrd 72 72 !!---------------------------------------------------------------------- 73 73 ! … … 75 75 ! 76 76 IF( l_trdtrc ) THEN 77 CALL wrk_alloc( jpi,jpj,jpk,jptra, ztrtrd )78 77 ztrtrd(:,:,:,:) = tra(:,:,:,:) 79 78 ENDIF 80 79 ! !* set the lateral diffusivity coef. for passive tracer 81 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv )82 80 zahu(:,:,:) = rldf * ahtu(:,:,:) 83 81 zahv(:,:,:) = rldf * ahtv(:,:,:) … … 115 113 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 116 114 END DO 117 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )118 115 ENDIF 119 116 ! … … 124 121 ENDIF 125 122 ! 126 CALL wrk_dealloc( jpi,jpj,jpk, zahu, zahv )127 123 ! 128 124 IF( nn_timing == 1 ) CALL timing_stop('trc_ldf') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r7881 r7910 82 82 REAL(wp) :: zfact ! temporary scalar 83 83 CHARACTER (len=22) :: charout 84 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrdt84 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztrdt 85 85 !!---------------------------------------------------------------------- 86 86 ! … … 102 102 103 103 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 104 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )105 104 ztrdt(:,:,:,:) = trn(:,:,:,:) 106 105 ENDIF … … 137 136 END DO 138 137 END DO 139 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt )140 138 END IF 141 139 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r7753 r7910 139 139 REAL(wp) :: ztrcorb, ztrmasb ! temporary scalars 140 140 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 141 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays141 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrtrdb, ztrtrdn ! workspace arrays 142 142 REAL(wp) :: zs2rdt 143 143 LOGICAL :: lldebug = .FALSE. … … 145 145 146 146 147 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn )148 147 149 148 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved … … 226 225 ENDIF 227 226 228 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn )229 227 230 228 END SUBROUTINE trc_rad_sms -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7753 r7910 65 65 REAL(wp) :: zswitch, zftra, zcd, zdtra, ztfx, ztra ! temporary scalars 66 66 CHARACTER (len=22) :: charout 67 REAL(wp), POINTER, DIMENSION(:,:) :: zsfx68 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd67 REAL(wp), DIMENSION(jpi,jpj) :: zsfx 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrtrd 69 69 70 70 !!--------------------------------------------------------------------- … … 73 73 ! 74 74 ! Allocate temporary workspace 75 CALL wrk_alloc( jpi,jpj, zsfx )76 IF( l_trdtrc ) CALL wrk_alloc( jpi,jpj,jpk, ztrtrd )77 75 ! 78 76 zrtrn = 1.e-15_wp … … 190 188 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 191 189 ENDIF 192 CALL wrk_dealloc( jpi,jpj, zsfx )193 IF( l_trdtrc ) CALL wrk_dealloc( jpi,jpj,jpk, ztrtrd )194 190 ! 195 191 IF( nn_timing == 1 ) CALL timing_stop('trc_sbc') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r7753 r7910 55 55 INTEGER :: jk, jn 56 56 CHARACTER (len=22) :: charout 57 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd ! 4D workspace57 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztrtrd ! 4D workspace 58 58 !!--------------------------------------------------------------------- 59 59 ! … … 61 61 ! 62 62 IF( l_trdtrc ) THEN 63 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )64 63 ztrtrd(:,:,:,:) = tra(:,:,:,:) 65 64 ENDIF … … 77 76 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 78 77 END DO 79 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )80 78 ENDIF 81 79 ! ! print mean trends (used for debugging) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r7646 r7910 34 34 USE prtctl ! print control 35 35 USE sms_pisces ! PISCES bio-model 36 USE wrk_nemo ! Memory allocation37 36 38 37 IMPLICIT NONE … … 102 101 ! 103 102 INTEGER :: ji, jj, jk, isum 104 REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk 105 !!---------------------------------------------------------------------- 106 107 CALL wrk_alloc( jpi, jpj, zvlmsk ) 103 REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk 104 !!---------------------------------------------------------------------- 105 108 106 109 107 ! I. Definition of control surface and integration weights … … 188 186 END SELECT 189 187 ! 190 CALL wrk_dealloc( jpi, jpj, zvlmsk )191 188 ! 192 189 END SUBROUTINE trd_mxl_trc_zint … … 246 243 REAL(wp) :: zavt, zfn, zfn2 247 244 ! 248 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltot ! d(trc)/dt over the anlysis window (incl. Asselin)249 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlres ! residual = dh/dt entrainment term250 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlatf ! for storage only251 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlrad ! for storage only (for trb<0 corr in trcrad)252 ! 253 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltot2 ! -+254 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlres2 ! | working arrays to diagnose the trends255 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrdm2 ! | associated with the time meaned ML256 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlatf2 ! | passive tracers257 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlrad2 ! | (-> for trb<0 corr in trcrad)245 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltot ! d(trc)/dt over the anlysis window (incl. Asselin) 246 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlres ! residual = dh/dt entrainment term 247 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlatf ! for storage only 248 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlrad ! for storage only (for trb<0 corr in trcrad) 249 ! 250 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltot2 ! -+ 251 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlres2 ! | working arrays to diagnose the trends 252 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltrdm2 ! | associated with the time meaned ML 253 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlatf2 ! | passive tracers 254 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlrad2 ! | (-> for trb<0 corr in trcrad) 258 255 ! 259 256 CHARACTER (LEN=10) :: clvar … … 261 258 262 259 ! Set-up pointers into sub-arrays of workspaces 263 CALL wrk_alloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad )264 CALL wrk_alloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 )265 260 266 261 IF( nn_dttrc /= 1 ) CALL ctl_stop( " Be careful, trends diags never validated " ) … … 742 737 IF( lrst_trc ) CALL trd_mxl_trc_rst_write( kt ) ! this must be after the array swap above (III.3) 743 738 744 CALL wrk_dealloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad )745 CALL wrk_dealloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 )746 739 ! 747 740 END SUBROUTINE trd_mxl_trc -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
r7881 r7910 68 68 CHARACTER (len=20), ALLOCATABLE, DIMENSION(:) :: cl 69 69 CHARACTER (len=10) :: cl2 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask, ztab3d 71 !!---------------------------------------------------------------------- 72 73 CALL wrk_alloc( jpi, jpj, jpk, zmask, ztab3d ) 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, ztab3d 71 !!---------------------------------------------------------------------- 72 74 73 ALLOCATE( cl(jptra) ) 75 74 ! ! Arrays, scalars initialization … … 148 147 END DO 149 148 ! 150 CALL wrk_dealloc( jpi, jpj, jpk, zmask, ztab3d )151 149 DEALLOCATE( cl ) 152 150 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r7646 r7910 457 457 INTEGER :: ji, jj, jk ! dummy loop indices 458 458 REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0 ! local scalars 459 REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv459 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv 460 460 !!--------------------------------------------------------------------- 461 461 ! … … 463 463 ! 464 464 ! Allocate temporary workspace 465 CALL wrk_alloc( jpi,jpj, zhdiv )466 465 467 466 IF( kt == nittrc000 ) THEN … … 518 517 END DO 519 518 ! 520 CALL wrk_dealloc( jpi,jpj, zhdiv )521 519 ! 522 520 IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ssh')
Note: See TracChangeset
for help on using the changeset viewer.