- Timestamp:
- 2017-04-13T16:21:08+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 107 edited
Legend:
- Unmodified
- Added
- Removed
-
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)
Note: See TracChangeset
for help on using the changeset viewer.