Changeset 9125 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2017-12-19T09:47:17+01:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 1 deleted
- 38 edited
-
BDY/bdydyn.F90 (modified) (4 diffs)
-
BDY/bdytides.F90 (modified) (4 diffs)
-
C1D/domc1d.F90 (modified) (4 diffs)
-
C1D/dtauvd.F90 (modified) (4 diffs)
-
C1D/dyndmp.F90 (modified) (3 diffs)
-
CRS/crsdom.F90 (modified) (20 diffs)
-
CRS/crsdomwri.F90 (modified) (5 diffs)
-
CRS/crsini.F90 (modified) (4 diffs)
-
DIA/diaar5.F90 (modified) (10 diffs)
-
DIA/diadct.F90 (modified) (2 diffs)
-
DIA/diatmb.F90 (modified) (1 diff)
-
FLO/flo4rk.F90 (modified) (5 diffs)
-
FLO/floblk.F90 (modified) (3 diffs)
-
FLO/flowri.F90 (modified) (1 diff)
-
IOM/prtctl.F90 (modified) (5 diffs)
-
LBC/lib_mpp.F90 (modified) (2 diffs)
-
OBS/diaobs.F90 (modified) (7 diffs)
-
OBS/obs_inter_sup.F90 (modified) (3 diffs)
-
OBS/obs_read_altbias.F90 (modified) (4 diffs)
-
OBS/obs_readmdt.F90 (modified) (5 diffs)
-
OBS/obs_rot_vel.F90 (modified) (4 diffs)
-
SBC/cyclone.F90 (modified) (4 diffs)
-
SBC/fldread.F90 (modified) (5 diffs)
-
SBC/ocealb.F90 (modified) (1 diff)
-
SBC/sbcblk_algo_coare.F90 (modified) (3 diffs)
-
SBC/sbcblk_algo_coare3p5.F90 (modified) (3 diffs)
-
SBC/sbcblk_algo_ecmwf.F90 (modified) (3 diffs)
-
SBC/sbcblk_algo_ncar.F90 (modified) (3 diffs)
-
SBC/sbcfwb.F90 (modified) (1 diff)
-
SBC/sbcice_cice.F90 (modified) (7 diffs)
-
SBC/sbcrnf.F90 (modified) (3 diffs)
-
SBC/sbctide.F90 (modified) (4 diffs)
-
SBC/sbcwave.F90 (modified) (1 diff)
-
TRD/trdmxl.F90 (modified) (5 diffs)
-
TRD/trdpen.F90 (modified) (5 diffs)
-
TRD/trdvor.F90 (modified) (9 diffs)
-
USR/usrdef_zgr.F90 (modified) (1 diff)
-
ZDF/zdfiwm.F90 (modified) (1 diff)
-
wrk_nemo.F90 (deleted)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r9124 r9125 16 16 !! conditions 17 17 !!---------------------------------------------------------------------- 18 USE wrk_nemo ! Memory Allocation19 18 USE oce ! ocean dynamics and tracers 20 19 USE dom_oce ! ocean space and time domain … … 50 49 INTEGER :: jk, ii, ij, ib_bdy, ib, igrd ! Loop counter 51 50 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 52 REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d ! after barotropic velocities51 REAL(wp), DIMENSION(jpi,jpj) :: pua2d, pva2d ! after barotropic velocities 53 52 !!---------------------------------------------------------------------- 54 53 ! … … 65 64 & .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 66 65 END DO 67 68 !-------------------------------------------------------69 ! Set pointers70 !-------------------------------------------------------71 72 CALL wrk_alloc( jpi,jpj, pua2d, pva2d )73 66 74 67 !------------------------------------------------------- … … 124 117 END IF 125 118 ! 126 CALL wrk_dealloc( jpi,jpj, pua2d, pva2d )127 !128 119 END SUBROUTINE bdy_dyn 129 120 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r9124 r9125 25 25 USE fldread ! 26 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE wrk_nemo ! Memory allocation28 27 29 28 IMPLICIT NONE … … 75 74 CHARACTER(len=80) :: clfile !: full file name for tidal input file 76 75 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read !: work space to read in tidal harmonics data 77 REAL(wp), POINTER, DIMENSION(:,:):: ztr, zti !: " " " " " " " "76 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti !: " " " " " " " " 78 77 !! 79 78 TYPE(TIDES_DATA), POINTER :: td !: local short cut … … 150 149 ! given on the global domain (ie global, jpiglo x jpjglo) 151 150 ! 152 CALL wrk_alloc( jpi,jpj, zti, ztr)151 ALLOCATE( zti(jpi,jpj), ztr(jpi,jpj) ) 153 152 ! 154 153 ! SSH fields … … 200 199 CALL iom_close( inum ) 201 200 ! 202 CALL wrk_dealloc( jpi,jpj,ztr, zti )201 DEALLOCATE( ztr, zti ) 203 202 ! 204 203 ELSE -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
r9124 r9125 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 21 20 IMPLICIT NONE … … 58 57 REAL(wp) :: zlam1, zcos_alpha, ze1, ze1deg ! Case 5 local scalars 59 58 REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05 ! 60 REAL(wp) , POINTER, DIMENSION(:,:) :: gphidta, glamdta, zdist ! Global lat/lon59 REAL(wp) , DIMENSION(jpidta,jpjdta) :: gphidta, glamdta, zdist ! Global lat/lon 61 60 !! 62 61 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & … … 75 74 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 76 75 77 CALL wrk_alloc( jpidta,jpjdta, gphidta, glamdta, zdist )78 76 79 77 ! ============================= ! … … 183 181 jpizoom = iloc(1) + nimpp - 2 ! Minloc index - 1; want the bottom-left 184 182 jpjzoom = iloc(2) + njmpp - 2 ! corner index of the zoom domain. 185 186 CALL wrk_dealloc( jpidta,jpjdta, gphidta, glamdta, zdist )187 183 188 184 IF (lwp) THEN -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
r9124 r9125 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 … … 139 138 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 140 139 REAL(wp):: zl, zi ! local floats 141 REAL(wp), POINTER, DIMENSION(:) :: zup, zvp ! 1D workspace140 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zup, zvp ! 1D workspace 142 141 !!---------------------------------------------------------------------- 143 142 ! … … 151 150 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 152 151 ! 153 CALL wrk_alloc( jpk, zup, zvp)152 ALLOCATE( zup(jpk), zvp(jpk) ) 154 153 ! 155 154 IF( kt == nit000 .AND. lwp )THEN … … 187 186 END DO 188 187 ! 189 CALL wrk_dealloc( jpk,zup, zvp )188 DEALLOCATE( zup, zvp ) 190 189 ! 191 190 ELSE !== z- or zps- coordinate ==! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
r9124 r9125 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( ln_timing ) 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( ln_timing ) CALL timing_stop( 'dyn_dmp') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r9019 r9125 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(:,:,:), ALLOCATABLE :: zsurf, zsurfmsk, zmask 490 487 !!---------------------------------------------------------------- 491 488 ! … … 496 493 CASE ( 'VOL' ) 497 494 ! 498 CALL wrk_alloc( jpi,jpj,jpk, zsurf, zsurfmsk)495 ALLOCATE( zsurf(jpi,jpj,jpk), zsurfmsk(jpi,jpj,jpk) ) 499 496 ! 500 497 SELECT CASE ( cd_type ) … … 585 582 END SELECT 586 583 587 CALL wrk_dealloc( jpi, jpj, jpk,zsurf, zsurfmsk )584 DEALLOCATE( zsurf, zsurfmsk ) 588 585 589 586 CASE ( 'SUM' ) 590 587 591 CALL wrk_alloc( jpi, jpj, jpk, zsurfmsk)588 ALLOCATE( zsurfmsk(jpi,jpj,jpk) ) 592 589 593 590 SELECT CASE ( cd_type ) … … 763 760 ENDIF 764 761 765 CALL wrk_dealloc( jpi, jpj, jpk,zsurfmsk )762 DEALLOCATE( zsurfmsk ) 766 763 767 764 CASE ( 'MAX' ) ! search the max of unmasked grid cells 768 765 769 CALL wrk_alloc( jpi, jpj, jpk, zmask)766 ALLOCATE( zmask(jpi,jpj,jpk) ) 770 767 771 768 SELECT CASE ( cd_type ) … … 934 931 END SELECT 935 932 936 CALL wrk_dealloc( jpi, jpj, jpk,zmask )933 DEALLOCATE( zmask ) 937 934 938 935 CASE ( 'MIN' ) ! Search the min of unmasked grid cells 939 936 940 CALL wrk_alloc( jpi, jpj, jpk, zmask)937 ALLOCATE( zmask(jpi,jpj,jpk) ) 941 938 942 939 SELECT CASE ( cd_type ) … … 1104 1101 END SELECT 1105 1102 ! 1106 CALL wrk_dealloc( jpi, jpj, jpk,zmask )1103 DEALLOCATE( zmask ) 1107 1104 ! 1108 1105 END SELECT … … 1149 1146 INTEGER :: ijie, ijje, ii, ij, je_2 1150 1147 REAL(wp) :: zflcrs, zsfcrs 1151 REAL(wp), DIMENSION(:,:), POINTER:: zsurfmsk1148 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsurfmsk 1152 1149 !!---------------------------------------------------------------- 1153 1150 ! … … 1158 1155 CASE ( 'VOL' ) 1159 1156 1160 CALL wrk_alloc( jpi, jpj, zsurfmsk)1157 ALLOCATE( zsurfmsk(jpi,jpj) ) 1161 1158 zsurfmsk(:,:) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 1162 1159 … … 1222 1219 ENDDO 1223 1220 1224 CALL wrk_dealloc( jpi, jpj,zsurfmsk )1221 DEALLOCATE( zsurfmsk ) 1225 1222 1226 1223 CASE ( 'SUM' ) 1227 1224 1228 CALL wrk_alloc( jpi, jpj, zsurfmsk)1225 ALLOCATE( zsurfmsk(jpi,jpj) ) 1229 1226 IF( PRESENT( p_e3 ) ) THEN 1230 1227 zsurfmsk(:,:) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) … … 1364 1361 ENDIF 1365 1362 1366 CALL wrk_dealloc( jpi, jpj,zsurfmsk )1363 DEALLOCATE( zsurfmsk ) 1367 1364 1368 1365 CASE ( 'MAX' ) … … 1644 1641 INTEGER :: ijie, ijje, ii, ij, je_2 1645 1642 REAL(wp) :: ze3crs 1646 REAL(wp), DIMENSION( :,:,:), POINTER:: zmask, zsurf1643 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, zsurf 1647 1644 1648 1645 !!---------------------------------------------------------------- … … 1651 1648 p_e3_max_crs(:,:,:) = 1. 1652 1649 1653 1654 CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )1655 1650 1656 1651 SELECT CASE ( cd_type ) … … 1756 1751 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 1757 1752 ! 1758 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask )1759 1753 ! 1760 1754 END SUBROUTINE crs_dom_e3 … … 1773 1767 INTEGER :: ji, jj, jk ! dummy loop indices 1774 1768 INTEGER :: ii, ij, je_2 1775 REAL(wp), DIMENSION( :,:,:), POINTER:: zsurf, zsurfmsk1769 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsurf, zsurfmsk 1776 1770 !!---------------------------------------------------------------- 1777 1771 ! Initialize 1778 1772 1779 1780 CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )1781 1773 ! 1782 1774 SELECT CASE ( cd_type ) … … 1867 1859 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0, pval=1.0 ) 1868 1860 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 1869 1870 CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf )1871 1861 1872 1862 END SUBROUTINE crs_dom_sfc … … 2236 2226 !! local variables 2237 2227 INTEGER :: ji,jj,jk ! dummy indices 2238 REAL(wp), DIMENSION( :,:) , POINTER:: zmbk2228 REAL(wp), DIMENSION(jpi_crs, jpj_crs) :: zmbk 2239 2229 !!---------------------------------------------------------------- 2240 2241 CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )2242 2230 2243 2231 mbathy_crs(:,:) = jpkm1 … … 2281 2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 2282 2270 ! 2283 CALL wrk_dealloc( jpi_crs, jpj_crs, zmbk )2284 !2285 2271 END SUBROUTINE crs_dom_bat 2286 2272 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
r9124 r9125 19 19 USE crsdom ! coarse grid domain 20 20 USE crslbclnk ! crs mediator to lbclnk 21 USE wrk_nemo ! Working array22 21 23 22 IMPLICIT NONE … … 63 62 INTEGER :: ji, jj, jk ! dummy loop indices 64 63 ! ! workspaces 65 REAL(wp), POINTER, DIMENSION(:,: ) :: zprt, zprw 66 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 67 REAL(wp), POINTER, DIMENSION(:,: ) :: ze3tp, ze3wp 68 !!---------------------------------------------------------------------- 69 ! 70 CALL wrk_alloc( jpi_crs, jpj_crs, zprt , zprw ) 71 CALL wrk_alloc( jpi_crs, jpj_crs, ze3tp, ze3wp ) 72 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv ) 73 64 REAL(wp), DIMENSION(jpi_crs,jpj_crs ) :: zprt, zprw 65 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zdepu, zdepv 66 REAL(wp), DIMENSION(jpi_crs,jpj_crs ) :: ze3tp, ze3wp 67 !!---------------------------------------------------------------------- 68 ! 74 69 ze3tp(:,:) = 0.0 75 70 ze3wp(:,:) = 0.0 … … 289 284 END SELECT 290 285 ! 291 CALL wrk_dealloc( jpi_crs, jpj_crs, zprt , zprw )292 CALL wrk_dealloc( jpi_crs, jpj_crs, ze3tp, ze3wp )293 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv )294 !295 286 END SUBROUTINE crs_dom_wri 296 287 … … 312 303 INTEGER :: ji ! dummy loop indices 313 304 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not 314 REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 315 !!---------------------------------------------------------------------- 316 ! 317 CALL wrk_alloc( jpi_crs, jpj_crs, ztstref ) 305 REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: ztstref 306 !!---------------------------------------------------------------------- 318 307 ! 319 308 ! build an array with different values for each element … … 331 320 puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 332 321 ! 333 CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref )334 !335 322 END SUBROUTINE dom_uniq_crs 336 323 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r9124 r9125 22 22 USE in_out_manager 23 23 USE lib_mpp 24 USE wrk_nemo25 24 26 25 IMPLICIT NONE … … 72 71 INTEGER :: ierr ! allocation error status 73 72 INTEGER :: ios ! Local integer output status for namelist read 74 REAL(wp), DIMENSION( :,:,:), POINTER:: ze3t, ze3u, ze3v, ze3w73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w 75 74 76 75 NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn … … 180 179 181 180 ! 182 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3u, ze3v, ze3w )183 !184 181 ze3t(:,:,:) = e3t_n(:,:,:) 185 182 ze3u(:,:,:) = e3u_n(:,:,:) … … 245 242 ! 7. Finish and clean-up 246 243 !--------------------------------------------------------- 247 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3u, ze3v, ze3w )248 244 ! 249 245 END SUBROUTINE crs_init -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r9124 r9125 22 22 USE fldread ! type FLD_N 23 23 USE timing ! preformance summary 24 USE wrk_nemo ! working arrays25 24 26 25 IMPLICIT NONE … … 76 75 REAL(wp) :: zaw, zbw, zrw 77 76 ! 78 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 79 REAL(wp), POINTER, DIMENSION(:,:) :: zpe ! 2D workspace 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe ! 2D workspace 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 81 82 82 !!-------------------------------------------------------------------- 83 83 IF( ln_timing ) CALL timing_start('dia_ar5') … … 85 85 IF( kt == nit000 ) CALL dia_ar5_init 86 86 87 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)87 IF( l_ar5 ) THEN 88 ALLOCATE( zarea_ssh(jpi,jpj) , zbotpres(jpi,jpj) ) 89 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 90 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 91 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 92 92 ENDIF … … 212 212 ! Exclude points where rn2 is negative as convection kicks in here and 213 213 ! work is not being done against stratification 214 CALL wrk_alloc( jpi, jpj, zpe)214 ALLOCATE( zpe(jpi,jpj) ) 215 215 zpe(:,:) = 0._wp 216 216 IF( ln_zdfddm ) THEN … … 247 247 !!gm CALL lbc_lnk( zpe, 'T', 1._wp) 248 248 CALL iom_put( 'tnpeo', zpe ) 249 CALL wrk_dealloc( jpi, jpj,zpe )250 ENDIF 251 ! 249 DEALLOCATE( zpe ) 250 ENDIF 251 252 252 IF( l_ar5 ) THEN 253 CALL wrk_dealloc( jpi , jpj ,zarea_ssh , zbotpres )254 CALL wrk_dealloc( jpi , jpj , jpk ,zrhd , zrhop )255 CALL wrk_dealloc( jpi , jpj , jpk , jpts ,ztsn )253 DEALLOCATE( zarea_ssh , zbotpres ) 254 DEALLOCATE( zrhd , zrhop ) 255 DEALLOCATE( ztsn ) 256 256 ENDIF 257 257 ! … … 274 274 ! 275 275 INTEGER :: ji, jj, jk 276 REAL(wp), POINTER, DIMENSION(:,:) :: z2d276 REAL(wp), DIMENSION(jpi,jpj) :: z2d 277 277 278 278 279 280 CALL wrk_alloc( jpi, jpj, z2d )281 279 z2d(:,:) = pua(:,:,1) 282 280 DO jk = 1, jpkm1 … … 315 313 ENDIF 316 314 317 CALL wrk_dealloc( jpi, jpj, z2d )318 319 315 END SUBROUTINE dia_ar5_hst 320 316 … … 330 326 INTEGER :: ji, jj, jk ! dummy loop indices 331 327 REAL(wp) :: zztmp 332 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity328 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 333 329 ! 334 330 !!---------------------------------------------------------------------- … … 341 337 IF( l_ar5 ) THEN 342 338 ! 343 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )344 339 ! ! allocate dia_ar5 arrays 345 340 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 357 352 IF( lk_mpp ) CALL mpp_sum( vol0 ) 358 353 359 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 360 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 361 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 362 CALL iom_close( inum ) 363 364 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 365 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 366 IF( ln_zps ) THEN ! z-coord. partial steps 367 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 368 DO ji = 1, jpi 369 ik = mbkt(ji,jj) 370 IF( ik > 1 ) THEN 371 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 372 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 373 ENDIF 374 END DO 375 END DO 354 IF( iom_use( 'sshthster' ) ) THEN 355 ALLOCATE( zsaldta(jpi,jpj,jpj,jpts) ) 356 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 357 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 358 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 359 CALL iom_close( inum ) 360 361 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 362 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 363 IF( ln_zps ) THEN ! z-coord. partial steps 364 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 365 DO ji = 1, jpi 366 ik = mbkt(ji,jj) 367 IF( ik > 1 ) THEN 368 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 369 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 370 ENDIF 371 END DO 372 END DO 373 ENDIF 374 ! 375 DEALLOCATE( zsaldta ) 376 376 ENDIF 377 !378 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )379 377 ! 380 378 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r9124 r9125 506 506 istart,iend !first and last points selected in listpoint 507 507 INTEGER :: jpoint !loop on list points 508 INTEGER, POINTER,DIMENSION(nb_point_max) :: idirec !contains temporary sec%direction509 INTEGER, POINTER,DIMENSION(2,nb_point_max) :: icoord !contains temporary sec%listpoint508 INTEGER, DIMENSION(nb_point_max) :: idirec !contains temporary sec%direction 509 INTEGER, DIMENSION(2,nb_point_max) :: icoord !contains temporary sec%listpoint 510 510 !---------------------------------------------------------------------------- 511 511 ! 512 512 IF( ld_debug )WRITE(numout,*)' -------------------------' 513 513 IF( ld_debug )WRITE(numout,*)' removepoints in listpoint' … … 559 559 ! 560 560 END SUBROUTINE removepoints 561 561 562 562 563 SUBROUTINE transport(sec,ld_debug,jsec) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r9124 r9125 103 103 !!-------------------------------------------------------------------- 104 104 REAL(wp) :: zmdi =1.e+20 ! land value 105 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb! workspace105 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! workspace 106 106 !!-------------------------------------------------------------------- 107 107 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r6140 r9125 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_merge_2017/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r7646 r9125 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_merge_2017/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r6140 r9125 34 34 CHARACTER (len=80) :: clname ! netcdf output filename 35 35 36 ! Following are only workspace arrays but shape is not (jpi,jpj) and37 ! therefore make them module arrays rather than replacing with wrk_nemo38 ! member arrays.39 36 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zlon , zlat, zdep ! 2D workspace 40 37 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ztem , zsal, zrho ! 2D workspace -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r9019 r9125 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 !!---------------------------------------------------------------------- 102 98 103 99 ! Arrays, scalars initialization … … 207 203 208 204 ENDDO 209 210 CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 )211 CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 )212 205 ! 213 206 END SUBROUTINE prt_ctl … … 425 418 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 426 419 427 INTEGER, POINTER, DIMENSION(:,:) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace420 INTEGER, DIMENSION(jpi,jpj) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace 428 421 REAL(wp) :: zidom, zjdom ! temporary scalars 429 422 !!---------------------------------------------------------------------- 430 423 431 424 ! 432 CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )433 425 ! 434 426 ! 1. Dimension arrays for subdomains … … 578 570 ! 579 571 ! 580 CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )581 !582 572 ! 583 573 END SUBROUTINE sub_dom -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r9069 r9125 59 59 USE lbcnfd ! north fold treatment 60 60 USE in_out_manager ! I/O manager 61 USE wrk_nemo ! work arrays62 61 63 62 IMPLICIT NONE … … 1033 1032 !!---------------------------------------------------------------------- 1034 1033 ! 1035 ! Since this is just an init routine and these arrays are of length jpnij1036 ! then don't use wrk_nemo module - just allocate and deallocate.1037 1034 ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr ) 1038 1035 IF( ierr /= 0 ) THEN -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r9041 r9125 14 14 !! fin_date : Compute the final date YYYYMMDD.HHMMSS 15 15 !!---------------------------------------------------------------------- 16 USE wrk_nemo ! Memory Allocation17 16 USE par_kind ! Precision variables 18 17 USE in_out_manager ! I/O manager … … 159 158 REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS 160 159 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 161 REAL(wp), POINTER, DIMENSION(:,:) :: &160 REAL(wp), DIMENSION(jpi,jpj) :: & 162 161 & zglam1, & ! Model longitudes for profile variable 1 163 162 & zglam2 ! Model longitudes for profile variable 2 164 REAL(wp), POINTER, DIMENSION(:,:) :: &163 REAL(wp), DIMENSION(jpi,jpj) :: & 165 164 & zgphi1, & ! Model latitudes for profile variable 1 166 165 & zgphi2 ! Model latitudes for profile variable 2 167 REAL(wp), POINTER, DIMENSION(:,:,:) :: &166 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 168 167 & zmask1, & ! Model land/sea mask associated with variable 1 169 168 & zmask2 ! Model land/sea mask associated with variable 2 … … 194 193 195 194 INTEGER :: jnumsstbias 196 CALL wrk_alloc( jpi, jpj, zglam1 )197 CALL wrk_alloc( jpi, jpj, zglam2 )198 CALL wrk_alloc( jpi, jpj, zgphi1 )199 CALL wrk_alloc( jpi, jpj, zgphi2 )200 CALL wrk_alloc( jpi, jpj, jpk, zmask1 )201 CALL wrk_alloc( jpi, jpj, jpk, zmask2 )202 195 203 196 !----------------------------------------------------------------------- … … 513 506 ENDIF 514 507 515 CALL wrk_dealloc( jpi, jpj, zglam1 )516 CALL wrk_dealloc( jpi, jpj, zglam2 )517 CALL wrk_dealloc( jpi, jpj, zgphi1 )518 CALL wrk_dealloc( jpi, jpj, zgphi2 )519 CALL wrk_dealloc( jpi, jpj, jpk, zmask1 )520 CALL wrk_dealloc( jpi, jpj, jpk, zmask2 )521 522 508 END SUBROUTINE dia_obs_init 523 509 … … 567 553 INTEGER :: jvar ! Variable number 568 554 INTEGER :: ji, jj ! Loop counters 569 REAL(wp), POINTER, DIMENSION(:,:,:) :: &555 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 570 556 & zprofvar1, & ! Model values for 1st variable in a prof ob 571 557 & zprofvar2 ! Model values for 2nd variable in a prof ob 572 REAL(wp), POINTER, DIMENSION(:,:,:) :: &558 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 573 559 & zprofmask1, & ! Mask associated with zprofvar1 574 560 & zprofmask2 ! Mask associated with zprofvar2 575 REAL(wp), POINTER, DIMENSION(:,:) :: &561 REAL(wp), DIMENSION(jpi,jpj) :: & 576 562 & zsurfvar, & ! Model values equivalent to surface ob. 577 563 & zsurfmask ! Mask associated with surface variable 578 REAL(wp), POINTER, DIMENSION(:,:) :: &564 REAL(wp), DIMENSION(jpi,jpj) :: & 579 565 & zglam1, & ! Model longitudes for prof variable 1 580 566 & zglam2, & ! Model longitudes for prof variable 2 … … 582 568 & zgphi2 ! Model latitudes for prof variable 2 583 569 584 !Allocate local work arrays585 CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 )586 CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 )587 CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 )588 CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 )589 CALL wrk_alloc( jpi, jpj, zsurfvar )590 CALL wrk_alloc( jpi, jpj, zsurfmask )591 CALL wrk_alloc( jpi, jpj, zglam1 )592 CALL wrk_alloc( jpi, jpj, zglam2 )593 CALL wrk_alloc( jpi, jpj, zgphi1 )594 CALL wrk_alloc( jpi, jpj, zgphi2 )595 570 !----------------------------------------------------------------------- 596 571 … … 692 667 ENDIF 693 668 694 CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 )695 CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 )696 CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 )697 CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 )698 CALL wrk_dealloc( jpi, jpj, zsurfvar )699 CALL wrk_dealloc( jpi, jpj, zsurfmask )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 705 669 END SUBROUTINE dia_obs 706 670 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
r6140 r9125 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 131 ! Check workspace array and set-up pointer132 CALL wrk_alloc(jpi,jpj,1,zval)133 129 134 130 ! Set up local "3D" buffer … … 152 148 153 149 pgval(:,:,:) = zgval(:,:,1,:) 154 155 ! 'Release' workspace array back to pool156 CALL wrk_dealloc(jpi,jpj,1,zval)157 150 158 151 END SUBROUTINE obs_int_comm_2d -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r6140 r9125 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 … … 106 105 & igrdj 107 106 INTEGER :: numaltbias 108 109 CALL wrk_alloc(jpi,jpj,z_altbias)110 107 111 108 IF(lwp)WRITE(numout,*) … … 201 198 & ) 202 199 203 CALL wrk_dealloc(jpi,jpj,z_altbias)204 205 200 END SUBROUTINE obs_rea_altbias 206 201 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r9023 r9125 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 83 CALL wrk_alloc(jpi,jpj,z_mdt,mdtmask)84 81 85 82 IF(lwp)WRITE(numout,*) … … 167 164 & ) 168 165 169 CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask)170 166 IF(lwp)WRITE(numout,*) ' ------------- ' 171 167 ! … … 192 188 INTEGER :: ji, jj 193 189 REAL(wp) :: zdxdy, zarea, zeta1, zeta2, zcorr_mdt, zcorr_bcketa, zcorr ! local scalar 194 REAL(wp), POINTER, DIMENSION(:,:) :: zpromsk190 REAL(wp), DIMENSION(jpi,jpj) :: zpromsk 195 191 CHARACTER(LEN=14), PARAMETER :: cpname = 'obs_offset_mdt' 196 192 !!---------------------------------------------------------------------- 197 198 CALL wrk_alloc( jpi,jpj, zpromsk )199 193 200 194 ! Initialize the local mask, for domain projection … … 258 252 IF ( nn_msshc == 2 ) WRITE(numout,*) ' User defined MSSH correction' 259 253 260 CALL wrk_dealloc( jpi,jpj, zpromsk )261 254 ! 262 255 END SUBROUTINE obs_offset_mdt -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r6140 r9125 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 230 226 END SUBROUTINE obs_rotvel 231 227 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
r7646 r9125 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 ! … … 88 87 TYPE(FLD_N) :: sn_tc ! informations about the fields to be read 89 88 !!-------------------------------------------------------------------- 90 91 CALL wrk_alloc( jpi,jpj, zwnd_x, zwnd_y )92 89 93 90 ! ! ====================== ! … … 271 268 CALL rot_rep ( zwnd_x, zwnd_y, 'T', 'en->j', pwnd_j ) !rotation of components on ORCA grid 272 269 273 CALL wrk_dealloc( jpi,jpj, zwnd_x, zwnd_y )274 275 270 END SUBROUTINE wnd_cyc 276 271 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r9019 r9125 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 … … 1144 1143 INTEGER :: ill ! character length 1145 1144 INTEGER :: iv ! indice of V component 1146 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 ) 1145 CHARACTER (LEN=100) :: clcomp ! dummy weight name 1146 REAL(wp), DIMENSION(jpi,jpj) :: utmp, vtmp ! temporary arrays for vector rotation 1147 !!--------------------------------------------------------------------- 1151 1148 ! 1152 1149 !! (sga: following code should be modified so that pairs arent searched for each time … … 1185 1182 END DO 1186 1183 ! 1187 CALL wrk_dealloc( jpi,jpj, utmp, vtmp )1188 !1189 1184 END SUBROUTINE fld_rot 1190 1185 … … 1438 1433 CHARACTER (len=5) :: aname ! 1439 1434 INTEGER , DIMENSION(:), ALLOCATABLE :: ddims 1440 INTEGER , POINTER, DIMENSION(:,:) :: data_src1441 REAL(wp), POINTER, DIMENSION(:,:) :: data_tmp1435 INTEGER, DIMENSION(jpi,jpj) :: data_src 1436 REAL(wp), DIMENSION(jpi,jpj) :: data_tmp 1442 1437 !!---------------------------------------------------------------------- 1443 !1444 CALL wrk_alloc( jpi,jpj, data_src ) ! integer1445 CALL wrk_alloc( jpi,jpj, data_tmp )1446 1438 ! 1447 1439 IF( nxt_wgt > tot_wgts ) THEN … … 1561 1553 1562 1554 DEALLOCATE (ddims ) 1563 1564 CALL wrk_dealloc( jpi,jpj, data_src ) ! integer1565 CALL wrk_dealloc( jpi,jpj, data_tmp )1566 1555 ! 1567 1556 END SUBROUTINE fld_weight -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/ocealb.F90
r9019 r9125 12 12 USE in_out_manager ! I/O manager 13 13 USE lib_mpp ! MPP library 14 USE wrk_nemo ! work arrays15 14 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 16 15 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90
r9124 r9125 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 prtctl ! Print control 43 42 USE lib_fortran ! to use key_nosignedzero … … 110 109 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 111 110 112 REAL(wp), DIMENSION( :,:), POINTER:: &111 REAL(wp), DIMENSION(jpi,jpj) :: & 113 112 & u_star, t_star, q_star, & 114 113 & dt_zu, dq_zu, & 115 114 & znu_a, & !: Nu_air, Viscosity of air 116 115 & z0, z0t 117 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, ztmp2116 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 117 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 118 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt 120 119 !!---------------------------------------------------------------------- 121 120 ! 122 CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu)123 CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )124 125 121 l_zt_equal_zu = .FALSE. 126 122 IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 127 123 128 IF( .NOT. l_zt_equal_zu ) CALL wrk_alloc( jpi,jpj, zeta_t)124 IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) ) 129 125 130 126 !! First guess of temperature and humidity at height zu: … … 248 244 Cen = Chn 249 245 ! 250 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu ) 251 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) 252 IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t ) 246 IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t ) 253 247 ! 254 248 END SUBROUTINE turb_coare -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90
r9124 r9125 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 in_out_manager ! I/O manager 42 41 USE prtctl ! Print control … … 111 110 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 112 111 ! 113 REAL(wp), DIMENSION( :,:), POINTER:: &112 REAL(wp), DIMENSION(jpi,jpj) :: & 114 113 & u_star, t_star, q_star, & 115 114 & dt_zu, dq_zu, & 116 115 & znu_a, & !: Nu_air, Viscosity of air 117 116 & 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 121 !!---------------------------------------------------------------------------------- 122 ! 123 CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu) 124 CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) 125 117 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 118 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 119 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt 120 !!---------------------------------------------------------------------------------- 121 ! 126 122 l_zt_equal_zu = .FALSE. 127 123 IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 128 124 129 IF( .NOT. l_zt_equal_zu ) CALL wrk_alloc( jpi,jpj, zeta_t)125 IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) ) 130 126 131 127 !! First guess of temperature and humidity at height zu: … … 256 252 Cen = Chn 257 253 ! 258 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu ) 259 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) 260 IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t ) 254 IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t ) 261 255 ! 262 256 END SUBROUTINE turb_coare3p5 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90
r9124 r9125 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 in_out_manager ! I/O manager 36 35 USE prtctl ! Print control … … 118 117 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 119 118 ! 120 REAL(wp), DIMENSION( :,:), POINTER:: u_star, t_star, q_star, &119 REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star, & 121 120 & dt_zu, dq_zu, & 122 121 & znu_a, & !: Nu_air, Viscosity of air 123 122 & Linv, & !: 1/L (inverse of Monin Obukhov length... 124 123 & z0, z0t, z0q 125 REAL(wp), DIMENSION(:,:), POINTER :: func_m, func_h 126 REAL(wp), DIMENSION(:,:), POINTER :: ztmp0, ztmp1, ztmp2 127 !!---------------------------------------------------------------------------------- 128 ! 129 CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv ) 130 CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, z0q, ztmp0, ztmp1, ztmp2 ) 124 REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h 125 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 126 !!---------------------------------------------------------------------------------- 131 127 ! 132 128 ! Identical first gess as in COARE, with IFS parameter values though … … 286 282 Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q)) 287 283 288 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv )289 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, z0q, ztmp0, ztmp1, ztmp2 )290 !291 284 END SUBROUTINE TURB_ECMWF 292 285 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90
r9124 r9125 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 in_out_manager ! I/O manager 38 37 USE prtctl ! Print control … … 118 117 INTEGER , PARAMETER :: nb_itt = 4 ! number of itterations 119 118 ! 120 REAL(wp), DIMENSION(:,:), POINTER :: Cx_n10 ! 10m neutral latent/sensible coefficient 121 REAL(wp), DIMENSION(:,:), POINTER :: sqrt_Cd_n10 ! root square of Cd_n10 122 REAL(wp), DIMENSION(:,:), POINTER :: zeta_u ! stability parameter at height zu 123 REAL(wp), DIMENSION(:,:), POINTER :: zpsi_h_u 124 REAL(wp), DIMENSION(:,:), POINTER :: ztmp0, ztmp1, ztmp2 125 REAL(wp), DIMENSION(:,:), POINTER :: stab ! stability test integer 126 !!---------------------------------------------------------------------------------- 127 ! 128 CALL wrk_alloc( jpi,jpj, Cx_n10, sqrt_Cd_n10, zeta_u, stab ) 129 CALL wrk_alloc( jpi,jpj, zpsi_h_u, ztmp0, ztmp1, ztmp2 ) 119 REAL(wp), DIMENSION(jpi,jpj) :: Cx_n10 ! 10m neutral latent/sensible coefficient 120 REAL(wp), DIMENSION(jpi,jpj) :: sqrt_Cd_n10 ! root square of Cd_n10 121 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 122 REAL(wp), DIMENSION(jpi,jpj) :: zpsi_h_u 123 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 124 REAL(wp), DIMENSION(jpi,jpj) :: stab ! stability test integer 125 !!---------------------------------------------------------------------------------- 130 126 ! 131 127 l_zt_equal_zu = .FALSE. … … 223 219 END DO 224 220 ! 225 CALL wrk_dealloc( jpi,jpj, Cx_n10, sqrt_Cd_n10, zeta_u, stab )226 CALL wrk_dealloc( jpi,jpj, zpsi_h_u, ztmp0, ztmp1, ztmp2 )227 !228 221 END SUBROUTINE turb_ncar 229 222 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r9124 r9125 25 25 USE in_out_manager ! I/O manager 26 26 USE lib_mpp ! distribued memory computing library 27 USE timing ! Timing 27 28 USE lbclnk ! ocean lateral boundary conditions 28 29 USE lib_fortran ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r9124 r9125 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 daymod ! calendar 22 21 USE fldread ! read input fields … … 155 154 !!--------------------------------------------------------------------- 156 155 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 157 REAL(wp), DIMENSION( :,:), POINTER:: ztmp1, ztmp2156 REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 158 157 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 159 158 INTEGER :: ji, jj, jl, jk ! dummy loop indices 160 159 !!--------------------------------------------------------------------- 161 !162 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 )163 160 ! 164 161 IF(lwp) WRITE(numout,*)'cice_sbc_init' … … 272 269 ENDIF 273 270 ! 274 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )275 !276 271 END SUBROUTINE cice_sbc_init 277 272 … … 286 281 ! 287 282 INTEGER :: ji, jj, jl ! dummy loop indices 288 REAL(wp), DIMENSION( :,:), POINTER:: ztmp, zpice289 REAL(wp), DIMENSION( :,:,:), POINTER:: ztmpn283 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, zpice 284 REAL(wp), DIMENSION(jpi,jpj,ncat) :: ztmpn 290 285 REAL(wp) :: zintb, zintn ! dummy argument 291 286 !!--------------------------------------------------------------------- 292 287 ! 293 CALL wrk_alloc( jpi,jpj, ztmp, zpice )294 CALL wrk_alloc( jpi,jpj,ncat, ztmpn )295 296 288 IF( kt == nit000 ) THEN 297 289 IF(lwp) WRITE(numout,*)'cice_sbc_in' … … 492 484 END DO 493 485 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 494 495 CALL wrk_dealloc( jpi,jpj, ztmp, zpice )496 CALL wrk_dealloc( jpi,jpj,ncat, ztmpn )497 486 ! 498 487 END SUBROUTINE cice_sbc_in … … 508 497 509 498 INTEGER :: ji, jj, jl ! dummy loop indices 510 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 511 !!--------------------------------------------------------------------- 512 ! 513 CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 514 499 REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 500 !!--------------------------------------------------------------------- 501 ! 515 502 IF( kt == nit000 ) THEN 516 503 IF(lwp) WRITE(numout,*)'cice_sbc_out' … … 660 647 snwice_mass_b(:,:) = snwice_mass(:,:) 661 648 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 662 663 ! Release work space664 665 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )666 649 ! 667 650 END SUBROUTINE cice_sbc_out -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r9023 r9125 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 ! !-------------------! … … 169 167 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 170 168 ENDIF 171 !172 CALL wrk_dealloc( jpi,jpj, ztfrz)173 169 ! 174 170 END SUBROUTINE sbc_rnf -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
r9023 r9125 16 16 USE ioipsl ! NetCDF IPSL library 17 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 18 USE wrk_nemo !19 18 20 19 IMPLICIT NONE … … 140 139 INTEGER :: inum ! Logical unit of input file 141 140 INTEGER :: ji, jj, itide ! dummy loop indices 142 REAL(wp), POINTER, DIMENSION(:,:) :: ztr, zti !: workspace to read in tidal harmonics data141 REAL(wp), DIMENSION(jpi,jpj) :: ztr, zti !: workspace to read in tidal harmonics data 143 142 !!---------------------------------------------------------------------- 144 143 IF(lwp) THEN … … 147 146 WRITE(numout,*) '~~~~~~~~~~~~~~ ' 148 147 ENDIF 149 !150 CALL wrk_alloc( jpi, jpj, zti, ztr )151 148 ! 152 149 CALL iom_open ( cn_tide_load , inum ) … … 166 163 CALL iom_close( inum ) 167 164 ! 168 CALL wrk_dealloc( jpi, jpj, zti, ztr )169 !170 165 END SUBROUTINE tide_init_load 171 166 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r9117 r9125 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 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r9101 r9125 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 … … 253 252 ! 254 253 INTEGER :: ji, jj, jk, isum 255 REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk 256 !!---------------------------------------------------------------------- 257 258 CALL wrk_alloc( jpi, jpj, zvlmsk ) 254 REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk 255 !!---------------------------------------------------------------------- 259 256 260 257 ! I. Definition of control surface and associated fields … … 280 277 281 278 END IF 282 !283 CALL wrk_dealloc( jpi, jpj, zvlmsk )284 279 ! 285 280 END SUBROUTINE trd_mxl_zint … … 339 334 ! ! z(ts)mltot : dT/dt over the anlysis window (including Asselin) 340 335 ! ! z(ts)mlres : residual = dh/dt entrainment term 341 REAL(wp), POINTER, DIMENSION(:,: ):: ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf342 REAL(wp), POINTER, DIMENSION(:,: ):: ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2343 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics336 REAL(wp), DIMENSION(jpi,jpj ) :: ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf 337 REAL(wp), DIMENSION(jpi,jpj ) :: ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 338 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 344 339 !!---------------------------------------------------------------------- 345 340 346 CALL wrk_alloc( jpi, jpj, ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf )347 CALL wrk_alloc( jpi, jpj, ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 )348 CALL wrk_alloc( jpi, jpj, jpltrd, ztmltrd2, zsmltrd2 )349 350 341 ! ====================================================================== 351 342 ! II. Cumulate the trends over the analysis window … … 719 710 IF( lrst_oce ) CALL trd_mxl_rst_write( kt ) 720 711 721 CALL wrk_dealloc( jpi, jpj, ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf )722 CALL wrk_dealloc( jpi, jpj, ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 )723 CALL wrk_dealloc( jpi, jpj, jpltrd, ztmltrd2, zsmltrd2 )724 712 ! 725 713 END SUBROUTINE trd_mxl -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r9019 r9125 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 … … 70 69 ! 71 70 INTEGER :: jk ! dummy loop indices 72 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace73 REAL(wp), POINTER, DIMENSION(:,:,:):: zpe ! 3D workspace71 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! 2D workspace 72 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpe ! 3D workspace 74 73 !!---------------------------------------------------------------------- 75 74 ! 76 CALL wrk_alloc( jpi, jpj, jpk, zpe )77 75 zpe(:,:,:) = 0._wp 78 76 ! … … 96 94 CASE ( jptra_zad ) ; CALL iom_put( "petrd_zad", zpe ) ! vertical advection 97 95 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 98 CALL wrk_alloc( jpi, jpj, z2d)96 ALLOCATE( z2d(jpi,jpj) ) 99 97 z2d(:,:) = wn(:,:,1) * ( & 100 98 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem) & … … 102 100 & ) / e3t_n(:,:,1) 103 101 CALL iom_put( "petrd_sad" , z2d ) 104 CALL wrk_dealloc( jpi, jpj,z2d )102 DEALLOCATE( z2d ) 105 103 ENDIF 106 104 CASE ( jptra_ldf ) ; CALL iom_put( "petrd_ldf" , zpe ) ! lateral diffusion … … 115 113 CASE ( jptra_atf ) ; CALL iom_put( "petrd_atf" , zpe ) ! asselin time filter (last trend) 116 114 !IF( ln_linssh ) THEN ! cst volume : ssh term (otherwise include in e3t variation) 117 ! CALL wrk_alloc( jpi, jpj, z2d)115 ! ALLOCATE( z2d(jpi,jpj) ) 118 116 ! z2d(:,:) = ( ssha(:,:) - sshb(:,:) ) & 119 117 ! & * ( dPE_dt(:,:,1) * tsn(:,:,1,jp_tem) & 120 118 ! & + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal) ) / ( e3t_n(:,:,1) * pdt ) 121 119 ! CALL iom_put( "petrd_sad" , z2d ) 122 ! CALL wrk_dealloc( jpi, jpj,z2d )120 ! DEALLOCATE( z2d ) 123 121 !ENDIF 124 122 ! 125 123 END SELECT 126 124 ! 127 CALL wrk_dealloc( jpi, jpj, jpk, zpe )128 125 ! 129 126 END SUBROUTINE trd_pen -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r9097 r9125 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 !!---------------------------------------------------------------------- 97 94 98 95 SELECT CASE( ktrd ) … … 122 119 END SELECT 123 120 ! 124 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv )125 !126 121 END SUBROUTINE trd_vor 127 122 … … 160 155 INTEGER :: ji, jj ! dummy loop indices 161 156 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 157 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 158 !!---------------------------------------------------------------------- 159 167 160 ! 168 161 … … 210 203 CALL FLUSH(numout) 211 204 ENDIF 212 !213 CALL wrk_dealloc( jpi, jpj, zudpvor, zvdpvor )214 205 ! 215 206 END SUBROUTINE trd_vor_zint_2d … … 249 240 ! 250 241 INTEGER :: ji, jj, jk ! dummy loop indices 251 REAL(wp), POINTER, DIMENSION(:,:) :: zubet , zvbet ! Beta.V252 REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends242 REAL(wp), DIMENSION(jpi,jpj) :: zubet , zvbet ! Beta.V 243 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 253 244 !!---------------------------------------------------------------------- 254 245 255 CALL wrk_alloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )256 257 246 ! Initialization 258 247 zubet (:,:) = 0._wp … … 306 295 ENDIF 307 296 ! 308 CALL wrk_dealloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )309 !310 297 END SUBROUTINE trd_vor_zint_3d 311 298 … … 323 310 INTEGER :: it, itmod ! local integers 324 311 REAL(wp) :: zmean ! local scalars 325 REAL(wp), POINTER, DIMENSION(:,:) :: zun, zvn 326 !!---------------------------------------------------------------------- 327 328 CALL wrk_alloc( jpi, jpj, zun, zvn ) 312 REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn 313 !!---------------------------------------------------------------------- 329 314 330 315 ! ================= … … 458 443 IF( kt == nitend ) CALL histclo( nidvor ) 459 444 ! 460 CALL wrk_dealloc( jpi, jpj, zun, zvn )461 !462 445 END SUBROUTINE trd_vor_iom 463 446 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90
r9124 r9125 23 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 24 USE lib_mpp ! distributed memory computing library 25 USE wrk_nemo ! Memory allocation26 25 27 26 IMPLICIT NONE -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfiwm.F90
r9104 r9125 27 27 USE iom ! I/O Manager 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 30
Note: See TracChangeset
for help on using the changeset viewer.
