Changeset 834 for trunk/NEMO/LIM_SRC_3/limitd_th.F90
- Timestamp:
- 2008-03-07T18:11:35+01:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC_3/limitd_th.F90 (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_3/limitd_th.F90
r825 r834 1 1 MODULE limitd_th 2 2 #if defined key_lim3 3 !!---------------------------------------------------------------------- 4 !! 'key_lim3' : LIM3 sea-ice model 5 !!---------------------------------------------------------------------- 3 6 !!====================================================================== 4 7 !! *** MODULE limitd_th *** … … 15 18 USE ice_oce ! ice variables 16 19 USE thd_ice 17 USE limicepoints18 20 USE limistate 19 21 USE in_out_manager 20 22 USE ice 21 23 USE par_ice 22 USE limthd_lab23 24 USE limthd_lac 24 25 USE limvar … … 44 45 45 46 !!---------------------------------------------------------------------- 46 !! LIM -@ 4.0, UCL-ASTR (2005)47 !! LIM3.0, UCL-ASTR (2008) 47 48 !! (c) UCL-ASTR and Martin Vancoppenolle 48 49 !!---------------------------------------------------------------------- … … 73 74 !! ** History : 74 75 !! (12-2005) Martin Vancoppenolle 75 !! Au moment ou j'ecris ces lignes, je ne me rends pas76 !! compte du boulot que j'entame... un truc de malate comme77 !! on dit ici chez les Belches78 76 !! 79 77 !!------------------------------------------------------------------ … … 81 79 82 80 !! * Local variables 83 INTEGER :: ji, & ! spatial dummy loop index 84 jj, & ! spatial dummy loop index 85 jk, & ! vertical layering dummy loop index 86 jl, & ! ice category dummy loop index 87 jm, & ! ice types dummy loop index 88 index, & 81 INTEGER :: jm, & ! ice types dummy loop index 89 82 jbnd1, & 90 83 jbnd2 … … 94 87 epsi10 = 1.0e-10 95 88 96 REAL(wp) :: & ! constant values for ice enthalpy97 zindb98 99 89 !!-- End of declarations 100 90 !!---------------------------------------------------------------------------------------------- 101 91 102 IF (lwp) THEN92 IF (lwp) THEN 103 93 WRITE(numout,*) 104 WRITE(numout,*) 'lim_itd_th : Thermodynamics of the ice thickness distribution'94 WRITE(numout,*) 'lim_itd_th : Thermodynamics of the ice thickness distribution' 105 95 WRITE(numout,*) '~~~~~~~~~~~' 106 96 ENDIF … … 120 110 CALL lim_var_agg(1) 121 111 122 !+++++123 WRITE(numout,*) ' From limitd_th : '124 WRITE(numout,*) ' at_i : ', at_i(jiindex,jjindex)125 WRITE(numout,*) ' vt_i : ', vt_i(jiindex,jjindex)126 WRITE(numout,*) ' vt_s : ', vt_s(jiindex,jjindex)127 DO jl = 1, jpl128 WRITE(numout,*) '* - category number ', jl129 WRITE(numout,*) ' a_i : ', a_i(jiindex,jjindex,jl)130 WRITE(numout,*) ' v_i : ', v_i(jiindex,jjindex,jl)131 WRITE(numout,*) ' ht_i : ', ht_i(jiindex,jjindex,jl)132 WRITE(numout,*) ' v_s : ', v_s(jiindex,jjindex,jl)133 WRITE(numout,*) ' ht_s : ', ht_s(jiindex,jjindex,jl)134 WRITE(numout,*) ' e_s : ', e_s(jiindex,jjindex,1,jl)/1.0e9135 WRITE(numout,*) ' e_i : ', e_i(jiindex,jjindex,1:nlay_i,jl)/1.0e9136 WRITE(numout,*) ' t_su : ', t_su(jiindex,jjindex,jl)137 WRITE(numout,*) ' t_snow : ', t_s(jiindex,jjindex,1,jl)138 WRITE(numout,*) ' t_i : ', t_i(jiindex,jjindex,1:nlay_i,jl)139 WRITE(numout,*) ' smv_i : ', smv_i(jiindex,jjindex,jl)140 WRITE(numout,*) ' oa_i : ', oa_i(jiindex,jjindex,jl)141 WRITE(numout,*)142 END DO143 !+++++144 145 !------------------------------------------------------------------------------|146 ! 2) Melt ice laterally.147 !------------------------------------------------------------------------------|148 ! DO jm = 1, jpm149 ! CALL lim_thd_lab(ice_cat_bounds(jm,1),ice_cat_bounds(jm,2))150 ! END DO151 ! CALL lim_thd_lab152 153 112 !------------------------------------------------------------------------------| 154 113 ! 3) Add frazil ice growing in leads. … … 158 117 CALL lim_var_glo2eqv ! only for info 159 118 160 !+++++161 WRITE(numout,*) ' limthd_lac, new values ***** '162 DO jl = 1, jpl163 WRITE(numout,*) '* - category number ', jl164 WRITE(numout,*) ' a_i : ', a_i(jiindex,jjindex,jl)165 WRITE(numout,*) ' ht_i : ', ht_i(jiindex,jjindex,jl)166 WRITE(numout,*) ' v_i : ', v_i(jiindex,jjindex,jl)167 WRITE(numout,*) ' v_s : ', v_s(jiindex,jjindex,jl)168 WRITE(numout,*) ' e_i : ', e_i(jiindex,jjindex,1:nlay_i,jl)/1.0e9169 WRITE(numout,*) ' smv_i : ', smv_i(jiindex,jjindex,jl)170 WRITE(numout,*) ' t_su : ', t_su(jiindex,jjindex,jl)171 WRITE(numout,*) ' t_snow : ', t_s(jiindex,jjindex,1,jl)172 WRITE(numout,*) ' t_i : ', t_i(jiindex,jjindex,1:nlay_i,jl)173 WRITE(numout,*)174 END DO175 !+++++176 119 !---------------------------------------------------------------------------------------- 177 120 ! 4) Computation of trend terms and get back to old values … … 230 173 !! (06-2006) Adaptation to include salt, age and types 231 174 !! (04-2007) Mass conservation checked 232 !!233 !! Je suis d'humeur massacrante aujourd'hui, tout234 !! le monde m'embete et m'empeche de coder235 !!236 !! Muere lentamente237 !! quien evita una pasion y su remolino de emociones238 !! justamente estas que regresan el brillo a los ojos239 !! y restauran los corazones destrozados240 !!241 175 !!------------------------------------------------------------------ 242 176 !! * Arguments … … 250 184 INTEGER :: ji, & ! spatial dummy loop index 251 185 jj, & ! spatial dummy loop index 252 jk, & ! vertical layering dummy loop index253 186 jl, & ! ice category dummy loop index 254 index, & ! for ice points255 187 zji, zjj, & ! dummy indices used when changing coordinates 256 188 nd ! used for thickness categories … … 307 239 308 240 REAL(wp) :: & ! constant values for ice enthalpy 309 zdummy, zdummy2, &310 241 zslope ! used to compute local thermodynamic "speeds" 311 242 … … 337 268 !! 1) Compute thickness and changes in each ice category 338 269 !!---------------------------------------------------------------------------------------------- 339 IF (lwp) THEN340 341 WRITE(numout,*) 'lim_itd_th_rem: Remapping the ice thickness distribution'342 343 WRITE(numout,*) 'klbnd : ', klbnd344 WRITE(numout,*) 'kubnd : ', kubnd345 WRITE(numout,*) 'ntyp : ', ntyp270 IF (lwp) THEN 271 WRITE(numout,*) 272 WRITE(numout,*) 'lim_itd_th_rem : Remapping the ice thickness distribution' 273 WRITE(numout,*) '~~~~~~~~~~~~~~~' 274 WRITE(numout,*) ' klbnd : ', klbnd 275 WRITE(numout,*) ' kubnd : ', kubnd 276 WRITE(numout,*) ' ntyp : ', ntyp 346 277 ENDIF 347 348 ! +++++ [349 ! index = 1350 ! jiindex = arc_sp_grid(index,1)351 ! jjindex = arc_sp_grid(index,2)352 ! WRITE(numout,*) '*', arc_sp_acro(index), ' ', arc_sp_name(index)353 ! WRITE(numout,*)354 ! WRITE(numout,*) ' a_i : ', a_i(jiindex,jjindex,klbnd:kubnd)355 ! WRITE(numout,*) ' ht_i : ', ht_i(jiindex,jjindex,klbnd:kubnd)356 ! WRITE(numout,*) ' v_i : ', v_i(jiindex,jjindex,klbnd:kubnd)357 ! +++++ ]358 278 359 279 zdhice(:,:,:) = 0.0 … … 361 281 DO jj = 1, jpj 362 282 DO ji = 1, jpi 363 364 283 zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 365 284 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl),zeps) * zindb … … 369 288 zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 370 289 ENDIF 371 372 290 END DO 373 291 END DO 374 292 END DO 375 !+++++376 ! WRITE(numout,*) ' 1 *** '377 ! WRITE(numout,*) ' klbnd -> kubnd ', klbnd, kubnd378 ! WRITE(numout,*) 'ht_i ', ht_i (jiindex,jjindex,klbnd:kubnd)379 ! WRITE(numout,*) 'zht_i_o', zht_i_o(jiindex,jjindex,klbnd:kubnd)380 ! WRITE(numout,*) 'zdhice ', zdhice (jiindex,jjindex,klbnd:kubnd)381 !+++++382 293 383 294 !----------------------------------------------------------------------------------------------- … … 392 303 END DO 393 304 END DO 394 395 !+++++396 ! WRITE(numout,*) ' 2 *** '397 ! WRITE(numout,*) ' klbnd -> kubnd ', klbnd, kubnd398 ! WRITE(numout,*) 'a_i ', a_i (jiindex,jjindex,klbnd:kubnd)399 ! WRITE(numout,*) 'at_i ', at_i (jiindex,jjindex)400 !+++++401 305 402 306 !----------------------------------------------------------------------------------------------- … … 478 382 ! ji 479 383 END DO !jl 480 !+++++481 ! WRITE(numout,*) ' 4 *** '482 ! WRITE(numout,*) ' klbnd -> kubnd - 1 ', klbnd, kubnd - 1483 ! WRITE(numout,*) ' hi_max ', hi_max(klbnd:kubnd-1)484 ! WRITE(numout,*) ' zhbnew ', zhbnew(jiindex,jjindex,klbnd:kubnd-1)485 !+++++486 384 487 385 !----------------------------------------------------------------------------------------------- … … 521 419 END DO !jj 522 420 523 !+++++524 ! WRITE(numout,*) ' 6 *** '525 ! WRITE(numout,*) ' klbnd -1, kubnd ', klbnd - 1, kubnd526 ! WRITE(numout,*) ' zhb0 ', zhb0(jiindex,jjindex)527 ! WRITE(numout,*) ' zhb1 ', zhb1(jiindex,jjindex)528 ! WRITE(numout,*) ' zhbnew klbnd-1 ', zhbnew(jiindex,jjindex,klbnd-1)529 ! WRITE(numout,*) ' zhbnew kubnd ', zhbnew(jiindex,jjindex,klbnd)530 !+++++531 532 421 !----------------------------------------------------------------------------------------------- 533 422 ! 7) Compute g(h) … … 537 426 g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 538 427 hR(:,:,klbnd), zremap_flag) 539 540 !+++++541 ! WRITE(numout,*) ' 7a *** klbnd ', klbnd542 ! WRITE(numout,*) ' g0(klbnd) ', g0(jiindex,jjindex,klbnd)543 ! WRITE(numout,*) ' g1(klbnd) ', g1(jiindex,jjindex,klbnd)544 ! WRITE(numout,*) ' hL(klbnd) ', hL(jiindex,jjindex,klbnd)545 ! WRITE(numout,*) ' hR(klbnd) ', hR(jiindex,jjindex,klbnd)546 !+++++547 428 548 429 !- 7.2 Area lost due to melting of thin ice (first category, klbnd) … … 601 482 END DO 602 483 603 !+++++604 ! WRITE(numout,*) ' 7b *** klbnd->kubnd ', klbnd, kubnd605 ! WRITE(numout,*) ' g0 ', g0(jiindex,jjindex,klbnd:kubnd)606 ! WRITE(numout,*) ' g1 ', g1(jiindex,jjindex,klbnd:kubnd)607 ! WRITE(numout,*) ' hL ', hL(jiindex,jjindex,klbnd:kubnd)608 ! WRITE(numout,*) ' hR ', hR(jiindex,jjindex,klbnd:kubnd)609 ! WRITE(numout,*)610 ! WRITE(numout,*) ' ht_i ', ht_i(jiindex,jjindex,klbnd:kubnd)611 ! WRITE(numout,*) ' a_i ', a_i (jiindex,jjindex,klbnd:kubnd)612 ! WRITE(numout,*) ' v_i ', v_i (jiindex,jjindex,klbnd:kubnd)613 !+++++614 615 484 !----------------------------------------------------------------------------------------------- 616 485 ! 8) Compute area and volume to be shifted across each boundary … … 669 538 CALL lim_itd_shiftice ( klbnd, kubnd, zdonor, zdaice, zdvice ) 670 539 671 ! WRITE(numout,*) ' 9 *** '672 ! WRITE(numout,*) ' ht_i ', ht_i(jiindex,jjindex,klbnd:kubnd)673 ! WRITE(numout,*) ' a_i ', a_i (jiindex,jjindex,klbnd:kubnd)674 ! WRITE(numout,*) ' v_i ', v_i (jiindex,jjindex,klbnd:kubnd)675 676 540 !!---------------------------------------------------------------------------------------------- 677 541 !! 10) Make sure ht_i >= minimum ice thickness hi_min … … 741 605 !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 742 606 !! (01-2006) Martin Vancoppenolle 743 !! Au moment ou j'ecris ces lignes, je ne me rends pas744 !! compte du boulot que j'entame... un truc de malate comme745 !! on dit ici chez les Belches746 !! This routine was inspired from CICE (W.H. Lipscomb, E. Hunke, C. M. Bitz)747 !! the sea ice model of LANL, Los Alamos, USA.748 !! Thanks to these guys and their team to put their routines online749 607 !! 750 608 !!------------------------------------------------------------------ … … 783 641 !!-- End of declarations 784 642 !!---------------------------------------------------------------------------------------------- 785 786 ! WRITE(numout,*) ' lim_itd_fitline : linearly fitting the function g(h) '787 ! WRITE(numout,*) ' ~~~~~~~~~~~~~~~ in category number ', num_cat788 643 789 644 DO jj = 1, jpj … … 853 708 !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 854 709 !! (01-2006) Martin Vancoppenolle 855 !! Et quand fatigues de s'etre souvenus856 !! Nos souvenirs fatigues ne seront plus que des loques...857 !! "!!! Il a attrape la ratatinette, l'epouvantable ratatinette"858 !!859 !! This routine was largely inspired from CICE860 !! (W.H. Lipscomb, E. Hunke, C. M. Bitz)861 !! the sea ice model of LANL, Los Alamos, USA.862 !! Merci a eux et a leur equipe de mettre leurs routines en ligne863 !!864 !! J'ajoute aujourd'hui : le secret de ma vie pour l'instant865 !! c'est de trouver la balance entre mon ego et l'absence d'ego866 !! balance entre respect des autres et respect de moi867 !! trouver comment realiser la compréhension de l'autre868 !! sans déclencher ma propre aliénation869 710 !! 870 711 !!------------------------------------------------------------------ … … 887 728 jl1, & ! donor category 888 729 jk, & ! ice layer index 889 zji, zjj, & ! indices when changing from 2D-1D is done 890 index ! for ice points referencing 730 zji, zjj ! indices when changing from 2D-1D is done 891 731 892 732 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 893 zaTsfn, & 894 zqsnow 733 zaTsfn 895 734 896 735 REAL(wp), DIMENSION(jpi,jpj) :: & … … 902 741 zdeice , & ! ice energy transferred 903 742 zdsm_vice , & ! ice salinity times volume transferred 904 zsm_v1 , & ! ice salinity times volume905 zsm_v2 , & ! ice salinity times volume906 743 zdo_aice , & ! ice age times volume transferred 907 zo_v1 , & ! ice age times volume908 zo_v2 , & ! ice age times volume909 744 zdaTsf , & ! aicen*Tsfcn transferred 910 745 zindsn , & ! snow or not … … 928 763 929 764 !!-- End of declarations 930 ! WRITE(numout,*) ' lim_itd_shiftice : shifting ice between categories ' 931 ! WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 765 932 766 !---------------------------------------------------------------------------------------------- 933 767 ! 1) Define a variable equal to a_i*T_su … … 1024 858 END DO !jl 1025 859 1026 !-----------------------------------------------------------------1027 ! error messages1028 !-----------------------------------------------------------------1029 1030 ! if (daice_negative) then1031 ! do j = jlo,jhi1032 ! do i = ilo,ihi1033 ! if (donor(i,j,n) > 0 .and. daice(i,j,n) <= -puny) then1034 ! write(nu_diag,*) my_task,':',i,j,1035 ! & 'ITD Neg daice =',daice(i,j,n),' boundary',n1036 ! call abort_ice ('ice: ITD Neg daice')1037 ! endif1038 ! enddo1039 ! enddo1040 ! endif1041 1042 ! if (dvice_negative) then1043 ! do j = jlo,jhi1044 ! do i = ilo,ihi1045 ! if (donor(i,j,n) > 0 .and. dvice(i,j,n) <= -puny) then1046 ! write(nu_diag,*) my_task,':',i,j,1047 ! & 'ITD Neg dvice =',dvice(i,j,n),' boundary',n1048 ! call abort_ice ('ice: ITD Neg dvice')1049 ! endif1050 ! enddo1051 ! enddo1052 ! endif1053 1054 ! if (daice_greater_aicen) then1055 ! do j = jlo,jhi1056 ! do i = ilo,ihi1057 ! if (donor(i,j,n) > 0) then1058 ! n1 = donor(i,j,n)1059 ! if (daice(i,j,n) >= aicen(i,j,n1)+puny) then1060 ! write(nu_diag,*) my_task,':',i,j,1061 ! & 'ITD daice > aicen, cat',n11062 ! write(nu_diag,*) my_task,':',i,j,1063 ! & 'daice =', daice(i,j,n),1064 ! & 'aicen =', aicen(i,j,n1)1065 ! call abort_ice ('ice: ITD daice > aicen')1066 ! endif1067 ! endif1068 ! enddo1069 ! enddo1070 ! endif1071 1072 ! if (dvice_greater_vicen) then1073 ! do j = jlo,jhi1074 ! do i = ilo,ihi1075 ! if (donor(i,j,n) > 0) then1076 ! n1 = donor(i,j,n)1077 ! if (dvice(i,j,n) >= vicen(i,j,n1)+puny) then1078 ! write(nu_diag,*) my_task,':',i,j,1079 ! & 'ITD dvice > vicen, cat',n11080 ! write(nu_diag,*) my_task,':',i,j,1081 ! & 'dvice =', dvice(i,j,n),1082 ! & 'vicen =', vicen(i,j,n1)1083 ! call abort_ice ('ice: ITD dvice > vicen')1084 ! endif1085 ! endif1086 ! enddo1087 ! enddo1088 ! endif1089 1090 ! enddo ! boundaries 1 to ncat-11091 1092 860 !------------------------------------------------------------------------------- 1093 861 ! 3) Transfer volume and energy between categories … … 1210 978 t_su(ji,jj,jl) = zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 1211 979 zindsn = 1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl))) !0 if no ice and 1 if yes 1212 ! t_s(ji,jj,1,jl) = - zQsnow(ji,jj,jl) / MAX(v_s(ji,jj,jl),zeps) * zindsn + rtt1213 980 ELSE 1214 981 ht_i(ji,jj,jl) = 0.0 1215 982 t_su(ji,jj,jl) = rtt 1216 ! t_s(ji,jj,1,jl) = rtt1217 983 ENDIF 1218 984 END DO ! ji … … 1246 1012 !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 1247 1013 !! (01-2006) Martin Vancoppenolle (adaptation) 1248 !!1249 !! Quel etre encore que celui-ci! Le Jugement Dernier sera la1250 !! avant qu'il vous fasse jamais une avance sur votre mois,1251 !! Seigneur! Tu peux supplier, te mettre en quatre,1252 !! meme si tu es dans la misere, il ne te donnera rien,1253 !! le vieux demon! Et quant on pense que, chez lui,1254 !! sa cuisiniere lui donne des gifles! Je ne vois pas l'interet1255 !! qu'il y a a travailler dans un ministere. Cela ne rapporte1256 !! absolument rien.1257 !!1258 !! This routine was largely inspired from CICE1259 !! (W.H. Lipscomb, E. Hunke, C. M. Bitz)1260 !! the sea ice model of LANL, Los Alamos, USA.1261 1014 !! 1262 1015 !!------------------------------------------------------------------ … … 1283 1036 REAL(wp) :: & ! constant values 1284 1037 zeps = 1.0e-10, & 1285 epsi10 = 1.0e-10, & 1286 zindb 1038 epsi10 = 1.0e-10 1287 1039 1288 1040 REAL (wp), DIMENSION(jpi,jpj) :: & ! … … 1294 1046 !!-- End of declarations 1295 1047 !------------------------------------------------------------------------------ 1296 ! WRITE(numout,*) ' lim_itd_th_reb '1297 ! WRITE(numout,*) ' ~~~~~~~~~~~~~~ '1298 ! WRITE(numout,*) ' Ice Type no ', ntyp1299 ! WRITE(numout,*) ' bounds of categories ', klbnd, kubnd1300 1048 1301 1049 ! ! conservation check 1302 ! CALL lim_column_sum (jpl, v_i, vt_i_init) 1303 ! CALL lim_column_sum (jpl, v_s, vt_s_init) 1050 IF ( con_i ) THEN 1051 CALL lim_column_sum (jpl, v_i, vt_i_init) 1052 CALL lim_column_sum (jpl, v_s, vt_s_init) 1053 ENDIF 1304 1054 1305 1055 ! … … 1307 1057 ! 1) Compute ice thickness. 1308 1058 !------------------------------------------------------------------------------ 1309 ! nothing to do1310 1059 DO jl = klbnd, kubnd 1311 1060 DO jj = 1, jpj … … 1447 1196 !------------------------------------------------------------------------------ 1448 1197 1449 ! CALL lim_column_sum (jpl, v_i, vt_i_final) 1450 ! fieldid = ' v_i : limitd_reb ' 1451 ! CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 1452 1453 ! CALL lim_column_sum (jpl, v_s, vt_s_final) 1454 ! fieldid = ' v_s : limitd_reb ' 1455 ! CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 1198 IF ( con_i ) THEN 1199 CALL lim_column_sum (jpl, v_i, vt_i_final) 1200 fieldid = ' v_i : limitd_reb ' 1201 CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 1202 1203 CALL lim_column_sum (jpl, v_s, vt_s_final) 1204 fieldid = ' v_s : limitd_reb ' 1205 CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 1206 ENDIF 1456 1207 1457 1208 END SUBROUTINE lim_itd_th_reb
Note: See TracChangeset
for help on using the changeset viewer.
