Changeset 5202 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
- Timestamp:
- 2015-04-07T17:40:16+02:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r5181 r5202 127 127 REAL(wp) :: za, zfac ! local scalar 128 128 CHARACTER (len = 15) :: fieldid 129 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s)130 ! (ridging ice area - area of new ridges) / dt131 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s)132 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear133 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges134 REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2)135 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2)136 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories129 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s) 130 ! (ridging ice area - area of new ridges) / dt 131 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s) 132 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear 133 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges 134 REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2) 135 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2) 136 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 137 137 ! 138 138 INTEGER, PARAMETER :: nitermax = 20 … … 142 142 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 143 143 144 CALL wrk_alloc( jpi, 144 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 145 145 146 146 IF(ln_ctl) THEN … … 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_zapsmall 156 157 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 158 157 159 !-----------------------------------------------------------------------------! 158 160 ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons … … 364 366 ENDIF 365 367 366 ! updates367 368 CALL lim_var_agg( 1 ) 368 369 … … 830 831 REAL(wp), POINTER, DIMENSION(:,:) :: ardg1 , ardg2 ! area of ice ridged & new ridges 831 832 REAL(wp), POINTER, DIMENSION(:,:) :: vsrdg , esrdg ! snow volume & energy of ridging ice 832 REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! areal age content of ridged & rifging ice833 833 REAL(wp), POINTER, DIMENSION(:,:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 834 834 … … 839 839 REAL(wp), POINTER, DIMENSION(:,:) :: srdg2 ! sal*volume of new ridges 840 840 REAL(wp), POINTER, DIMENSION(:,:) :: smsw ! sal*volume of water trapped into ridges 841 REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! ice age of ice ridged 841 842 842 843 REAL(wp), POINTER, DIMENSION(:,:) :: afrft ! fraction of category area rafted … … 844 845 REAL(wp), POINTER, DIMENSION(:,:) :: virft , vsrft ! ice & snow volume of rafting ice 845 846 REAL(wp), POINTER, DIMENSION(:,:) :: esrft , smrft ! snow energy & salinity of rafting ice 846 REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! areal age content of rafted ice & rafting ice847 REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! ice age of ice rafted 847 848 848 849 REAL(wp), POINTER, DIMENSION(:,:,:) :: eirft ! ice energy of rafting ice … … 854 855 CALL wrk_alloc( (jpi+1)*(jpj+1), indxi, indxj ) 855 856 CALL wrk_alloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final ) 856 CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2,dhr, dhr2 )857 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw )857 CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 858 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 858 859 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 859 860 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) … … 897 898 vsnwn_init(:,:,:) = v_s (:,:,:) 898 899 smv_i_init(:,:,:) = smv_i(:,:,:) 899 oa_i_init (:,:,:) = oa_i (:,:,:)900 900 esnwn_init(:,:,:) = e_s (:,:,1,:) 901 901 eicen_init(:,:,:,:) = e_i (:,:,:,:) 902 oa_i_init (:,:,:) = oa_i (:,:,:) 902 903 903 904 ! … … 939 940 arft2(ji,jj) = arft1(ji,jj) / kraft 940 941 941 oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice942 oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice943 oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1)944 oirft2(ji,jj)= oirft1(ji,jj) / kraft945 946 942 !--------------------------------------------------------------- 947 943 ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 … … 971 967 vsw (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 972 968 973 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 974 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 975 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 969 vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 970 esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 971 srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 972 oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) 973 oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1) 976 974 977 975 ! rafting volumes, heat contents ... 978 virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 979 vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 980 esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 981 smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 976 virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 977 vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 978 esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 979 smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 980 oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) 981 oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft 982 982 983 983 ! substract everything 984 a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - ardg1(ji,jj) - arft1(ji,jj) 985 v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - vrdg1(ji,jj) - virft(ji,jj) 986 v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - vsrdg(ji,jj) - vsrft(ji,jj) 987 e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj) - esrft(ji,jj) 984 a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - ardg1 (ji,jj) - arft1 (ji,jj) 985 v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - vrdg1 (ji,jj) - virft (ji,jj) 986 v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - vsrdg (ji,jj) - vsrft (ji,jj) 987 e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj) 988 smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj) 988 989 oa_i(ji,jj,jl1) = oa_i(ji,jj,jl1) - oirdg1(ji,jj) - oirft1(ji,jj) 989 smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj) - smrft(ji,jj)990 990 991 991 !----------------------------------------------------------------- 992 992 ! 3.5) Compute properties of new ridges 993 993 !----------------------------------------------------------------- 994 !--------- ----994 !--------- 995 995 ! Salinity 996 !--------- ----996 !--------- 997 997 smsw(ji,jj) = vsw(ji,jj) * sss_m(ji,jj) ! salt content of seawater frozen in voids !! MV HC2014 998 998 srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge … … 1118 1118 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirdg2(ji,jj) * farea 1119 1119 1120 END DO ! ij1120 END DO 1121 1121 1122 1122 ! Transfer ice energy to category jl2 by ridging … … 1145 1145 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 1146 1146 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + smrft (ji,jj) 1147 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj) 1147 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj) 1148 1148 ENDIF 1149 1149 ! … … 1187 1187 CALL wrk_dealloc( (jpi+1)*(jpj+1), indxi, indxj ) 1188 1188 CALL wrk_dealloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final ) 1189 CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2,dhr, dhr2 )1190 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw )1189 CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 1190 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 1191 1191 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 1192 1192 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
Note: See TracChangeset
for help on using the changeset viewer.
