Changeset 868 for trunk/NEMO/LIM_SRC_3/limitd_me.F90
- Timestamp:
- 2008-03-14T19:53:00+01:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC_3/limitd_me.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_3/limitd_me.F90
r867 r868 977 977 IF ( raftswi .EQ. 1 ) THEN 978 978 979 DO jl = 1, jpl 980 DO jj = 1, jpj 981 DO ji = 1, jpi 982 IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. & 983 epsi11 ) THEN 984 WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 985 WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 986 WRITE(numout,*) ' lat, lon : ', gphit(ji,jj), glamt(ji,jj) 987 WRITE(numout,*) ' aridge : ', aridge(ji,jj,1:jpl) 988 WRITE(numout,*) ' araft : ', araft(ji,jj,1:jpl) 989 WRITE(numout,*) ' athorn : ', athorn(ji,jj,1:jpl) 990 ENDIF 979 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi11 ) THEN 980 DO jl = 1, jpl 981 DO jj = 1, jpj 982 DO ji = 1, jpi 983 IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. & 984 epsi11 ) THEN 985 WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 986 WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 987 WRITE(numout,*) ' lat, lon : ', gphit(ji,jj), glamt(ji,jj) 988 WRITE(numout,*) ' aridge : ', aridge(ji,jj,1:jpl) 989 WRITE(numout,*) ' araft : ', araft(ji,jj,1:jpl) 990 WRITE(numout,*) ' athorn : ', athorn(ji,jj,1:jpl) 991 ENDIF 992 END DO 991 993 END DO 992 994 END DO 993 END DO995 ENDIF 994 996 995 997 ENDIF … … 1238 1240 vsnon_init(ji,jj,jl) = v_s(ji,jj,jl) 1239 1241 1240 esnon_init(ji,jj,jl) = e_s(ji,jj,1,jl)1241 1242 smv_i_init(ji,jj,jl) = smv_i(ji,jj,jl) 1242 1243 oa_i_init (ji,jj,jl) = oa_i(ji,jj,jl) … … 1244 1245 END DO ! jj 1245 1246 END DO !jl 1247 1248 esnon_init(:,:,:) = e_s(:,:,1,:) 1246 1249 1247 1250 DO jl = 1, jpl … … 1283 1286 large_afrft = .false. 1284 1287 1288 !CDIR NODEP 1285 1289 DO ij = 1, icells 1286 1290 ji = indxi(ij) … … 1426 1430 !-------------------------------------------------------------------- 1427 1431 DO jk = 1, nlay_i 1432 !CDIR NODEP 1428 1433 DO ij = 1, icells 1429 1434 ji = indxi(ij) … … 1468 1473 IF ( con_i ) THEN 1469 1474 DO jk = 1, nlay_i 1475 !CDIR NODEP 1470 1476 DO ij = 1, icells 1471 1477 ji = indxi(ij) … … 1478 1484 1479 1485 IF (large_afrac) THEN ! there is a bug 1486 !CDIR NODEP 1480 1487 DO ij = 1, icells 1481 1488 ji = indxi(ij) … … 1490 1497 ENDIF ! large_afrac 1491 1498 IF (large_afrft) THEN ! there is a bug 1499 !CDIR NODEP 1492 1500 DO ij = 1, icells 1493 1501 ji = indxi(ij) … … 1508 1516 DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 1509 1517 ! over categories to which ridged ice is transferred 1518 !CDIR NODEP 1510 1519 DO ij = 1, icells 1511 1520 ji = indxi(ij) … … 1542 1551 ! Transfer ice energy to category jl2 by ridging 1543 1552 DO jk = 1, nlay_i 1553 !CDIR NODEP 1544 1554 DO ij = 1, icells 1545 1555 ji = indxi(ij) … … 1555 1565 DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 1556 1566 1567 !CDIR NODEP 1557 1568 DO ij = 1, icells 1558 1569 ji = indxi(ij) … … 1579 1590 ! Transfer rafted ice energy to category jl2 1580 1591 DO jk = 1, nlay_i 1592 !CDIR NODEP 1581 1593 DO ij = 1, icells 1582 1594 ji = indxi(ij) … … 1729 1741 jl, & ! ice category index 1730 1742 jk, & ! ice layer index 1731 icells, & ! number of cells with ice to zap 1732 ij ! combined i/j horizontal index 1733 1734 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 1735 indxi, & ! compressed indices for i/j directions 1736 indxj 1743 ! ij, & ! combined i/j horizontal index 1744 icells ! number of cells with ice to zap 1745 1746 ! INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 1747 ! indxi, & ! compressed indices for i/j directions 1748 ! indxj 1749 1750 INTEGER, DIMENSION(jpi,jpj) :: zmask 1751 1737 1752 1738 1753 REAL(wp) :: & … … 1745 1760 ! Abort model in case of negative area. 1746 1761 !----------------------------------------------------------------- 1747 1748 icells = 0 1749 DO jj = 1, jpj 1762 IF( MAXVAL(a_i(:,:,jl)) .LT. -epsi11 ) THEN 1763 DO jj = 1, jpj 1764 DO ji = 1, jpi 1765 IF ( a_i(ji,jj,jl) .LT. -epsi11 ) THEN 1766 WRITE (numout,*) ' ALERTE 98 ' 1767 WRITE (numout,*) ' Negative ice area: ji, jj, jl: ', ji, jj,jl 1768 WRITE (numout,*) ' a_i ', a_i(ji,jj,jl) 1769 ENDIF 1770 END DO 1771 END DO 1772 ENDIF 1773 1774 icells = 0 1775 zmask = 0.e0 1776 DO jj = 1, jpj 1750 1777 DO ji = 1, jpi 1751 IF ( a_i(ji,jj,jl) .LT. -1.0e-11 ) THEN 1752 WRITE (numout,*) ' ALERTE 98 ' 1753 WRITE (numout,*) ' Negative ice area: ji, jj, jl: ', ji, jj,jl 1754 WRITE (numout,*) ' a_i ', a_i(ji,jj,jl) 1755 ELSEIF ( ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0.0) & 1778 IF ( ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0.0) & 1756 1779 .OR. & 1757 1780 ( a_i(ji,jj,jl) .GT. 0.0 .AND. a_i(ji,jj,jl) .LE. 1.0e-11 ) & … … 1761 1784 .OR. & 1762 1785 ( v_i(ji,jj,jl) .GT. 0.0 .AND. v_i(ji,jj,jl) .LT. 1.e-12 ) ) THEN 1763 icells = icells + 1 1764 indxi(icells) = ji 1765 indxj(icells) = jj 1786 zmask(ji,jj) = 1 1766 1787 ENDIF 1767 1788 END DO 1768 1789 END DO 1769 WRITE(numout,*) icells, ' cells of ice zapped in the ocean '1790 WRITE(numout,*) SUM(zmask), ' cells of ice zapped in the ocean ' 1770 1791 1771 1792 !----------------------------------------------------------------- … … 1774 1795 1775 1796 DO jk = 1, nlay_i 1776 DO ij = 1, icells 1777 ji = indxi(ij) 1778 jj = indxj(ij) 1797 DO jj = 1 , jpj 1798 DO ji = 1 , jpi 1779 1799 1780 1800 xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice 1781 1801 xtmp = xtmp * unit_fac 1782 1802 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1783 e_i(ji,jj,jk,jl) = 0.01784 1785 END DO ! ij1803 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1 - zmask(ji,jj) ) 1804 END DO ! ji 1805 END DO ! jj 1786 1806 END DO ! jk 1787 1807 1788 DO ij = 1, icells 1789 ji = indxi(ij) 1790 jj = indxj(ij) 1808 DO jj = 1 , jpj 1809 DO ji = 1 , jpi 1791 1810 1792 1811 !----------------------------------------------------------------- … … 1803 1822 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1804 1823 1805 t_s(ji,jj,1,jl) = rtt 1824 xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB ??????? 1825 1826 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) ) 1806 1827 1807 1828 !----------------------------------------------------------------- … … 1822 1843 ! fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 1823 1844 1824 ato_i(ji,jj) = ato_i(ji,jj) + a_i(ji,jj,jl) 1825 a_i(ji,jj,jl) = 0.0 1826 v_i(ji,jj,jl) = 0.0 1827 v_s(ji,jj,jl) = 0.0 1828 t_su(ji,jj,jl) = t_bo(ji,jj) 1829 oa_i(ji,jj,jl) = 0.0 1830 smv_i(ji,jj,jl) = 0.0 1831 1832 END DO ! ij 1845 ato_i(ji,jj) = a_i(ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) 1846 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1847 v_i(ji,jj,jl) = v_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1848 v_s(ji,jj,jl) = v_s(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1849 t_su(ji,jj,jl) = t_su(ji,jj,jl) * (1 -zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj) 1850 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1851 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1852 1853 END DO ! ji 1854 END DO ! jj 1833 1855 1834 1856 END DO ! jl
Note: See TracChangeset
for help on using the changeset viewer.
