Changeset 9125
- Timestamp:
- 2017-12-19T09:47:17+01:00 (7 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM
- Files:
-
- 1 deleted
- 79 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_zgr.F90
r9089 r9125 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 25 USE lib_mpp ! distributed memory computing library 26 USE wrk_nemo ! Memory allocation27 26 USE timing ! Timing 28 27 -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_zgr.F90
r7188 r9125 21 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 22 USE lib_mpp ! distributed memory computing library 23 USE wrk_nemo ! Memory allocation24 23 USE timing ! Timing 25 24 -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_zgr.F90
r7188 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 USE timing ! Timing 27 26 -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/VORTEX/MY_SRC/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/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90
r9124 r9125 29 29 USE lib_mpp ! for mpp_sum 30 30 USE iom ! I/O 31 USE wrk_nemo ! Memory Allocation32 31 33 32 IMPLICIT NONE … … 148 147 INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b ! Flags for boundaries receiving 149 148 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 150 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat)149 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 151 150 !! 152 151 CHARACTER(LEN=1) :: ctypebdy ! - - … … 1189 1188 ! For the flagu/flagv calculation below we require a version of fmask without 1190 1189 ! the land boundary condition (shlat) included: 1191 CALL wrk_alloc(jpi,jpj, zfmask )1192 1190 DO ij = 2, jpjm1 1193 1191 DO ii = 2, jpim1 … … 1318 1316 IF( nb_bdy>0 ) DEALLOCATE( nbidta, nbjdta, nbrdta ) 1319 1317 ! 1320 CALL wrk_dealloc(jpi,jpj, zfmask )1321 1318 ! 1322 1319 END SUBROUTINE bdy_segs -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90
r9124 r9125 45 45 USE lbclnk ! ocean lateral boundary condition (or mpp link) 46 46 USE lib_mpp ! distributed memory computing library 47 USE wrk_nemo ! Memory Allocation48 47 49 48 IMPLICIT NONE -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90
r9124 r9125 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 25 USE lib_mpp ! distributed memory computing library 26 USE wrk_nemo ! Memory allocation27 26 28 27 IMPLICIT NONE -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r9124 r9125 40 40 USE prtctl ! print control 41 41 USE fldread ! read input fields 42 USE wrk_nemo ! Memory allocation43 42 USE timing ! Timing 44 43 USE trc, ONLY : ln_rsttr, numrtr, numrtw, lrst_trc … … 108 107 INTEGER, INTENT(in) :: kt ! ocean time-step index 109 108 INTEGER :: ji, jj, jk 110 REAL(wp), POINTER, DIMENSION(:,:) :: zemp109 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zemp 111 110 !!---------------------------------------------------------------------- 112 111 ! … … 139 138 ! 140 139 IF( .NOT.ln_linssh ) THEN 141 CALL wrk_alloc(jpi, jpj, zemp)140 ALLOCATE( zemp(jpi,jpj) ) 142 141 zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:) ! effective u-transport 143 142 emp_b (:,:) = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1) ! E-P 144 143 zemp (:,:) = 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr * tmask(:,:,1) 145 144 CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) ) != ssh, vertical scale factor & vertical transport 146 CALL wrk_dealloc(jpi, jpj,zemp )145 DEALLOCATE( zemp ) 147 146 ! Write in the tracer restart file 148 147 ! ******************************* … … 587 586 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 588 587 INTEGER :: iswap 589 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuslp, zvslp, zwslpi, zwslpj588 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuslp, zvslp, zwslpi, zwslpj 590 589 !!--------------------------------------------------------------------- 591 !592 CALL wrk_alloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj )593 590 ! 594 591 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) … … 660 657 ENDIF 661 658 ! 662 CALL wrk_dealloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj )663 !664 659 END SUBROUTINE dta_dyn_slp 665 660 -
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 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r9124 r9125 43 43 USE lib_mpp ! MPP library 44 44 USE timing ! preformance summary 45 USE wrk_nemo ! working array46 45 47 46 IMPLICIT NONE -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/C14/trcatm_c14.F90
r9124 r9125 45 45 REAL(wp) :: yn20 = 20. ! 20 degrees north 46 46 REAL(wp) :: yn40 = 40. ! 40 degrees north 47 REAL(wp), POINTER, DIMENSION(:) :: zco2, zyrco2 ! temporary arrays for swap47 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zco2, zyrco2 ! temporary arrays for swap 48 48 ! 49 49 !!---------------------------------------------------------------------- … … 78 78 ! 79 79 IF(kc14typ==2) THEN 80 CALL wrk_alloc( nrecco2,zco2) 81 CALL wrk_alloc( nrecco2,zyrco2) 80 ALLOCATE( zco2(nrecco2), zyrco2(nrecco2) ) 82 81 zco2(:)=spco2(:) 83 82 zyrco2(:)=tyrco2(:) … … 88 87 tyrco2(izco2)=1950._wp-zyrco2(jn) ! BP to AD dates 89 88 END DO 90 CALL wrk_dealloc(nrecco2,zco2) 91 CALL wrk_dealloc(nrecco2,zyrco2) 89 DEALLOCATE( zco2,zyrco2 ) 92 90 ENDIF 93 91 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/C14/trcwri_c14.F90
r7068 r9125 36 36 INTEGER :: ji,jj,jk,jn ! dummy loop indexes 37 37 REAL(wp) :: zage,zarea,ztemp ! temporary 38 REAL(wp), POINTER, DIMENSION(:,:) :: zres, z2d ! temporary storage 2D39 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d , zz3d ! temporary storage 3D38 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zres, z2d ! temporary storage 2D 39 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d , zz3d ! temporary storage 3D 40 40 !!--------------------------------------------------------------------- 41 41 … … 50 50 IF( iom_use("DeltaC14") .OR. iom_use("C14Age") .OR. iom_use("RAge") ) THEN 51 51 ! 52 CALL wrk_alloc( jpi, jpj , z2d, zres)53 CALL wrk_alloc( jpi, jpj, jpk, z3d, zz3d)52 ALLOCATE( z2d(jpi,jpj), zres(jpi,jpj) ) 53 ALLOCATE( z3d(jpi,jpj,jpk), zz3d(jpi,jpj,jpk) ) 54 54 ! 55 55 zage = -1._wp / rlam14 / rsiyea ! factor for radioages in year … … 87 87 CALL iom_put( "RAge" , zage * z2d(:,:) ) ! Reservoir age [yr] 88 88 ! 89 CALL wrk_dealloc( jpi, jpj , z2d, zres ) 90 CALL wrk_dealloc( jpi, jpj, jpk, z3d, zz3d ) 89 DEALLOCATE( z2d, zres, z3d, zz3d ) 91 90 ! 92 91 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r9124 r9125 43 43 INTEGER, INTENT(in) :: kt ! ocean time-step index 44 44 INTEGER :: jn ! dummy loop index 45 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt45 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt 46 46 !!---------------------------------------------------------------------- 47 47 ! … … 52 52 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 53 53 54 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrmyt)54 IF( l_trdtrc ) ALLOCATE( ztrmyt(jpi,jpj,jpk) ) 55 55 56 56 CALL trc_bc ( kt ) ! tracers: surface and lateral Boundary Conditions … … 64 64 CALL trd_trc( ztrmyt, jn, jptra_sms, kt ) ! save trends 65 65 END DO 66 CALL wrk_dealloc( jpi, jpj, jpk,ztrmyt )66 DEALLOCATE( ztrmyt ) 67 67 END IF 68 68 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r9124 r9125 96 96 REAL(wp) :: znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 97 97 REAL(wp) :: ze3t 98 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw2d99 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zw3d98 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw2d 99 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zw3d 100 100 CHARACTER (len=25) :: charout 101 101 !!--------------------------------------------------------------------- … … 103 103 IF( ln_timing ) CALL timing_start('p2z_bio') 104 104 ! 105 IF( lk_iomput ) THEN 106 CALL wrk_alloc( jpi, jpj, 17, zw2d ) 107 CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d ) 108 ENDIF 105 IF( lk_iomput ) ALLOCATE( zw2d(jpi,jpj,17), zw3d(jpi,jpj,jpk,3) ) 109 106 110 107 IF( kt == nittrc000 ) THEN … … 377 374 ENDIF 378 375 ! 379 IF( lk_iomput ) THEN 380 CALL wrk_dealloc( jpi, jpj, 17, zw2d ) 381 CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d ) 382 ENDIF 376 IF( lk_iomput ) DEALLOCATE( zw2d, zw3d ) 383 377 ! 384 378 IF( ln_timing ) CALL timing_stop('p2z_bio') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r9124 r9125 64 64 INTEGER :: ji, jj, jk, jl, ikt 65 65 REAL(wp) :: zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt 66 REAL(wp), POINTER, DIMENSION(:,:) :: zsedpoca66 REAL(wp), DIMENSION(jpi,jpj) :: zsedpoca 67 67 CHARACTER (len=25) :: charout 68 68 !!--------------------------------------------------------------------- … … 72 72 IF( kt == nittrc000 ) CALL p2z_exp_init 73 73 74 CALL wrk_alloc( jpi, jpj, zsedpoca )75 74 zsedpoca(:,:) = 0. 76 75 … … 147 146 ENDIF 148 147 ! 149 CALL wrk_dealloc( jpi, jpj, zsedpoca) ! temporary save of trends150 151 148 IF(ln_ctl) THEN ! print mean trends (used for debugging) 152 149 WRITE(charout, FMT="('exp')") … … 167 164 INTEGER :: ji, jj, jk 168 165 REAL(wp) :: zmaskt, zfluo, zfluu 169 REAL(wp), POINTER, DIMENSION(:,: ) ::zrro170 REAL(wp), POINTER, DIMENSION(:,:,:) ::zdm0166 REAL(wp), DIMENSION(jpi,jpj ) :: zrro 167 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm0 171 168 !!--------------------------------------------------------------------- 172 169 ! … … 178 175 ENDIF 179 176 ! 180 ! Allocate temporary workspace181 CALL wrk_alloc( jpi, jpj, zrro )182 CALL wrk_alloc( jpi, jpj, jpk, zdm0 )183 184 177 185 178 ! Calculate vertical distribution of newly formed biogenic poc … … 247 240 ENDIF 248 241 ! 249 CALL wrk_dealloc( jpi, jpj, zrro )250 CALL wrk_dealloc( jpi, jpj, jpk, zdm0 )251 !252 242 END SUBROUTINE p2z_exp_init 253 243 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r9124 r9125 67 67 REAL(wp) :: zkr, zkg ! total absorption coefficient in red and green 68 68 REAL(wp) :: zcoef ! temporary scalar 69 REAL(wp), POINTER, DIMENSION(:,:) :: zpar100, zpar0m70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zparr, zparg69 REAL(wp), DIMENSION(jpi,jpj ) :: zpar100, zpar0m 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg 71 71 !!--------------------------------------------------------------------- 72 72 ! 73 73 IF( ln_timing ) CALL timing_start('p2z_opt') 74 74 ! 75 ! Allocate temporary workspace76 CALL wrk_alloc( jpi, jpj, zpar100, zpar0m )77 CALL wrk_alloc( jpi, jpj, jpk, zparr, zparg )78 75 79 76 IF( kt == nittrc000 ) THEN … … 142 139 ENDIF 143 140 ! 144 CALL wrk_dealloc( jpi, jpj, zpar100, zpar0m )145 CALL wrk_dealloc( jpi, jpj, jpk, zparr, zparg )146 !147 141 IF( ln_timing ) CALL timing_stop('p2z_opt') 148 142 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r9124 r9125 59 59 INTEGER :: ji, jj, jk, jl, ierr 60 60 CHARACTER (len=25) :: charout 61 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d62 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra61 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork, ztra 63 63 !!--------------------------------------------------------------------- 64 64 ! … … 70 70 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 71 71 ENDIF 72 73 ! Allocate temporary workspace74 CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )75 72 76 73 ! sedimentation of detritus : upstream scheme … … 98 95 IF( lk_iomput ) THEN 99 96 IF( iom_use( "TDETSED" ) ) THEN 100 CALL wrk_alloc( jpi, jpj, zw2d)97 ALLOCATE( zw2d(jpi,jpj) ) 101 98 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 102 99 DO jk = 2, jpkm1 … … 104 101 END DO 105 102 CALL iom_put( "TDETSED", zw2d ) 106 CALL wrk_dealloc( jpi, jpj,zw2d )103 DEALLOCATE( zw2d ) 107 104 ENDIF 108 105 ENDIF 109 !110 CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )111 106 ! 112 107 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r9124 r9125 564 564 LOGICAL :: l_exitnow 565 565 REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 566 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin566 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 567 567 568 568 IF( ln_timing ) CALL timing_start('solve_at_general') 569 ! Allocate temporary workspace570 CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )571 CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )572 569 573 570 CALL anw_infsup( zalknw_inf, zalknw_sup ) … … 799 796 END DO 800 797 ! 801 CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )802 CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )803 804 798 805 799 IF( ln_timing ) CALL timing_stop('solve_at_general') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r9124 r9125 74 74 REAL(wp) :: dissol, zligco 75 75 CHARACTER (len=25) :: charout 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig, precip77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1,zFeL2, zTL2, zFe2, zFeP78 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zstrn276 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTL1, zFe3, ztotlig, precip, zFeL1 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zFeL2, zTL2, zFe2, zFeP 78 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zstrn, zstrn2 79 79 !!--------------------------------------------------------------------- 80 80 ! 81 81 IF( ln_timing ) CALL timing_start('p4z_fechem') 82 82 ! 83 ! Allocate temporary workspace84 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )85 83 zFe3 (:,:,:) = 0. 86 84 zFeL1(:,:,:) = 0. 87 85 zTL1 (:,:,:) = 0. 88 86 IF( ln_fechem ) THEN 89 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2)90 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP)87 ALLOCATE( zstrn(jpi,jpj), zstrn2(jpi,jpj) ) 88 ALLOCATE( zFe2(jpi,jpj,jpk), zFeL2(jpi,jpj,jpk), zTL2(jpi,jpj,jpk), zFeP(jpi,jpj,jpk) ) 91 89 zFe2 (:,:,:) = 0. 92 90 zFeL2(:,:,:) = 0. … … 360 358 ENDIF 361 359 ! 362 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )363 360 IF( ln_fechem ) THEN 364 CALL wrk_dealloc( jpi, jpj,zstrn, zstrn2 )365 CALL wrk_dealloc( jpi, jpj, jpk,zFe2, zFeL2, zTL2, zFeP )361 DEALLOCATE( zstrn, zstrn2 ) 362 DEALLOCATE( zFe2, zFeL2, zTL2, zFeP ) 366 363 ENDIF 367 364 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r9124 r9125 80 80 REAL(wp) :: zyr_dec, zdco2dt 81 81 CHARACTER (len=25) :: charout 82 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d, zpco2atm 82 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3, zoflx, zpco2atm 83 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d 83 84 !!--------------------------------------------------------------------- 84 85 ! 85 86 IF( ln_timing ) CALL timing_start('p4z_flx') 86 !87 CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm )88 87 ! 89 88 … … 187 186 188 187 IF( lk_iomput .AND. knt == nrdttrc ) THEN 189 CALL wrk_alloc( jpi, jpj, zw2d)188 ALLOCATE( zw2d(jpi,jpj) ) 190 189 IF( iom_use( "Cflx" ) ) THEN 191 190 zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r … … 211 210 CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum ) ! molC 212 211 ! 213 CALL wrk_dealloc( jpi, jpj, zw2d ) 214 ENDIF 215 ! 216 CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm ) 212 DEALLOCATE( zw2d ) 213 ENDIF 217 214 ! 218 215 IF( ln_timing ) CALL timing_stop('p4z_flx') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r9124 r9125 62 62 REAL(wp) :: zomegaca, zexcess, zexcess0 63 63 CHARACTER (len=25) :: charout 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3, zcaldiss, zhinit, zhi, zco3sat 65 65 !!--------------------------------------------------------------------- 66 66 ! 67 67 IF( ln_timing ) CALL timing_start('p4z_lys') 68 !69 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )70 68 ! 71 69 zco3 (:,:,:) = 0. … … 139 137 ENDIF 140 138 ! 141 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )142 !143 139 IF( ln_timing ) CALL timing_stop('p4z_lys') 144 140 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r9124 r9125 72 72 REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 73 73 CHARACTER (len=25) :: charout 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 75 76 76 77 !!--------------------------------------------------------------------- … … 78 79 IF( ln_timing ) CALL timing_start('p4z_meso') 79 80 ! 80 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )81 81 zgrazing(:,:,:) = 0._wp 82 82 … … 220 220 ! 221 221 IF( lk_iomput .AND. knt == nrdttrc ) THEN 222 CALL wrk_alloc( jpi, jpj, jpk, zw3d)222 ALLOCATE( zw3d(jpi,jpj,jpk) ) 223 223 IF( iom_use( "GRAZ2" ) ) THEN 224 224 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton … … 229 229 CALL iom_put( "PCAL", zw3d ) 230 230 ENDIF 231 CALL wrk_dealloc( jpi, jpj, jpk,zw3d )231 DEALLOCATE( zw3d ) 232 232 ENDIF 233 233 ! … … 237 237 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 238 238 ENDIF 239 !240 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )241 239 ! 242 240 IF( ln_timing ) CALL timing_stop('p4z_meso') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r9124 r9125 69 69 REAL(wp) :: zgrazp, zgrazm, zgrazsd 70 70 REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d 71 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing 72 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d 72 73 CHARACTER (len=25) :: charout 73 74 !!--------------------------------------------------------------------- 74 75 ! 75 76 IF( ln_timing ) CALL timing_start('p4z_micro') 76 !77 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )78 77 ! 79 78 DO jk = 1, jpkm1 … … 177 176 IF( lk_iomput ) THEN 178 177 IF( knt == nrdttrc ) THEN 179 CALL wrk_alloc( jpi, jpj, jpk, zw3d)178 ALLOCATE( zw3d(jpi,jpj,jpk) ) 180 179 IF( iom_use( "GRAZ1" ) ) THEN 181 180 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 182 181 CALL iom_put( "GRAZ1", zw3d ) 183 182 ENDIF 184 CALL wrk_dealloc( jpi, jpj, jpk,zw3d )183 DEALLOCATE( zw3d ) 185 184 ENDIF 186 185 ENDIF … … 191 190 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 192 191 ENDIF 193 !194 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )195 192 ! 196 193 IF( ln_timing ) CALL timing_stop('p4z_micro') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r9124 r9125 64 64 REAL(wp) :: zchl 65 65 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 66 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp467 REAL(wp), POINTER, DIMENSION(:,: ) :: zetmp568 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr100, zqsr_corr69 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d66 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zetmp5 67 REAL(wp), DIMENSION(jpi,jpj ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 68 REAL(wp), DIMENSION(jpi,jpj ) :: zqsr100, zqsr_corr 69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpar, ze0, ze1, ze2, ze3, zchl3d 70 70 !!--------------------------------------------------------------------- 71 71 ! … … 73 73 ! 74 74 ! Allocate temporary workspace 75 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 76 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr ) 77 IF( ln_p5z ) CALL wrk_alloc( jpi, jpj, zetmp5 ) 78 CALL wrk_alloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d ) 75 IF( ln_p5z ) ALLOCATE( zetmp5(jpi,jpj) ) 79 76 80 77 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) … … 243 240 ENDIF 244 241 ! 245 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 246 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr ) 247 IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj, zetmp5 ) 248 CALL wrk_dealloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d ) 242 IF( ln_p5z ) DEALLOCATE( zetmp5 ) 249 243 ! 250 244 IF( ln_timing ) CALL timing_stop('p4z_opt') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r9124 r9125 63 63 REAL(wp) :: zrfact2 64 64 CHARACTER (len=25) :: charout 65 REAL(wp), POINTER, DIMENSION(:,:) :: totprod, totthick, totcons66 REAL(wp), POINTER, DIMENSION(:,:,:) :: zremipoc, zremigoc, zorem3, ztremint67 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: alphag65 REAL(wp), DIMENSION(jpi,jpj ) :: totprod, totthick, totcons 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zremipoc, zremigoc, zorem3, ztremint 67 REAL(wp), DIMENSION(jpi,jpj,jpk,jcpoc) :: alphag 68 68 !!--------------------------------------------------------------------- 69 69 ! 70 70 IF( ln_timing ) CALL timing_start('p4z_poc') 71 71 ! 72 ! Allocate temporary workspace73 CALL wrk_alloc( jpi, jpj, totprod, totthick, totcons )74 CALL wrk_alloc( jpi, jpj, jpk, zremipoc, zremigoc, zorem3, ztremint )75 ALLOCATE( alphag(jpi,jpj,jpk,jcpoc) )76 77 72 ! Initialization of local variables 78 73 ! --------------------------------- … … 465 460 ENDIF 466 461 ! 467 CALL wrk_dealloc( jpi, jpj, totprod, totthick, totcons )468 CALL wrk_dealloc( jpi, jpj, jpk, zremipoc, zremigoc, zorem3, ztremint )469 DEALLOCATE( alphag )470 462 ! 471 463 IF( ln_timing ) CALL timing_stop('p4z_poc') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r9124 r9125 76 76 REAL(wp) :: zfact 77 77 CHARACTER (len=25) :: charout 78 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zw2d, zmixnano, zmixdiat 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 80 REAL(wp), DIMENSION(jpi,jpj ) :: zstrn, zmixnano, zmixdiat 81 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadd, zysopt 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprdia, zprbio, zprdch, zprnch 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcad, zprofed, zprofen 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewd 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl 84 86 !!--------------------------------------------------------------------- 85 87 ! … … 87 89 ! 88 90 ! Allocate temporary workspace 89 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn )90 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )91 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )92 CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )93 91 ! 94 92 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp … … 367 365 IF( lk_iomput ) THEN 368 366 IF( knt == nrdttrc ) THEN 369 CALL wrk_alloc( jpi, jpj, zw2d ) 370 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 367 ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) ) 371 368 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 372 369 ! … … 469 466 IF( iom_use( "tintpp" ) ) CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s 470 467 ! 471 CALL wrk_dealloc( jpi, jpj, zw2d ) 472 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 468 DEALLOCATE( zw2d, zw3d ) 473 469 ENDIF 474 470 ENDIF … … 479 475 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 480 476 ENDIF 481 !482 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn )483 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )484 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )485 CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )486 477 ! 487 478 IF( ln_timing ) CALL timing_stop('p4z_prod') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r9124 r9125 67 67 REAL(wp) :: zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp 68 68 CHARACTER (len=25) :: charout 69 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zfacsi, zw3d, zfacsib 69 REAL(wp), DIMENSION(jpi,jpj ) :: ztempbac 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zolimi, zdepprod, zfacsi, zfacsib 71 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 71 72 !!--------------------------------------------------------------------- 72 73 ! 73 74 IF( ln_timing ) CALL timing_start('p4z_rem') 74 75 ! 75 ! Allocate temporary workspace 76 CALL wrk_alloc( jpi, jpj, ztempbac ) 77 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib ) 78 79 ! Initialisation of temprary arrys 76 ! Initialisation of arrys 80 77 zdepprod(:,:,:) = 1._wp 81 78 ztempbac(:,:) = 0._wp … … 270 267 271 268 IF( knt == nrdttrc ) THEN 272 CALL wrk_alloc( jpi, jpj, jpk, zw3d)269 ALLOCATE( zw3d(jpi,jpj,jpk) ) 273 270 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 274 271 ! … … 282 279 ENDIF 283 280 ! 284 CALL wrk_dealloc( jpi, jpj, jpk,zw3d )281 DEALLOCATE( zw3d ) 285 282 ENDIF 286 !287 CALL wrk_dealloc( jpi, jpj, ztempbac )288 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib )289 283 ! 290 284 IF( ln_timing ) CALL timing_stop('p4z_rem') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r9124 r9125 62 62 ! 63 63 CHARACTER (len=25) :: charout 64 REAL(wp), POINTER, DIMENSION(:,: ) :: zsidep, zwork1, zwork2, zwork3 65 REAL(wp), POINTER, DIMENSION(:,: ) :: zdenit2d, zironice, zbureff 66 REAL(wp), POINTER, DIMENSION(:,: ) :: zwsbio3, zwsbio4, zwscal 67 REAL(wp), POINTER, DIMENSION(:,: ) :: zsedcal, zsedsi, zsedc 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zsoufer, zpdep, zlight 69 REAL(wp), POINTER, DIMENSION(:,: ) :: zwsfep 64 REAL(wp), DIMENSION(jpi,jpj ) :: zwork1, zwork2, zwork3 65 REAL(wp), DIMENSION(jpi,jpj ) :: zdenit2d, zbureff 66 REAL(wp), DIMENSION(jpi,jpj ) :: zwsbio3, zwsbio4, zwscal 67 REAL(wp), DIMENSION(jpi,jpj ) :: zsedcal, zsedsi, zsedc 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight 69 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep 70 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zsidep, zwsfep, zironice 70 71 !!--------------------------------------------------------------------- 71 72 ! … … 75 76 ! 76 77 ! Allocate temporary workspace 77 CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 78 CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 79 CALL wrk_alloc( jpi, jpj, zsedcal, zsedsi, zsedc ) 80 CALL wrk_alloc( jpi, jpj, jpk, zlight, zsoufer ) 81 IF( ln_p5z ) CALL wrk_alloc( jpi, jpj, jpk, ztrpo4, ztrdop ) 82 IF( ln_ligand ) CALL wrk_alloc( jpi, jpj, zwsfep ) 78 IF( ln_p5z ) ALLOCATE( ztrpo4(jpi,jpj,jpk), ztrdop(jpi,jpj,jpk) ) 79 IF( ln_ligand ) ALLOCATE( zwsfep(jpi,jpj) ) 83 80 84 81 … … 97 94 IF( ln_ironice ) THEN 98 95 ! 99 CALL wrk_alloc( jpi, jpj, zironice)96 ALLOCATE( zironice(jpi,jpj) ) 100 97 ! 101 98 DO jj = 1, jpj … … 114 111 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 115 112 ! 116 CALL wrk_dealloc( jpi, jpj,zironice )113 DEALLOCATE( zironice ) 117 114 ! 118 115 ENDIF … … 122 119 IF( ln_dust ) THEN 123 120 ! 124 CALL wrk_alloc( jpi, jpj, zsidep)125 CALL wrk_alloc( jpi, jpj, jpk, zpdep, zirondep)121 ALLOCATE( zsidep(jpi,jpj) ) 122 ALLOCATE( zpdep(jpi,jpj,jpk), zirondep(jpi,jpj,jpk) ) 126 123 ! ! Iron and Si deposition at the surface 127 124 IF( ln_solub ) THEN … … 152 149 ENDIF 153 150 ENDIF 154 CALL wrk_dealloc( jpi, jpj,zsidep )155 CALL wrk_dealloc( jpi, jpj, jpk, zpdep, zirondep)151 DEALLOCATE( zsidep ) 152 DEALLOCATE( zpdep, zirondep ) 156 153 ! 157 154 ENDIF … … 514 511 ENDIF 515 512 ! 516 CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 517 CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 518 CALL wrk_dealloc( jpi, jpj, zsedcal, zsedsi, zsedc ) 519 CALL wrk_dealloc( jpi, jpj, jpk, zlight, zsoufer ) 520 IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj, jpk, ztrpo4, ztrdop ) 521 IF( ln_ligand ) CALL wrk_dealloc( jpi, jpj, zwsfep ) 513 IF( ln_p5z ) DEALLOCATE( ztrpo4, ztrdop ) 514 IF( ln_ligand ) DEALLOCATE( zwsfep ) 522 515 ! 523 516 IF( ln_timing ) CALL timing_stop('p4z_sed') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r9124 r9125 65 65 REAL(wp) :: zfact, zwsmax, zmax 66 66 CHARACTER (len=25) :: charout 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d68 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d67 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 68 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d 69 69 !!--------------------------------------------------------------------- 70 70 ! … … 212 212 IF( lk_iomput ) THEN 213 213 IF( knt == nrdttrc ) THEN 214 CALL wrk_alloc( jpi, jpj, zw2d ) 215 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 214 ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) ) 216 215 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 217 216 ! … … 250 249 IF( iom_use( "tcexp" ) ) CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s 251 250 ! 252 CALL wrk_dealloc( jpi, jpj, zw2d ) 253 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 251 DEALLOCATE( zw2d, zw3d ) 254 252 ENDIF 255 253 ENDIF … … 304 302 INTEGER :: ji, jj, jk, jn 305 303 REAL(wp) :: zigma,zew,zign, zflx, zstep 306 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2, ztrb304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztraz, zakz, zwsink2, ztrb 307 305 !!--------------------------------------------------------------------- 308 306 ! 309 307 IF( ln_timing ) CALL timing_start('p4z_sink2') 310 308 ! 311 ! Allocate temporary workspace312 CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb )313 314 309 zstep = rfact2 / REAL( kiter, wp ) / 2. 315 310 … … 391 386 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 392 387 ! 393 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb )394 !395 388 IF( ln_timing ) CALL timing_stop('p4z_sink2') 396 389 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r9124 r9125 420 420 CHARACTER(LEN=100) :: cltxt 421 421 INTEGER :: jk 422 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork422 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork 423 423 !!---------------------------------------------------------------------- 424 424 ! … … 437 437 ENDIF 438 438 439 CALL wrk_alloc( jpi, jpj, jpk, zwork )440 !441 439 IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 442 440 ! Compute the budget of NO3, ALK, Si, Fer … … 503 501 ENDIF 504 502 ! 505 CALL wrk_dealloc( jpi, jpj, jpk, zwork )506 !507 503 ! Global budget of N SMS : denitrification in the water column and in the sediment 508 504 ! nitrogen fixation by the diazotrophs -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmeso.F90
r9124 r9125 85 85 CHARACTER (len=25) :: charout 86 86 REAL(wp) :: zrfact2, zmetexcess 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d 87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 88 89 89 90 !!--------------------------------------------------------------------- … … 91 92 IF( ln_timing ) CALL timing_start('p5z_meso') 92 93 ! 93 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )94 94 zgrazing(:,:,:) = 0._wp 95 95 … … 342 342 ! 343 343 IF( lk_iomput .AND. knt == nrdttrc ) THEN 344 CALL wrk_alloc( jpi, jpj, jpk, zw3d)344 ALLOCATE( zw3d(jpi,jpj,jpk) ) 345 345 IF( iom_use( "GRAZ2" ) ) THEN 346 346 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton … … 351 351 CALL iom_put( "PCAL", zw3d ) 352 352 ENDIF 353 CALL wrk_dealloc( jpi, jpj, jpk,zw3d )353 DEALLOCATE( zw3d ) 354 354 ENDIF 355 355 ! … … 359 359 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 360 360 ENDIF 361 !362 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )363 361 ! 364 362 IF( ln_timing ) CALL timing_stop('p5z_meso') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmicro.F90
r9124 r9125 82 82 REAL(wp) :: zgrazdc, zgrazdn, zgrazdp, zgrazdf, zgraznf, zgrazz 83 83 REAL(wp) :: zgrazpc, zgrazpn, zgrazpp, zgrazpf, zbeta, zrfact2, zmetexcess 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing 85 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 85 86 CHARACTER (len=25) :: charout 86 87 !!--------------------------------------------------------------------- 87 88 ! 88 89 IF( ln_timing ) CALL timing_start('p5z_micro') 89 !90 CALL wrk_alloc( jpi, jpj, jpk, zgrazing )91 90 ! 92 91 zmetexcess = 0.0 … … 290 289 ! 291 290 IF( lk_iomput .AND. knt == nrdttrc ) THEN 292 CALL wrk_alloc( jpi, jpj, jpk, zw3d)291 ALLOCATE( zw3d(jpi,jpj,jpk) ) 293 292 IF( iom_use( "GRAZ1" ) ) THEN 294 293 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 295 294 CALL iom_put( "GRAZ1", zw3d ) 296 295 ENDIF 297 CALL wrk_dealloc( jpi, jpj, jpk,zw3d )296 DEALLOCATE( zw3d ) 298 297 ENDIF 299 298 ! … … 303 302 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 304 303 ENDIF 305 !306 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )307 304 ! 308 305 IF( ln_timing ) CALL timing_stop('p5z_micro') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zprod.F90
r9124 r9125 81 81 REAL(wp) :: zfact, zrfact2 82 82 CHARACTER (len=25) :: charout 83 REAL(wp), POINTER, DIMENSION(:,:) :: zmixnano, zmixpico, zmixdiat, zstrn84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadp, zpislopeadd85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprbio, zprpic, zprdia, zysopt86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprchln, zprchlp, zprchld87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcap, zprorcad88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprofed, zprofep, zprofen89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewp, zpronewd90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zproregn, zproregp, zproregd91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpropo4n, zpropo4p, zpropo4d92 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprodopn, zprodopp, zprodopd93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrespn, zrespp, zrespd, zprnut94 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcroissn, zcroissp, zcroissd95 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl96 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d97 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d83 REAL(wp), DIMENSION(jpi,jpj ) :: zmixnano, zmixpico, zmixdiat, zstrn 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadp, zpislopeadd 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprbio, zprpic, zprdia, zysopt 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprchln, zprchlp, zprchld 87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcap, zprorcad 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofed, zprofep, zprofen 89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewp, zpronewd 90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zproregn, zproregp, zproregd 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpropo4n, zpropo4p, zpropo4d 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprodopn, zprodopp, zprodopd 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespn, zrespp, zrespd, zprnut 94 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcroissn, zcroissp, zcroissd 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl 96 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 97 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d 98 98 !!--------------------------------------------------------------------- 99 99 ! 100 100 IF( ln_timing ) CALL timing_start('p5z_prod') 101 !102 ! Allocate temporary workspace103 CALL wrk_alloc( jpi, jpj, zmixnano, zmixpico, zmixdiat, zstrn )104 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )105 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopeadd, zysopt )106 CALL wrk_alloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad )107 CALL wrk_alloc( jpi, jpj, jpk, zprofed, zprofep, zprofen )108 CALL wrk_alloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd )109 CALL wrk_alloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut )110 CALL wrk_alloc( jpi, jpj, jpk, zprchln, zprchlp, zprchld, zprodopn, zprodopp, zprodopd )111 CALL wrk_alloc( jpi, jpj, jpk, zcroissp, zcroissn, zcroissd )112 101 ! 113 102 zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp … … 474 463 IF( lk_iomput ) THEN 475 464 IF( knt == nrdttrc ) THEN 476 CALL wrk_alloc( jpi, jpj, zw2d ) 477 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 465 ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) ) 478 466 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 479 467 ! … … 550 538 IF( iom_use( "tintpp" ) ) CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s 551 539 ! 552 CALL wrk_dealloc( jpi, jpj, zw2d ) 553 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 540 DEALLOCATE( zw2d, zw3d ) 554 541 ENDIF 555 542 ENDIF … … 560 547 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 561 548 ENDIF 562 !563 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixpico, zmixdiat, zstrn )564 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )565 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopeadd, zysopt )566 CALL wrk_dealloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad )567 CALL wrk_dealloc( jpi, jpj, jpk, zprofed, zprofep, zprofen )568 CALL wrk_dealloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd )569 CALL wrk_dealloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut )570 CALL wrk_dealloc( jpi, jpj, jpk, zprchln, zprchlp, zprchld, zprodopn, zprodopp, zprodopd )571 CALL wrk_dealloc( jpi, jpj, jpk, zcroissp, zcroissn, zcroissd )572 549 ! 573 550 IF( ln_timing ) CALL timing_stop('p5z_prod') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r9124 r9125 47 47 INTEGER, INTENT( in ) :: kt ! ocean time-step 48 48 CHARACTER (len=22) :: charout 49 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd49 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrtrd 50 50 !!---------------------------------------------------------------------- 51 51 ! … … 58 58 59 59 IF( l_trdtrc ) THEN 60 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd) ! temporary save of trends60 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 61 61 ztrtrd(:,:,:,:) = tra(:,:,:,:) 62 62 ENDIF … … 89 89 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 90 90 END DO 91 CALL wrk_dealloc( jpi, jpj, jpk, jptra,ztrtrd ) ! temporary save of trends91 DEALLOCATE( ztrtrd ) ! temporary save of trends 92 92 ENDIF 93 93 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r9124 r9125 85 85 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 86 86 CHARACTER (len=22) :: charout 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd88 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrd 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 89 89 !!---------------------------------------------------------------------- 90 90 ! 91 91 IF( ln_timing ) CALL timing_start('trc_dmp') 92 92 ! 93 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd) ! temporary save of trends93 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) ! temporary save of trends 94 94 ! 95 95 IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 96 96 ! 97 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta) ! Memory allocation97 ALLOCATE( ztrcdta(jpi,jpj,jpk) ) ! Memory allocation 98 98 ! ! =========== 99 99 DO jn = 1, jptra ! tracer loop … … 150 150 END DO ! tracer loop 151 151 ! ! =========== 152 CALL wrk_dealloc( jpi, jpj, jpk,ztrcdta )153 ENDIF 154 ! 155 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk,ztrtrd )152 DEALLOCATE( ztrcdta ) 153 ENDIF 154 ! 155 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 156 156 ! ! print mean trends (used for debugging) 157 157 IF( ln_ctl ) THEN … … 352 352 IF(lwp) WRITE(numout,*) 353 353 ! 354 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta) ! Memory allocation354 ALLOCATE( ztrcdta(jpi,jpj,jpk) ) ! Memory allocation 355 355 ! 356 356 DO jn = 1, jptra … … 370 370 ENDIF 371 371 ENDDO 372 CALL wrk_dealloc( jpi, jpj, jpk,ztrcdta )372 DEALLOCATE( ztrcdta ) 373 373 ENDIF 374 374 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r9124 r9125 70 70 REAL(wp) :: zdep 71 71 CHARACTER (len=22) :: charout 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zahu, zahv72 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zahu, zahv 73 73 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 74 74 !!---------------------------------------------------------------------- … … 77 77 ! 78 78 IF( l_trdtrc ) THEN 79 CALL wrk_alloc( jpi,jpj,jpk,jptra, ztrtrd)79 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 80 80 ztrtrd(:,:,:,:) = tra(:,:,:,:) 81 81 ENDIF 82 82 ! !* set the lateral diffusivity coef. for passive tracer 83 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv )84 83 zahu(:,:,:) = rldf * ahtu(:,:,:) 85 84 zahv(:,:,:) = rldf * ahtv(:,:,:) … … 113 112 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 114 113 END DO 115 CALL wrk_dealloc( jpi, jpj, jpk, jptra,ztrtrd )114 DEALLOCATE( ztrtrd ) 116 115 ENDIF 117 116 ! … … 121 120 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 122 121 ENDIF 123 !124 CALL wrk_dealloc( jpi,jpj,jpk, zahu, zahv )125 122 ! 126 123 IF( ln_timing ) CALL timing_stop('trc_ldf') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r9124 r9125 139 139 REAL(wp) :: ztrcorb, ztrmasb ! temporary scalars 140 140 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 141 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays141 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 142 142 REAL(wp) :: zs2rdt 143 143 LOGICAL :: lldebug = .FALSE. … … 145 145 146 146 147 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn)147 IF( l_trdtrc ) ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 148 148 149 149 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved … … 226 226 ENDIF 227 227 228 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk,ztrtrdb, ztrtrdn )228 IF( l_trdtrc ) DEALLOCATE( ztrtrdb, ztrtrdn ) 229 229 230 230 END SUBROUTINE trc_rad_sms -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r9124 r9125 64 64 REAL(wp) :: zftra, zcd, zdtra, ztfx, ztra ! - - 65 65 CHARACTER (len=22) :: charout 66 REAL(wp), POINTER, DIMENSION(:,:) :: zsfx67 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd66 REAL(wp), DIMENSION(jpi,jpj) :: zsfx 67 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrd 68 68 !!--------------------------------------------------------------------- 69 69 ! … … 71 71 ! 72 72 ! Allocate temporary workspace 73 CALL wrk_alloc( jpi,jpj, zsfx ) 74 IF( l_trdtrc ) CALL wrk_alloc( jpi,jpj,jpk, ztrtrd ) 73 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 75 74 ! 76 75 zrtrn = 1.e-15_wp … … 179 178 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 180 179 ENDIF 181 CALL wrk_dealloc( jpi,jpj, zsfx ) 182 IF( l_trdtrc ) CALL wrk_dealloc( jpi,jpj,jpk, ztrtrd ) 180 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 183 181 ! 184 182 IF( ln_timing ) CALL timing_stop('trc_sbc') -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r9050 r9125 31 31 USE prtctl ! print control 32 32 USE sms_pisces ! PISCES bio-model 33 USE wrk_nemo ! Memory allocation34 33 35 34 IMPLICIT NONE … … 97 96 ! 98 97 INTEGER :: ji, jj, jk, isum 99 REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk 100 !!---------------------------------------------------------------------- 101 102 CALL wrk_alloc( jpi, jpj, zvlmsk ) 98 REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk 99 !!---------------------------------------------------------------------- 103 100 104 101 ! I. Definition of control surface and integration weights … … 182 179 tmltrd_trc(:,:,ktrd,kjn) = tmltrd_trc(:,:,ktrd,kjn) + ptrc_trdmxl(:,:,1) * wkx_trc(:,:,1) ! non penetrative 183 180 END SELECT 184 !185 CALL wrk_dealloc( jpi, jpj, zvlmsk )186 181 ! 187 182 END SUBROUTINE trd_mxl_trc_zint … … 241 236 REAL(wp) :: zavt, zfn, zfn2 242 237 ! 243 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltot ! d(trc)/dt over the anlysis window (incl. Asselin)244 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlres ! residual = dh/dt entrainment term245 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlatf ! for storage only246 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlrad ! for storage only (for trb<0 corr in trcrad)247 ! 248 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltot2 ! -+249 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlres2 ! | working arrays to diagnose the trends250 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrdm2 ! | associated with the time meaned ML251 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlatf2 ! | passive tracers252 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlrad2 ! | (-> for trb<0 corr in trcrad)238 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltot ! d(trc)/dt over the anlysis window (incl. Asselin) 239 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlres ! residual = dh/dt entrainment term 240 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlatf ! for storage only 241 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlrad ! for storage only (for trb<0 corr in trcrad) 242 ! 243 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltot2 ! -+ 244 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlres2 ! | working arrays to diagnose the trends 245 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltrdm2 ! | associated with the time meaned ML 246 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlatf2 ! | passive tracers 247 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlrad2 ! | (-> for trb<0 corr in trcrad) 253 248 ! 254 249 CHARACTER (LEN=10) :: clvar 255 250 !!---------------------------------------------------------------------- 256 251 257 ! Set-up pointers into sub-arrays of workspaces258 CALL wrk_alloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad )259 CALL wrk_alloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 )260 252 261 253 IF( nn_dttrc /= 1 ) CALL ctl_stop( " Be careful, trends diags never validated " ) … … 734 726 735 727 IF( lrst_trc ) CALL trd_mxl_trc_rst_write( kt ) ! this must be after the array swap above (III.3) 736 737 CALL wrk_dealloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad )738 CALL wrk_dealloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 )739 728 ! 740 729 END SUBROUTINE trd_mxl_trc -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r9019 r9125 19 19 20 20 USE in_out_manager !* IO manager * 21 USE wrk_nemo !* Memory Allocation *22 21 USE timing !* Timing * 23 22 USE lib_mpp !* MPP library -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
r7881 r9125 68 68 CHARACTER (len=20), ALLOCATABLE, DIMENSION(:) :: cl 69 69 CHARACTER (len=10) :: cl2 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask, ztab3d 71 !!---------------------------------------------------------------------- 72 73 CALL wrk_alloc( jpi, jpj, jpk, zmask, ztab3d ) 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, ztab3d 71 !!---------------------------------------------------------------------- 72 74 73 ALLOCATE( cl(jptra) ) 75 74 ! ! Arrays, scalars initialization … … 148 147 END DO 149 148 ! 150 CALL wrk_dealloc( jpi, jpj, jpk, zmask, ztab3d )151 149 DEALLOCATE( cl ) 152 150 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r9124 r9125 467 467 INTEGER :: ji, jj, jk ! dummy loop indices 468 468 REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0 ! local scalars 469 REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv469 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv 470 470 !!--------------------------------------------------------------------- 471 471 ! 472 472 IF( ln_timing ) CALL timing_start('trc_sub_ssh') 473 473 ! 474 ! Allocate temporary workspace475 CALL wrk_alloc( jpi,jpj, zhdiv )476 474 477 475 IF( kt == nittrc000 ) THEN … … 527 525 IF( ln_bdy ) wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 528 526 END DO 529 !530 CALL wrk_dealloc( jpi,jpj, zhdiv )531 527 ! 532 528 IF( ln_timing ) CALL timing_stop('trc_sub_ssh')
Note: See TracChangeset
for help on using the changeset viewer.