- Timestamp:
- 2013-12-11T15:38:42+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4072 r4332 43 43 PUBLIC lim_itd_me_alloc ! called by iceini.F90 44 44 45 REAL(wp) :: epsi 11 = 1.e-11_wp ! constant values45 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 46 46 REAL(wp) :: epsi10 = 1.e-10_wp ! constant values 47 47 REAL(wp) :: epsi06 = 1.e-06_wp ! constant values … … 50 50 ! Variables shared among ridging subroutines 51 51 !----------------------------------------------------------------------- 52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: asum ! sum of total ice and open water area 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: aksum ! ratio of area removed to area ridged 54 ! 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: athorn ! participation function; fraction of ridging/ 56 ! ! closing associated w/ category n 57 ! 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmin ! minimum ridge thickness 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmax ! maximum ridge thickness 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hraft ! thickness of rafted ice 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: krdg ! mean ridge thickness/thickness of ridging ice 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aridge ! participating ice ridging 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: araft ! participating ice rafting 52 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: asum ! sum of total ice and open water area 53 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: aksum ! ratio of area removed to area ridged 54 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: athorn ! participation function; fraction of ridging/ 55 ! ! closing associated w/ category n 56 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: hrmin ! minimum ridge thickness 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: hrmax ! maximum ridge thickness 58 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: hraft ! thickness of rafted ice 59 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: krdg ! mean ridge thickness/thickness of ridging ice 60 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: aridge ! participating ice ridging 61 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: araft ! participating ice rafting 64 62 65 63 REAL(wp), PARAMETER :: krdgmin = 1.1_wp ! min ridge thickness multiplier 66 64 REAL(wp), PARAMETER :: kraft = 2.0_wp ! rafting multipliyer 67 REAL(wp), PARAMETER :: kamax = 1.0 65 REAL(wp), PARAMETER :: kamax = 1.0_wp ! max of ice area authorized (clem: scheme is not stable if kamax <= 0.99) 68 66 69 67 REAL(wp) :: Cp ! … … 183 181 ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 184 182 !-----------------------------------------------------------------------------! 185 ! Set hi_max(ncat) to a big value to ensure that all ridged ice is thinner than hi_max(ncat).186 187 hi_max(jpl) = 999.99188 189 183 Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0 ! proport const for PE 190 184 ! … … 265 259 ! Reduce the closing rate if more than 100% of the open water 266 260 ! would be removed. Reduce the opening rate proportionately. 267 IF ( ato_i(ji,jj) .GT. epsi1 1.AND. athorn(ji,jj,0) .GT. 0.0 ) THEN261 IF ( ato_i(ji,jj) .GT. epsi10 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN 268 262 w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 269 263 IF ( w1 .GT. ato_i(ji,jj)) THEN … … 285 279 DO jj = 1, jpj 286 280 DO ji = 1, jpi 287 IF ( a_i(ji,jj,jl) > epsi1 1.AND. athorn(ji,jj,jl) > 0._wp )THEN281 IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 288 282 w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 289 283 IF ( w1 > a_i(ji,jj,jl) ) THEN … … 316 310 DO jj = 1, jpj 317 311 DO ji = 1, jpi 318 IF (ABS(asum(ji,jj) - kamax ) .LT. epsi1 1) THEN312 IF (ABS(asum(ji,jj) - kamax ) .LT. epsi10) THEN 319 313 closing_net(ji,jj) = 0._wp 320 314 opning (ji,jj) = 0._wp … … 358 352 DO ji = 1, jpi 359 353 360 IF(ABS(asum(ji,jj) - kamax) > epsi1 1) asum_error = .true.354 IF(ABS(asum(ji,jj) - kamax) > epsi10 ) asum_error = .true. 361 355 362 356 dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice … … 377 371 DO jj = 1, jpj 378 372 DO ji = 1, jpi 379 IF( ABS( asum(ji,jj) - kamax) > epsi1 1) THEN ! there is a bug373 IF( ABS( asum(ji,jj) - kamax) > epsi10 ) THEN ! there is a bug 380 374 WRITE(numout,*) ' ' 381 375 WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) … … 400 394 401 395 !-----------------------------------------------------------------------------! 402 ! 6) Updating state variables and trend terms 396 ! 6) Updating state variables and trend terms (done in limupdate) 403 397 !-----------------------------------------------------------------------------! 404 405 398 CALL lim_var_glo2eqv 406 399 CALL lim_itd_me_zapsmall … … 419 412 END DO 420 413 END DO 421 422 !-----------------423 ! Trend terms424 !-----------------425 426 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:)427 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:)428 d_a_i_trp (:,:,:) = a_i (:,:,:) - old_a_i (:,:,:)429 d_v_s_trp (:,:,:) = v_s (:,:,:) - old_v_s (:,:,:)430 d_v_i_trp (:,:,:) = v_i (:,:,:) - old_v_i (:,:,:)431 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - old_e_s (:,:,:,:)432 d_e_i_trp (:,:,:,:) = e_i (:,:,:,:) - old_e_i (:,:,:,:)433 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:)434 d_smv_i_trp(:,:,:) = 0._wp435 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)436 414 437 415 IF(ln_ctl) THEN ! Control print … … 491 469 ! ------------------------------- 492 470 493 !-------------------------!494 ! Back to initial values495 !-------------------------!496 497 ! update of fields will be made later in lim update498 u_ice(:,:) = old_u_ice(:,:)499 v_ice(:,:) = old_v_ice(:,:)500 a_i(:,:,:) = old_a_i(:,:,:)501 v_s(:,:,:) = old_v_s(:,:,:)502 v_i(:,:,:) = old_v_i(:,:,:)503 e_s(:,:,:,:) = old_e_s(:,:,:,:)504 e_i(:,:,:,:) = old_e_i(:,:,:,:)505 oa_i(:,:,:) = old_oa_i(:,:,:)506 IF( num_sal == 2 ) smv_i(:,:,:) = old_smv_i(:,:,:)507 508 !----------------------------------------------------!509 ! Advection of ice in a free cell, newly ridged ice510 !----------------------------------------------------!511 512 ! to allow for thermodynamics to melt new ice513 ! we immediately advect ice in free cells514 515 ! heat content has to be corrected before ice volume516 !clem@order517 ! DO jl = 1, jpl518 ! DO jk = 1, nlay_i519 ! DO jj = 1, jpj520 ! DO ji = 1, jpi521 ! IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. &522 ! ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN523 ! old_e_i(ji,jj,jk,jl) = d_e_i_trp(ji,jj,jk,jl)524 ! d_e_i_trp(ji,jj,jk,jl) = 0._wp525 ! ENDIF526 ! END DO527 ! END DO528 ! END DO529 ! END DO530 !531 ! DO jl = 1, jpl532 ! DO jj = 1, jpj533 ! DO ji = 1, jpi534 ! IF( old_v_i (ji,jj,jl) < epsi06 .AND. &535 ! d_v_i_trp(ji,jj,jl) > epsi06 ) THEN536 ! old_v_i (ji,jj,jl) = d_v_i_trp(ji,jj,jl)537 ! d_v_i_trp (ji,jj,jl) = 0._wp538 ! old_a_i (ji,jj,jl) = d_a_i_trp(ji,jj,jl)539 ! d_a_i_trp (ji,jj,jl) = 0._wp540 ! old_v_s (ji,jj,jl) = d_v_s_trp(ji,jj,jl)541 ! d_v_s_trp (ji,jj,jl) = 0._wp542 ! old_e_s (ji,jj,1,jl) = d_e_s_trp(ji,jj,1,jl)543 ! d_e_s_trp (ji,jj,1,jl) = 0._wp544 ! old_oa_i (ji,jj,jl) = d_oa_i_trp(ji,jj,jl)545 ! d_oa_i_trp(ji,jj,jl) = 0._wp546 ! IF( num_sal == 2 ) old_smv_i(ji,jj,jl) = d_smv_i_trp(ji,jj,jl)547 ! d_smv_i_trp(ji,jj,jl) = 0._wp548 ! ENDIF549 ! END DO550 ! END DO551 ! END DO552 !clem@order553 471 ENDIF ! ln_limdyn=.true. 554 472 ! … … 605 523 DO ji = 1, jpi 606 524 ! 607 IF( a_i(ji,jj,jl) > epsi11 .AND. & 608 athorn(ji,jj,jl) > 0._wp ) THEN 525 IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN 609 526 hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 610 527 !---------------------------- … … 624 541 * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) ) 625 542 !!gm Optimization: (a**3-b**3)/(a-b) = a*a+ab+b*b ==> less costly operations even if a**3 is replaced by a*a*a... 626 ENDIF ! aicen > epsi1 1543 ENDIF ! aicen > epsi10 627 544 ! 628 545 END DO ! ji … … 681 598 DO jj = 2, jpj - 1 682 599 DO ji = 2, jpi - 1 683 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi1 1) THEN ! ice is600 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is 684 601 ! present 685 602 zworka(ji,jj) = 4.0 * strength(ji,jj) & … … 721 638 DO jj = 1, jpj - 1 722 639 DO ji = 1, jpi - 1 723 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi1 1) THEN ! ice is present640 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is present 724 641 numts_rm = 1 ! number of time steps for the running mean 725 642 IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 … … 794 711 DO jj = 1, jpj 795 712 DO ji = 1, jpi 796 IF( ato_i(ji,jj) > epsi1 1) THEN ; Gsum(ji,jj,0) = ato_i(ji,jj)713 IF( ato_i(ji,jj) > epsi10 ) THEN ; Gsum(ji,jj,0) = ato_i(ji,jj) 797 714 ELSE ; Gsum(ji,jj,0) = 0._wp 798 715 ENDIF … … 804 721 DO jj = 1, jpj 805 722 DO ji = 1, jpi 806 IF( a_i(ji,jj,jl) .GT. epsi1 1) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl)723 IF( a_i(ji,jj,jl) .GT. epsi10 ) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 807 724 ELSE ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 808 725 ENDIF … … 887 804 IF ( raftswi == 1 ) THEN 888 805 889 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi1 1) THEN806 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN 890 807 DO jl = 1, jpl 891 808 DO jj = 1, jpj 892 809 DO ji = 1, jpi 893 IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. & 894 epsi11 ) THEN 810 IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. epsi10 ) THEN 895 811 WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 896 812 WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl … … 938 854 DO ji = 1, jpi 939 855 940 IF (a_i(ji,jj,jl) .GT. epsi1 1.AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN856 IF (a_i(ji,jj,jl) .GT. epsi10 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN 941 857 hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 942 858 hrmean = MAX(SQRT(Hstar*hi), hi*krdgmin) … … 992 908 INTEGER :: ij ! horizontal index, combines i and j loops 993 909 INTEGER :: icells ! number of cells with aicen > puny 994 REAL(wp) :: z eps, zindb, zsrdg2 ! local scalar910 REAL(wp) :: zindb, zsrdg2 ! local scalar 995 911 REAL(wp) :: hL, hR, farea, zdummy, zdummy0, ztmelts ! left and right limits of integration 996 912 … … 1044 960 1045 961 IF( con_i ) THEN 1046 CALL lim_column_sum (jpl, v_i, vice_init ) 1047 WRITE(numout,*) ' vice_init : ', vice_init(jiindx,jjindx) 962 CALL lim_column_sum (jpl, v_i, vice_init ) 1048 963 CALL lim_column_sum_energy (jpl, nlay_i, e_i, eice_init ) 1049 WRITE(numout,*) ' eice_init : ', eice_init(jiindx,jjindx) 964 DO ji = mi0(jiindx), mi1(jiindx) 965 DO jj = mj0(jjindx), mj1(jjindx) 966 WRITE(numout,*) ' vice_init : ', vice_init(ji,jj) 967 WRITE(numout,*) ' eice_init : ', eice_init(ji,jj) 968 END DO 969 END DO 1050 970 ENDIF 1051 1052 zeps = 1.e-20_wp1053 971 1054 972 !------------------------------------------------------------------------------- … … 1062 980 ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice & 1063 981 & + opning(ji,jj) * rdt_ice 1064 IF( ato_i(ji,jj) < -epsi1 1) THEN982 IF( ato_i(ji,jj) < -epsi10 ) THEN 1065 983 neg_ato_i = .TRUE. 1066 984 ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error … … 1074 992 DO jj = 1, jpj 1075 993 DO ji = 1, jpi 1076 IF( ato_i(ji,jj) < -epsi1 1) THEN994 IF( ato_i(ji,jj) < -epsi10 ) THEN 1077 995 WRITE(numout,*) '' 1078 996 WRITE(numout,*) 'Ridging error: ato_i < 0' 1079 997 WRITE(numout,*) 'ato_i : ', ato_i(ji,jj) 1080 ENDIF ! ato_i < -epsi1 1998 ENDIF ! ato_i < -epsi10 1081 999 END DO 1082 1000 END DO … … 1120 1038 DO jj = 1, jpj 1121 1039 DO ji = 1, jpi 1122 IF( aicen_init(ji,jj,jl1) > epsi11 .AND. athorn(ji,jj,jl1) > 0._wp&1123 .AND. closing_gross(ji,jj) > 0._wp ) THEN1040 IF( aicen_init(ji,jj,jl1) > epsi10 .AND. athorn(ji,jj,jl1) > 0._wp & 1041 & .AND. closing_gross(ji,jj) > 0._wp ) THEN 1124 1042 icells = icells + 1 1125 1043 indxi(icells) = ji … … 1158 1076 afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 1159 1077 1160 IF (afrac(ji,jj) > kamax + epsi1 1) THEN !riging1078 IF (afrac(ji,jj) > kamax + epsi10) THEN !riging 1161 1079 large_afrac = .true. 1162 1080 ELSEIF (afrac(ji,jj) > kamax) THEN ! roundoff error 1163 1081 afrac(ji,jj) = kamax 1164 1082 ENDIF 1165 IF (afrft(ji,jj) > kamax + epsi1 1) THEN !rafting1083 IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting 1166 1084 large_afrft = .true. 1167 1085 ELSEIF (afrft(ji,jj) > kamax) THEN ! roundoff error … … 1222 1140 dardg1dt (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 1223 1141 dardg2dt (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj) 1224 !clem diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) * r1_rdtice1225 1142 opening (ji,jj) = opening (ji,jj) + opning(ji,jj) * rdt_ice 1226 1143 … … 1276 1193 1277 1194 ! corrected sea water salinity 1278 zindb = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - zeps) )1279 zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), zeps)1195 zindb = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - epsi20 ) ) 1196 zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), epsi20 ) 1280 1197 1281 1198 ztmelts = - tmut * zdummy + rtt … … 1312 1229 ji = indxi(ij) 1313 1230 jj = indxj(ij) 1314 IF( afrac(ji,jj) > kamax + epsi1 1) THEN1231 IF( afrac(ji,jj) > kamax + epsi10 ) THEN 1315 1232 WRITE(numout,*) '' 1316 1233 WRITE(numout,*) ' ardg > a_i' … … 1324 1241 ji = indxi(ij) 1325 1242 jj = indxj(ij) 1326 IF( afrft(ji,jj) > kamax + epsi1 1) THEN1243 IF( afrft(ji,jj) > kamax + epsi10 ) THEN 1327 1244 WRITE(numout,*) '' 1328 1245 WRITE(numout,*) ' arft > a_i' … … 1424 1341 fieldid = ' v_i : limitd_me ' 1425 1342 CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid) 1426 WRITE(numout,*) ' vice_init : ', vice_init(jiindx,jjindx)1427 WRITE(numout,*) ' vice_final : ', vice_final(jiindx,jjindx)1428 1343 1429 1344 CALL lim_column_sum_energy (jpl, nlay_i, e_i, eice_final ) 1430 1345 fieldid = ' e_i : limitd_me ' 1431 1346 CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid) 1432 WRITE(numout,*) ' eice_init : ', eice_init(jiindx,jjindx) 1433 WRITE(numout,*) ' eice_final : ', eice_final(jiindx,jjindx) 1347 1348 DO ji = mi0(jiindx), mi1(jiindx) 1349 DO jj = mj0(jjindx), mj1(jjindx) 1350 WRITE(numout,*) ' vice_init : ', vice_init (ji,jj) 1351 WRITE(numout,*) ' vice_final : ', vice_final(ji,jj) 1352 WRITE(numout,*) ' eice_init : ', eice_init (ji,jj) 1353 WRITE(numout,*) ' eice_final : ', eice_final(ji,jj) 1354 END DO 1355 END DO 1434 1356 ENDIF 1435 1357 ! … … 1533 1455 1534 1456 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace 1535 1457 REAL(wp) :: zmask_glo 1536 1458 !!gm REAL(wp) :: xtmp ! temporary variable 1537 1459 !!------------------------------------------------------------------- … … 1545 1467 ! Abort model in case of negative area. 1546 1468 !----------------------------------------------------------------- 1547 IF( MINVAL(a_i(:,:,jl)) .LT. -epsi11 .AND. ln_nicep ) THEN1548 DO jj = 1, jpj1549 DO ji = 1, jpi1550 IF ( a_i(ji,jj,jl) .LT. -epsi11 ) THEN1551 WRITE (numout,*) ' ALERTE 98 '1552 WRITE (numout,*) ' Negative ice area: ji, jj, jl: ', ji, jj,jl1553 WRITE (numout,*) ' a_i ', a_i(ji,jj,jl)1554 ENDIF1555 END DO1556 END DO1557 ENDIF1558 1559 1469 icells = 0 1560 zmask = 0._wp1470 zmask(:,:) = 0._wp 1561 1471 DO jj = 1, jpj 1562 1472 DO ji = 1, jpi 1563 IF( ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0._wp ) .OR. & 1564 & ( a_i(ji,jj,jl) .GT. 0._wp .AND. a_i(ji,jj,jl) .LE. 1.0e-11 ) .OR. & 1565 & ( v_i(ji,jj,jl) == 0._wp .AND. a_i(ji,jj,jl) .GT. 0._wp ) .OR. & 1566 & ( v_i(ji,jj,jl) .GT. 0._wp .AND. v_i(ji,jj,jl) .LT. 1.e-12 ) ) zmask(ji,jj) = 1._wp 1567 END DO 1568 END DO 1569 IF( ln_nicep ) WRITE(numout,*) SUM(zmask), ' cells of ice zapped in the ocean ' 1473 IF( ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) < 0._wp ) .OR. & 1474 & ( a_i(ji,jj,jl) > 0._wp .AND. a_i(ji,jj,jl) <= epsi10 ) .OR. & 1475 & ( v_i(ji,jj,jl) == 0._wp .AND. a_i(ji,jj,jl) > 0._wp ) .OR. & 1476 & ( v_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) <= epsi10 ) ) zmask(ji,jj) = 1._wp 1477 END DO 1478 END DO 1479 zmask_glo = glob_sum(zmask) 1480 !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean ' 1570 1481 1571 1482 !----------------------------------------------------------------- … … 1579 1490 !!gm xtmp = xtmp * unit_fac 1580 1491 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1581 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1 - zmask(ji,jj) )1492 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 1582 1493 END DO 1583 1494 END DO … … 1601 1512 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB ??????? 1602 1513 1603 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) )1514 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 1604 1515 1605 1516 !----------------------------------------------------------------- … … 1615 1526 1616 1527 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) 1617 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1 - zmask(ji,jj) )1618 v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1 - zmask(ji,jj) )1619 v_s (ji,jj,jl) = v_s (ji,jj,jl) * ( 1 - zmask(ji,jj) )1620 t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1 - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)1621 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1 - zmask(ji,jj) )1622 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1 - zmask(ji,jj) )1528 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1529 v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1530 v_s (ji,jj,jl) = v_s (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1531 t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj) 1532 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1533 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1623 1534 ! 1624 1535 END DO
Note: See TracChangeset
for help on using the changeset viewer.
