- Timestamp:
- 2017-04-13T16:21:08+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r7646 r7910 36 36 USE par_kind 37 37 USE crslbclnk 38 USE wrk_nemo ! work arrays39 38 USE lib_mpp 40 39 … … 352 351 INTEGER :: ji, jj, jk , ii, ij, je_2 353 352 REAL(wp) :: zdAm 354 REAL(wp), DIMENSION( :,:,:), POINTER:: zvol, zmask353 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol, zmask 355 354 !!---------------------------------------------------------------- 356 355 ! 357 CALL wrk_alloc( jpi,jpj,jpk, zvol, zmask )358 356 ! 359 357 p_fld1_crs(:,:,:) = 0._wp … … 445 443 CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 ) 446 444 ! 447 CALL wrk_dealloc( jpi, jpj, jpk, zvol, zmask )448 445 ! 449 446 END SUBROUTINE crs_dom_facvol … … 487 484 INTEGER :: ii, ij, ijie, ijje, je_2 488 485 REAL(wp) :: zflcrs, zsfcrs 489 REAL(wp), DIMENSION( :,:,:), POINTER:: zsurf, zsurfmsk, zmask486 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsurf, zsurfmsk, zmask 490 487 !!---------------------------------------------------------------- 491 488 ! … … 496 493 CASE ( 'VOL' ) 497 494 ! 498 CALL wrk_alloc( jpi,jpj,jpk, zsurf, zsurfmsk )499 495 ! 500 496 SELECT CASE ( cd_type ) … … 585 581 END SELECT 586 582 587 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )588 583 589 584 CASE ( 'SUM' ) 590 585 591 CALL wrk_alloc( jpi, jpj, jpk, zsurfmsk )592 586 593 587 SELECT CASE ( cd_type ) … … 763 757 ENDIF 764 758 765 CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk )766 759 767 760 CASE ( 'MAX' ) ! search the max of unmasked grid cells 768 761 769 CALL wrk_alloc( jpi, jpj, jpk, zmask )770 762 771 763 SELECT CASE ( cd_type ) … … 934 926 END SELECT 935 927 936 CALL wrk_dealloc( jpi, jpj, jpk, zmask )937 928 938 929 CASE ( 'MIN' ) ! Search the min of unmasked grid cells 939 930 940 CALL wrk_alloc( jpi, jpj, jpk, zmask )941 931 942 932 SELECT CASE ( cd_type ) … … 1104 1094 END SELECT 1105 1095 ! 1106 CALL wrk_dealloc( jpi, jpj, jpk, zmask )1107 1096 ! 1108 1097 END SELECT … … 1149 1138 INTEGER :: ijie, ijje, ii, ij, je_2 1150 1139 REAL(wp) :: zflcrs, zsfcrs 1151 REAL(wp), DIMENSION( :,:), POINTER:: zsurfmsk1140 REAL(wp), DIMENSION(jpi,jpj) :: zsurfmsk 1152 1141 !!---------------------------------------------------------------- 1153 1142 ! … … 1158 1147 CASE ( 'VOL' ) 1159 1148 1160 CALL wrk_alloc( jpi, jpj, zsurfmsk )1161 1149 zsurfmsk(:,:) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 1162 1150 … … 1222 1210 ENDDO 1223 1211 1224 CALL wrk_dealloc( jpi, jpj, zsurfmsk )1225 1212 1226 1213 CASE ( 'SUM' ) 1227 1214 1228 CALL wrk_alloc( jpi, jpj, zsurfmsk )1229 1215 IF( PRESENT( p_e3 ) ) THEN 1230 1216 zsurfmsk(:,:) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) … … 1364 1350 ENDIF 1365 1351 1366 CALL wrk_dealloc( jpi, jpj, zsurfmsk )1367 1352 1368 1353 CASE ( 'MAX' ) … … 1644 1629 INTEGER :: ijie, ijje, ii, ij, je_2 1645 1630 REAL(wp) :: ze3crs 1646 REAL(wp), DIMENSION( :,:,:), POINTER:: zmask, zsurf1631 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, zsurf 1647 1632 1648 1633 !!---------------------------------------------------------------- … … 1652 1637 1653 1638 1654 CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )1655 1639 1656 1640 SELECT CASE ( cd_type ) … … 1756 1740 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 1757 1741 ! 1758 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask )1759 1742 ! 1760 1743 END SUBROUTINE crs_dom_e3 … … 1773 1756 INTEGER :: ji, jj, jk ! dummy loop indices 1774 1757 INTEGER :: ii, ij, je_2 1775 REAL(wp), DIMENSION( :,:,:), POINTER:: zsurf, zsurfmsk1758 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsurf, zsurfmsk 1776 1759 !!---------------------------------------------------------------- 1777 1760 ! Initialize 1778 1761 1779 1762 1780 CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )1781 1763 ! 1782 1764 SELECT CASE ( cd_type ) … … 1868 1850 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 1869 1851 1870 CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf )1871 1852 1872 1853 END SUBROUTINE crs_dom_sfc … … 2236 2217 !! local variables 2237 2218 INTEGER :: ji,jj,jk ! dummy indices 2238 REAL(wp), DIMENSION( :,:) , POINTER:: zmbk2219 REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: zmbk 2239 2220 !!---------------------------------------------------------------- 2240 2221 2241 CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )2242 2222 2243 2223 mbathy_crs(:,:) = jpkm1 … … 2281 2261 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 2282 2262 ! 2283 CALL wrk_dealloc( jpi_crs, jpj_crs, zmbk )2284 2263 ! 2285 2264 END SUBROUTINE crs_dom_bat
Note: See TracChangeset
for help on using the changeset viewer.