Changeset 834 for trunk/NEMO/LIM_SRC_3/limthd_lac.F90
- Timestamp:
- 2008-03-07T18:11:35+01:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC_3/limthd_lac.F90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_3/limthd_lac.F90
r825 r834 1 1 MODULE limthd_lac 2 2 #if defined key_lim3 3 !!---------------------------------------------------------------------- 4 !! 'key_lim3' LIM3 sea-ice model 5 !!---------------------------------------------------------------------- 3 6 !!====================================================================== 4 7 !! *** MODULE limthd_lac *** … … 20 23 USE iceini 21 24 USE limtab 22 USE limicepoints23 25 USE taumod 24 26 USE blk_oce … … 43 45 44 46 !!---------------------------------------------------------------------- 45 !! LIM 2.0, UCL-LOCEAN-IPSL (2005)47 !! LIM 3.0, UCL-ASTR-LOCEAN-IPSL (2008) 46 48 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limthd_lac.F90,v 1.5 2005/03/27 18:34:42 opalod Exp $ 47 49 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt … … 79 81 !! 80 82 !! History : 81 !! 1.0 ! 01-04 (T. Fichefet, M. A. Morales Maqueda, H. Goosse)82 !! ! original code83 !! 2.0 ! 02-08 (C. Ethe, G. Madec) F90, mpp84 83 !! 3.0 ! 12-05 (M. Vancoppenolle) Thorough rewrite of the routine 85 84 !! Salinity variations in sea ice, 86 85 !! Multi-layer code 87 !! 3.1 ! 01-06 (M. Vancoppenolle) I ce thickness distribution86 !! 3.1 ! 01-06 (M. Vancoppenolle) ITD 88 87 !! 3.2 ! 04-07 (M. Vancoppenolle) Mass and energy conservation tested 89 88 !!------------------------------------------------------------------------ … … 185 184 186 185 REAL(wp) :: & 187 zde , & ! :increment of energy in category jl 188 zde_old , & ! :dummy variable for energy conservation 189 zde_new , & ! :dummy variable for energy conservation 190 zde_nice , & ! :dummy variable for energy conservation 191 zde_diff ! :dummy variable for energy conservation 186 zde ! :increment of energy in category jl 192 187 193 188 CHARACTER (len = 15) :: fieldid … … 199 194 vt_i_init(:,:) = 0.0 200 195 vt_s_init(:,:) = 0.0 201 IF(lwp) THEN 202 WRITE(numout,*) 'lim_thd_lac : Creating new ice' 203 WRITE(numout,*) '~~~~~~~~~~~' 196 zeps6 = 1.0e-6 197 198 !------------------------------------------------------------------------------! 199 ! 1) Conservation check and changes in each ice category 200 !------------------------------------------------------------------------------! 201 IF ( con_i ) THEN 202 CALL lim_column_sum (jpl, v_i, vt_i_init) 203 CALL lim_column_sum (jpl, v_s, vt_s_init) 204 CALL lim_column_sum_energy (jpl, nlay_i, e_i, et_i_init) 205 CALL lim_column_sum (jpl, e_s(:,:,1,:) , et_s_init) 204 206 ENDIF 205 zeps6 = 1.0e-6206 207 !++++++++++208 WRITE(numout,*) ' Step 0 '209 WRITE(numout,*) ' v_i : ', v_i(jiindex,jjindex,1:jpl)210 WRITE(numout,*) ' a_i : ', a_i(jiindex,jjindex,1:jpl)211 DO jk = 1, nlay_i212 WRITE(numout,*) ' e_i : ', jk, e_i(jiindex,jjindex,jk,1:jpl)213 END DO214 !++++++++++215 216 !------------------------------------------------------------------------------!217 ! 1) Conservation check and changes in each ice category218 !------------------------------------------------------------------------------!219 CALL lim_column_sum (jpl, v_i, vt_i_init)220 CALL lim_column_sum (jpl, v_s, vt_s_init)221 CALL lim_column_sum_energy (jpl, nlay_i, e_i, et_i_init)222 CALL lim_column_sum (jpl, e_s(:,:,1,:) , et_s_init)223 207 224 208 !------------------------------------------------------------------------------| … … 497 481 ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice 498 482 !------------------------------------------------------------------------------! 483 499 484 !---------------------- 500 485 ! Thickness of new ice … … 511 496 zjj = ( npac(ji) - 1 ) / jpi + 1 512 497 WRITE(numout,*) ' collection thickness <= 0 ', zh_newice(ji), ji, zji, zjj 513 ! WRITE(numout,*) ' LATITUDE ', gphit(zji,zjj), ' LONGITUDE ', &514 ! glamt(zji,zjj)515 ! WRITE(numout,*) ' zh_newice ', zh_newice(ji)516 ! WRITE(numout,*) ' ji ', ji517 ! WRITE(numout,*) ' a_i ', a_i(zji,zjj,1:jpl)518 ! WRITE(numout,*) ' v_i ', v_i(zji,zjj,1:jpl)519 498 ENDIF 520 499 END DO … … 554 533 / ( t_bo_b(ji) - rtt ) ) & 555 534 - rcp * ( ztmelts-rtt ) ) 556 !+++++++++++557 IF ( ji .EQ. jiindex_1D ) THEN558 WRITE(numout,*) ' ze_newice : ', ze_newice(jiindex_1d)559 ENDIF560 !+++++++++++561 535 ze_newice(ji) = MAX( ze_newice(ji) , 0.0 ) + & 562 536 MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) ) & 563 537 * rhoic * lfus 564 !+++++++++++565 IF ( ji .EQ. jiindex_1D ) THEN566 WRITE(numout,*) ' ze_newice : ', ze_newice(jiindex_1d)567 ENDIF568 !+++++++++++569 538 END DO ! ji 570 !+++++++++++571 IF ( jiindex_1d .GT. 0) WRITE(numout,*) ' ze_newice : ', ze_newice(jiindex_1d)572 !+++++++++++573 574 539 !---------------- 575 540 ! Age of new ice … … 585 550 zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji) !<0 586 551 END DO ! ji 587 !+++++++++++588 IF (jiindex_1d .GT. 0 ) THEN589 WRITE(numout,*) ' qldif : ', qldif_1d(jiindex_1d)590 WRITE(numout,*) ' qcmif : ', qcmif_1d(jiindex_1d)591 WRITE(numout,*) ' zqbgow : ', zqbgow(jiindex_1d)592 ENDIF593 !+++++++++++594 552 595 553 !------------------- … … 605 563 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 606 564 END DO 607 !+++++++++++608 IF (jiindex_1d .GT. 0) THEN609 WRITE(numout,*) ' zv_newice : ', zv_newice(jiindex_1d)610 ENDIF611 !+++++++++++612 565 613 566 !------------------------------------ … … 663 616 za_newice(ji) = za_newice(ji) - zda_res(ji) 664 617 zv_newice(ji) = zv_newice(ji) - zdv_res(ji) 665 IF ( ji .EQ. jiindex_1D ) THEN666 WRITE(numout,*) ' zv_newice : ', zv_newice(ji)667 WRITE(numout,*) ' zdv_res : ', zdv_res (ji)668 ENDIF669 618 ELSE 670 619 zda_res(ji) = 0.0 … … 678 627 zat_i_ac(:) = 0.0 679 628 680 WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex, 1:jpl)681 629 DO jl = 1, jpl 682 630 DO ji = 1, nbpac … … 691 639 END DO ! ji 692 640 END DO ! jl 693 WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex, 1:jpl)694 641 695 ! !++++++++++++++++696 DO ji = 1, nbpac697 ! !+++++698 IF (zat_i_ac(ji).gt.1.0) THEN699 zji = MOD( npac(ji) - 1, jpi ) + 1700 zjj = ( npac(ji) - 1 ) / jpi + 1701 WRITE(numout,*) ' *** ERROR MESSAGE *** '702 WRITE(numout,*) ' something MUST be wrong '703 WRITE(numout,*) ' at_i : ', zat_i_ac(ji)704 WRITE(numout,*) ' is wrong '705 WRITE(numout,*) ' point : ', zji, zjj706 ENDIF707 END DO ! ji708 !++++++++++++++++709 710 642 !---------------------------------- 711 643 ! Heat content - lateral accretion … … 849 781 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - & 850 782 za_i_ac(ji,jl) ) ) ! 0 if no ice and 1 if yes 851 !zo_i_ac(ji,jl) = zv_old(ji,jl) * zo_i_ac(ji,jl) / &852 !MAX(zv_i_ac(ji,jl),zeps) * zindb853 783 zoa_i_ac(ji,jl) = za_old(ji,jl) * zoa_i_ac(ji,jl) / & 854 784 MAX( za_i_ac(ji,jl) , zeps ) * zindb … … 940 870 END DO 941 871 942 !++++943 WRITE(numout,*) 'lim_thd_lac : Salt flux diagnostic '944 WRITE(numout,*) '~~~~~~~~~~~~'945 WRITE(numout,*) ' *** Salt fluxes at bottom interface ***'946 WRITE(numout,*) ' fseqv : ', fseqv(jiindex,jjindex)947 WRITE(numout,*)948 !++++949 950 872 !------------------------------------------------------------------------------| 951 873 ! 10) Conservation check and changes in each ice category 952 874 !------------------------------------------------------------------------------| 953 875 876 IF ( con_i ) THEN 954 877 CALL lim_column_sum (jpl, v_i, vt_i_final) 955 878 fieldid = 'v_i, limthd_lac' … … 972 895 WRITE(numout,*) ' et_i_init : ', et_i_init(jiindex,jjindex) 973 896 WRITE(numout,*) ' et_i_final: ', et_i_final(jiindex,jjindex) 897 898 ENDIF 974 899 975 900 END SUBROUTINE lim_thd_lac
Note: See TracChangeset
for help on using the changeset viewer.
