Changeset 5167 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
- Timestamp:
- 2015-03-24T18:35:00+01:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r5134 r5167 154 154 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 155 155 156 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 156 157 !-----------------------------------------------------------------------------! 157 158 ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons … … 235 236 ! Reduce the closing rate if more than 100% of the open water 236 237 ! would be removed. Reduce the opening rate proportionately. 237 IF ( ato_i(ji,jj) > epsi10 .AND. athorn(ji,jj,0) > 0.0 ) THEN 238 za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 239 IF ( za > ato_i(ji,jj)) THEN 240 zfac = ato_i(ji,jj) / za 241 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 242 opning(ji,jj) = opning(ji,jj) * zfac 243 ENDIF 238 za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 239 IF( za > epsi20 ) THEN 240 zfac = MIN( 1._wp, ato_i(ji,jj) / za ) 241 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 242 opning (ji,jj) = opning (ji,jj) * zfac 244 243 ENDIF 245 244 … … 251 250 ! Reduce the closing rate if more than 100% of any ice category 252 251 ! would be removed. Reduce the opening rate proportionately. 253 254 252 DO jl = 1, jpl 255 253 DO jj = 1, jpj 256 254 DO ji = 1, jpi 257 IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 258 za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 259 IF ( za > a_i(ji,jj,jl) ) THEN 260 zfac = a_i(ji,jj,jl) / za 261 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 262 opning (ji,jj) = opning (ji,jj) * zfac 263 ENDIF 255 za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 256 IF( za > epsi20 ) THEN 257 zfac = MIN( 1._wp, a_i(ji,jj,jl) / za ) 258 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 259 opning (ji,jj) = opning (ji,jj) * zfac 264 260 ENDIF 265 261 END DO … … 369 365 370 366 ! updates 371 CALL lim_var_glo2eqv372 CALL lim_var_zapsmall373 367 CALL lim_var_agg( 1 ) 374 368 … … 377 371 !-----------------------------------------------------------------------------! 378 372 IF(ln_ctl) THEN 373 CALL lim_var_glo2eqv 374 379 375 CALL prt_ctl_info(' ') 380 376 CALL prt_ctl_info(' - Cell values : ') … … 531 527 DO jj = 2, jpjm1 532 528 DO ji = 2, jpim1 533 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present529 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 534 530 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 535 531 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & … … 566 562 DO jj = 1, jpj - 1 567 563 DO ji = 1, jpi - 1 568 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present564 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 569 565 numts_rm = 1 ! number of time steps for the running mean 570 566 IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 … … 637 633 638 634 Gsum(:,:,-1) = 0._wp 639 640 DO jj = 1, jpj 641 DO ji = 1, jpi 642 IF( ato_i(ji,jj) > epsi10 ) THEN ; Gsum(ji,jj,0) = ato_i(ji,jj) 643 ELSE ; Gsum(ji,jj,0) = 0._wp 644 ENDIF 645 END DO 646 END DO 635 Gsum(:,:,0 ) = ato_i(:,:) 647 636 648 637 ! for each value of h, you have to add ice concentration then 649 638 DO jl = 1, jpl 650 DO jj = 1, jpj 651 DO ji = 1, jpi 652 IF( a_i(ji,jj,jl) > epsi10 ) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 653 ELSE ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 654 ENDIF 655 END DO 656 END DO 639 Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 657 640 END DO 658 641 … … 828 811 LOGICAL, PARAMETER :: l_conservation_check = .true. ! if true, check conservation (useful for debugging) 829 812 ! 830 LOGICAL :: neg_ato_i ! flag for ato_i(i,j) < -puny831 LOGICAL :: large_afrac ! flag for afrac > 1832 LOGICAL :: large_afrft ! flag for afrac > 1833 813 INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices 834 814 INTEGER :: ij ! horizontal index, combines i and j loops … … 898 878 ! 1) Compute change in open water area due to closing and opening. 899 879 !------------------------------------------------------------------------------- 900 901 neg_ato_i = .false.902 903 880 DO jj = 1, jpj 904 881 DO ji = 1, jpi 905 882 ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice & 906 883 & + opning(ji,jj) * rdt_ice 907 IF ( ato_i(ji,jj) < -epsi10 ) THEN908 neg_ato_i = .TRUE.909 ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error884 IF ( ato_i(ji,jj) < -epsi10 ) THEN ! there is a bug 885 IF(lwp) WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj) 886 ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error 910 887 ato_i(ji,jj) = 0._wp 911 888 ENDIF 912 889 END DO 913 890 END DO 914 915 ! if negative open water area alert it916 IF( neg_ato_i .AND. lwp ) THEN ! there is a bug917 DO jj = 1, jpj918 DO ji = 1, jpi919 IF( ato_i(ji,jj) < -epsi10 ) THEN920 WRITE(numout,*) ''921 WRITE(numout,*) 'Ridging error: ato_i < 0'922 WRITE(numout,*) 'ato_i : ', ato_i(ji,jj)923 ENDIF924 END DO925 END DO926 ENDIF927 891 928 892 !----------------------------------------------------------------- 929 893 ! 2) Save initial state variables 930 894 !----------------------------------------------------------------- 931 932 DO jl = 1, jpl 933 aicen_init(:,:,jl) = a_i(:,:,jl) 934 vicen_init(:,:,jl) = v_i(:,:,jl) 935 vsnwn_init(:,:,jl) = v_s(:,:,jl) 936 ! 937 smv_i_init(:,:,jl) = smv_i(:,:,jl) 938 oa_i_init (:,:,jl) = oa_i (:,:,jl) 939 END DO 940 941 esnwn_init(:,:,:) = e_s(:,:,1,:) 942 943 DO jl = 1, jpl 944 DO jk = 1, nlay_i 945 eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl) 946 END DO 947 END DO 895 aicen_init(:,:,:) = a_i (:,:,:) 896 vicen_init(:,:,:) = v_i (:,:,:) 897 vsnwn_init(:,:,:) = v_s (:,:,:) 898 smv_i_init(:,:,:) = smv_i(:,:,:) 899 oa_i_init (:,:,:) = oa_i (:,:,:) 900 esnwn_init(:,:,:) = e_s (:,:,1,:) 901 eicen_init(:,:,:,:) = e_i (:,:,:,:) 948 902 949 903 ! … … 972 926 END DO 973 927 974 large_afrac = .false.975 large_afrft = .false.976 977 928 DO ij = 1, icells 978 929 ji = indxi(ij) … … 1000 951 afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 1001 952 1002 IF (afrac(ji,jj) > kamax + epsi10) THEN !riging1003 large_afrac = .true.1004 ELSEIF (afrac(ji,jj) > kamax) THEN! roundoff error953 IF( afrac(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 954 IF(lwp) WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 955 ELSEIF( afrac(ji,jj) > kamax ) THEN ! roundoff error 1005 956 afrac(ji,jj) = kamax 1006 957 ENDIF 1007 IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting 1008 large_afrft = .true. 1009 ELSEIF (afrft(ji,jj) > kamax) THEN ! roundoff error 958 959 IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 960 IF(lwp) WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 961 ELSEIF( afrft(ji,jj) > kamax) THEN ! roundoff error 1010 962 afrft(ji,jj) = kamax 1011 963 ENDIF … … 1022 974 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 1023 975 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1024 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless1025 976 1026 977 ! rafting volumes, heat contents ... … … 1050 1001 1051 1002 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 1052 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! gurvan:increase in ice volume du to seawater frozen in voids1003 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! increase in ice volume du to seawater frozen in voids 1053 1004 1054 1005 !------------------------------------ … … 1134 1085 ENDIF 1135 1086 1136 IF( large_afrac .AND. lwp ) THEN ! there is a bug1137 DO ij = 1, icells1138 ji = indxi(ij)1139 jj = indxj(ij)1140 IF( afrac(ji,jj) > kamax + epsi10 ) THEN1141 WRITE(numout,*) ''1142 WRITE(numout,*) ' ardg > a_i'1143 WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)1144 ENDIF1145 END DO1146 ENDIF1147 IF( large_afrft .AND. lwp ) THEN ! there is a bug1148 DO ij = 1, icells1149 ji = indxi(ij)1150 jj = indxj(ij)1151 IF( afrft(ji,jj) > kamax + epsi10 ) THEN1152 WRITE(numout,*) ''1153 WRITE(numout,*) ' arft > a_i'1154 WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)1155 ENDIF1156 END DO1157 ENDIF1158 1159 1087 !------------------------------------------------------------------------------- 1160 1088 ! 4) Add area, volume, and energy of new ridge to each category jl2
Note: See TracChangeset
for help on using the changeset viewer.
