Changeset 8787
- Timestamp:
- 2017-11-22T15:38:33+01:00 (7 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO
- Files:
-
- 2 edited
-
LIM_SRC_3/icevar.F90 (modified) (6 diffs)
-
OPA_SRC/BDY/bdydta.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icevar.F90
r8623 r8787 44 44 !! ice_var_salprof1d : salinity profile in the ice 1D 45 45 !! ice_var_zapsmall : remove very small area and volume 46 !! ice_var_itd : convert 1-cat to multiple cat 46 !! ice_var_itd : convert 1-cat to jpl-cat 47 !! ice_var_itd2 : convert N-cat to jpl-cat 47 48 !! ice_var_bv : brine volume 48 49 !!---------------------------------------------------------------------- … … 67 68 PUBLIC ice_var_zapsmall 68 69 PUBLIC ice_var_itd 70 PUBLIC ice_var_itd2 69 71 PUBLIC ice_var_bv 70 72 … … 549 551 !!------------------------------------------------------------------- 550 552 INTEGER :: ji, jk, jl ! dummy loop indices 551 INTEGER :: ijpij, i_fill, jl0553 INTEGER :: ndim, i_fill, jl0 552 554 REAL(wp) :: zarg, zV, zconv, zdh, zdv 553 555 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables … … 562 564 ! then we check whether the distribution fullfills 563 565 ! volume and area conservation, positivity and ice categories bounds 564 ijpij= SIZE( zhti , 1 )565 zh_i(1: ijpij,1:jpl) = 0._wp566 zh_s(1: ijpij,1:jpl) = 0._wp567 za_i (1:ijpij,1:jpl) = 0._wp568 569 DO ji = 1, ijpij566 ndim = SIZE( zhti , 1 ) 567 zh_i(1:ndim,1:jpl) = 0._wp 568 zh_s(1:ndim,1:jpl) = 0._wp 569 za_i(1:ndim,1:jpl) = 0._wp 570 571 DO ji = 1, ndim 570 572 571 573 IF( zhti(ji) > 0._wp ) THEN … … 649 651 ! Add Snow in each category where za_i is not 0 650 652 DO jl = 1, jpl 651 DO ji = 1, ijpij653 DO ji = 1, ndim 652 654 IF( za_i(ji,jl) > 0._wp ) THEN 653 655 zh_s(ji,jl) = zh_i(ji,jl) * ( zhts(ji) / zhti(ji) ) … … 662 664 END DO 663 665 ! 664 END SUBROUTINE ice_var_itd 665 666 667 SUBROUTINE ice_var_bv 666 END SUBROUTINE ice_var_itd 667 668 SUBROUTINE ice_var_itd2( zhti, zhts, zati, zh_i, zh_s, za_i ) 669 !!------------------------------------------------------------------- 670 !! *** ROUTINE ice_var_itd2 *** 671 !! 672 !! ** Purpose : converting N-cat ice to jpl ice categories 673 !! 674 !! ice thickness distribution follows a gaussian law 675 !! around the concentration of the most likely ice thickness 676 !! (similar as iceistate.F90) 677 !! 678 !! ** Method: Iterative procedure 679 !! 680 !! 1) Fill ice cat that correspond to input thicknesses 681 !! Find the lowest(jlmin) and highest(jlmax) cat that are filled 682 !! 683 !! 2) Expand the filling to the cat jlmin-1 and jlmax+1 684 !! by removing 25% ice area from jlmin and jlmax (resp.) 685 !! 686 !! 3) Expand the filling to the empty cat between jlmin and jlmax 687 !! by a) removing 25% ice area from the lower cat (ascendant loop jlmin=>jlmax) 688 !! b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 689 !! 690 !! ** Arguments : zhti: N-cat ice thickness 691 !! zhts: N-cat snow depth 692 !! zati: N-cat ice concentration 693 !! 694 !! ** Output : jpl-cat 695 !! 696 !! (Example of application: BDY forcings when inputs have N-cat /= jpl) 697 !!------------------------------------------------------------------- 698 INTEGER :: ji, jl, jl1, jl2 ! dummy loop indices 699 INTEGER :: ndim, ncat 700 INTEGER, PARAMETER :: ztrans = 0.25_wp 701 REAL(wp), DIMENSION(:,:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables 702 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zh_i, zh_s, za_i ! output ice/snow variables 703 INTEGER , DIMENSION(:,:), ALLOCATABLE :: jlfil, jlfil2 704 INTEGER , DIMENSION(:) , ALLOCATABLE :: jlmax, jlmin 705 !!------------------------------------------------------------------- 706 ! 707 ndim = SIZE( zhti, 1 ) 708 ncat = SIZE( zhti, 2 ) 709 710 ! allocate arrays 711 ALLOCATE( jlfil(ndim,jpl), jlfil2(ndim,jpl) ) 712 ALLOCATE( jlmin(ndim), jlmax(ndim) ) 713 714 ! --- initialize output fields to 0 --- ! 715 zh_i(1:ndim,1:jpl) = 0._wp 716 zh_s(1:ndim,1:jpl) = 0._wp 717 za_i(1:ndim,1:jpl) = 0._wp 718 ! 719 ! --- fill the categories --- ! 720 ! find where cat-input = cat-output and fill cat-output fields 721 jlmax(:) = 0 722 jlmin(:) = 999 723 jlfil(:,:) = 0 724 DO jl1 = 1, jpl 725 DO jl2 = 1, ncat 726 DO ji = 1, ndim 727 IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN 728 ! fill the right category 729 zh_i(ji,jl1) = zhti(ji,jl2) 730 zh_s(ji,jl1) = zhts(ji,jl2) 731 za_i(ji,jl1) = zati(ji,jl2) 732 ! record categories that are filled 733 jlmax(ji) = MAX( jlmax(ji), jl1 ) 734 jlmin(ji) = MIN( jlmin(ji), jl1 ) 735 jlfil(ji,jl1) = jl1 736 ENDIF 737 END DO 738 END DO 739 END DO 740 ! 741 ! --- fill the gaps between categories --- ! 742 ! transfer from categories filled at the previous step to the empty ones in between 743 DO ji = 1, ndim 744 jl1 = jlmin(ji) 745 jl2 = jlmax(ji) 746 IF( jl1 > 1 ) THEN 747 ! fill the lower cat (jl1-1) 748 za_i(ji,jl1-1) = ztrans * za_i(ji,jl1) 749 zh_i(ji,jl1-1) = hi_mean(jl1-1) 750 ! remove from cat jl1 751 za_i(ji,jl1 ) = ( 1._wp - ztrans ) * za_i(ji,jl1) 752 ENDIF 753 IF( jl2 < jpl ) THEN 754 ! fill the upper cat (jl2+1) 755 za_i(ji,jl2+1) = ztrans * za_i(ji,jl2) 756 zh_i(ji,jl2+1) = hi_mean(jl2+1) 757 ! remove from cat jl2 758 za_i(ji,jl2 ) = ( 1._wp - ztrans ) * za_i(ji,jl2) 759 ENDIF 760 END DO 761 762 jlfil2(:,:) = jlfil(:,:) 763 ! fill categories from low to high 764 DO jl = 2, jpl-1 765 DO ji = 1, ndim 766 IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 767 ! fill high 768 za_i(ji,jl) = ztrans * za_i(ji,jl-1) 769 zh_i(ji,jl) = hi_mean(jl) 770 jlfil(ji,jl) = jl 771 ! remove low 772 za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1) 773 ENDIF 774 END DO 775 END DO 776 777 ! fill categories from high to low 778 DO jl = jpl-1, 2, -1 779 DO ji = 1, ndim 780 IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 781 ! fill low 782 za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1) 783 zh_i(ji,jl) = hi_mean(jl) 784 jlfil2(ji,jl) = jl 785 ! remove high 786 za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1) 787 ENDIF 788 END DO 789 END DO 790 791 ! deallocate arrays 792 DEALLOCATE( jlfil, jlfil2 ) 793 DEALLOCATE( jlmin, jlmax ) 794 795 END SUBROUTINE ice_var_itd2 796 797 798 SUBROUTINE ice_var_bv 668 799 !!------------------------------------------------------------------- 669 800 !! *** ROUTINE ice_var_bv *** -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r8563 r8787 48 48 49 49 #if defined key_lim3 50 LOGICAL :: ll_bdylim3 ! determine whether ice input is 1cat (F) or Xcat (T) type50 INTEGER :: nice_cat ! number of categories in the input file 51 51 INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure 52 52 #endif … … 175 175 176 176 #if defined key_lim3 177 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 177 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN ! set ice to initial values 178 178 ilen1(:) = nblen(:) 179 179 IF( dta%ll_a_i ) THEN … … 343 343 ENDIF 344 344 #if defined key_lim3 345 IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is 1cat) 346 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 347 & dta_bdy(ib_bdy)%h_i, dta_bdy(ib_bdy)%h_s, dta_bdy(ib_bdy)%a_i ) 345 IF( cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN 346 IF( nice_cat == 1 ) THEN ! case input cat = 1 347 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 348 & dta_bdy(ib_bdy)%h_i , dta_bdy(ib_bdy)%h_s , dta_bdy(ib_bdy)%a_i ) 349 ELSEIF( nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 350 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 351 & dta_bdy(ib_bdy)%h_i , dta_bdy(ib_bdy)%h_s , dta_bdy(ib_bdy)%a_i ) 352 ENDIF 348 353 ENDIF 349 354 #endif … … 413 418 TYPE(OBC_DATA), POINTER :: dta ! short cut 414 419 #if defined key_lim3 415 INTEGER :: zndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 420 INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 421 INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions 416 422 INTEGER :: inum,id1 ! local integer 417 423 #endif … … 619 625 ! 620 626 CALL iom_open ( clname, inum ) 621 id1 = iom_varid( inum, bn_a_i%clvar, k ndims=zndims, ldstop = .FALSE. )627 id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. ) 622 628 CALL iom_close ( inum ) 623 629 624 IF ( zndims == 4 ) THEN625 ll_bdylim3 = .TRUE.! Xcat input630 IF ( kndims == 4 ) THEN 631 nice_cat = kdimsz(4) ! Xcat input 626 632 ELSE 627 ll_bdylim3 = .FALSE.! 1cat input633 nice_cat = 1 ! 1cat input 628 634 ENDIF 629 635 ! End test … … 632 638 jfld = jfld + 1 633 639 blf_i(jfld) = bn_a_i 634 ibdy(jfld) = ib_bdy640 ibdy(jfld) = ib_bdy 635 641 igrid(jfld) = 1 636 642 ilen1(jfld) = nblen(igrid(jfld)) 637 IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF643 ilen3(jfld) = nice_cat 638 644 ENDIF 639 645 … … 641 647 jfld = jfld + 1 642 648 blf_i(jfld) = bn_h_i 643 ibdy(jfld) = ib_bdy649 ibdy(jfld) = ib_bdy 644 650 igrid(jfld) = 1 645 651 ilen1(jfld) = nblen(igrid(jfld)) 646 IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF652 ilen3(jfld) = nice_cat 647 653 ENDIF 648 654 649 655 IF( dta%ll_h_s ) THEN 650 656 jfld = jfld + 1 651 652 ibdy(jfld) = ib_bdy657 blf_i(jfld) = bn_h_s 658 ibdy(jfld) = ib_bdy 653 659 igrid(jfld) = 1 654 660 ilen1(jfld) = nblen(igrid(jfld)) 655 IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF661 ilen3(jfld) = nice_cat 656 662 ENDIF 657 663 … … 789 795 ALLOCATE( dta_bdy(ib_bdy)%h_s(nblen(1),jpl) ) 790 796 ELSE 791 IF ( ll_bdylim3 ) THEN ! case input is Xcat797 IF ( nice_cat == jpl ) THEN ! case input cat = jpl 792 798 jfld = jfld + 1 793 799 dta_bdy(ib_bdy)%a_i => bf(jfld)%fnow(:,1,:) … … 796 802 jfld = jfld + 1 797 803 dta_bdy(ib_bdy)%h_s => bf(jfld)%fnow(:,1,:) 798 ELSE ! case input is 1cat804 ELSE ! case input cat = 1 OR (/=1 and /=jpl) 799 805 jfld_ai = jfld + 1 800 806 jfld_hti = jfld + 2
Note: See TracChangeset
for help on using the changeset viewer.
