- Timestamp:
- 2017-12-19T09:47:17+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.