New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11228 – NEMO

Changeset 11228


Ignore:
Timestamp:
2019-07-09T14:21:55+02:00 (5 years ago)
Author:
clem
Message:

debug BDY-ice by allowing any number of categories as input. Ticket #2300 may also be solved

Location:
NEMO/releases/release-4.0
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • NEMO/releases/release-4.0/cfgs/SPITZ12/EXPREF/namelist_ice_cfg

    r10910 r11228  
    102102&namdia         !   Diagnostics 
    103103!------------------------------------------------------------------------------ 
     104   ln_icediachk     = .true.         !  check online the heat, mass & salt budgets (T) or not (F) 
    104105/ 

  • NEMO/releases/release-4.0/src/ICE/iceistate.F90

    r10534 r11228  
    504504      !! 
    505505      !!----------------------------------------------------------------------------- 
    506       INTEGER ::   ji, jj 
    507       INTEGER ::   ios, ierr, inum_ice   ! Local integer output status for namelist read 
     506      INTEGER ::   ios   ! Local integer output status for namelist read 
    508507      INTEGER ::   ifpr, ierror 
    509508      ! 

  • NEMO/releases/release-4.0/src/ICE/icethd_do.F90

    r10993 r11228  
    128128 
    129129      ! Default new ice thickness 
    130       WHERE( qlead(:,:) < 0._wp )   ;   ht_i_new(:,:) = rn_hinew 
    131       ELSEWHERE                     ;   ht_i_new(:,:) = 0._wp 
     130      WHERE( qlead(:,:) < 0._wp  .AND. tau_icebfr(:,:) == 0._wp )   ;   ht_i_new(:,:) = rn_hinew ! if cooling and no landfast 
     131      ELSEWHERE                                                     ;   ht_i_new(:,:) = 0._wp 
    132132      END WHERE 
    133133 
    … …  
    182182                  END DO 
    183183                  ! 
     184                  ! bound ht_i_new (though I don't see why it should be necessary) 
     185                  ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) ) 
     186                  ! 
    184187               ENDIF 
    185188               ! 

  • NEMO/releases/release-4.0/src/ICE/icevar.F90

    r10993 r11228  
    7373   PUBLIC   ice_var_zapneg 
    7474   PUBLIC   ice_var_roundoff 
    75    PUBLIC   ice_var_itd 
    76    PUBLIC   ice_var_itd2 
    7775   PUBLIC   ice_var_bv            
    7876   PUBLIC   ice_var_enthalpy            
    7977   PUBLIC   ice_var_sshdyn 
     78   PUBLIC   ice_var_itd 
     79 
     80   INTERFACE ice_var_itd 
     81      MODULE PROCEDURE ice_var_itd_1c1c, ice_var_itd_Nc1c, ice_var_itd_1cMc, ice_var_itd_NcMc 
     82   END INTERFACE 
    8083 
    8184   !!---------------------------------------------------------------------- 
    … …  
    656659   END SUBROUTINE ice_var_roundoff 
    657660    
     661 
     662   SUBROUTINE ice_var_bv 
     663      !!------------------------------------------------------------------- 
     664      !!                ***  ROUTINE ice_var_bv *** 
     665      !! 
     666      !! ** Purpose :   computes mean brine volume (%) in sea ice 
     667      !! 
     668      !! ** Method  : e = - 0.054 * S (ppt) / T (C) 
     669      !! 
     670      !! References : Vancoppenolle et al., JGR, 2007 
     671      !!------------------------------------------------------------------- 
     672      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     673      !!------------------------------------------------------------------- 
     674      ! 
     675!!gm I prefere to use WHERE / ELSEWHERE  to set it to zero only where needed   <<<=== to be done 
     676!!   instead of setting everything to zero as just below 
     677      bv_i (:,:,:) = 0._wp 
     678      DO jl = 1, jpl 
     679         DO jk = 1, nlay_i 
     680            WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 )    
     681               bv_i(:,:,jl) = bv_i(:,:,jl) - rTmlt * sz_i(:,:,jk,jl) * r1_nlay_i / ( t_i(:,:,jk,jl) - rt0 ) 
     682            END WHERE 
     683         END DO 
     684      END DO 
     685      WHERE( vt_i(:,:) > epsi20 )   ;   bvm_i(:,:) = SUM( bv_i(:,:,:) * v_i(:,:,:) , dim=3 ) / vt_i(:,:) 
     686      ELSEWHERE                     ;   bvm_i(:,:) = 0._wp 
     687      END WHERE 
     688      ! 
     689   END SUBROUTINE ice_var_bv 
     690 
     691 
     692   SUBROUTINE ice_var_enthalpy 
     693      !!------------------------------------------------------------------- 
     694      !!                   ***  ROUTINE ice_var_enthalpy ***  
     695      !!                  
     696      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature 
     697      !! 
     698      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
     699      !!------------------------------------------------------------------- 
     700      INTEGER  ::   ji, jk   ! dummy loop indices 
     701      REAL(wp) ::   ztmelts  ! local scalar  
     702      !!------------------------------------------------------------------- 
     703      ! 
     704      DO jk = 1, nlay_i             ! Sea ice energy of melting 
     705         DO ji = 1, npti 
     706            ztmelts      = - rTmlt  * sz_i_1d(ji,jk) 
     707            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point => likely conservation issue 
     708                                                                !   (sometimes zdf scheme produces abnormally high temperatures)    
     709            e_i_1d(ji,jk) = rhoi * ( rcpi  * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) )           & 
     710               &                   + rLfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) )   & 
     711               &                   - rcp   * ztmelts ) 
     712         END DO 
     713      END DO 
     714      DO jk = 1, nlay_s             ! Snow energy of melting 
     715         DO ji = 1, npti 
     716            e_s_1d(ji,jk) = rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) 
     717         END DO 
     718      END DO 
     719      ! 
     720   END SUBROUTINE ice_var_enthalpy 
     721 
    658722    
    659    SUBROUTINE ice_var_itd( zhti, zhts, zati, zh_i, zh_s, za_i ) 
    660       !!------------------------------------------------------------------- 
    661       !!                ***  ROUTINE ice_var_itd   *** 
    662       !! 
    663       !! ** Purpose :  converting 1-cat ice to multiple ice categories 
     723   FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b) 
     724      !!--------------------------------------------------------------------- 
     725      !!                   ***  ROUTINE ice_var_sshdyn  *** 
     726      !!                      
     727      !! ** Purpose :  compute the equivalent ssh in lead when sea ice is embedded 
     728      !! 
     729      !! ** Method  :  ssh_lead = ssh + (Mice + Msnow) / rau0 
     730      !! 
     731      !! ** Reference : Jean-Michel Campin, John Marshall, David Ferreira, 
     732      !!                Sea ice-ocean coupling using a rescaled vertical coordinate z*,  
     733      !!                Ocean Modelling, Volume 24, Issues 1-2, 2008 
     734      !!---------------------------------------------------------------------- 
     735      ! 
     736      ! input 
     737      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh            !: ssh [m] 
     738      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psnwice_mass    !: mass of snow and ice at current  ice time step [Kg/m2] 
     739      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psnwice_mass_b  !: mass of snow and ice at previous ice time step [Kg/m2] 
     740      ! 
     741      ! output 
     742      REAL(wp), DIMENSION(jpi,jpj) :: ice_var_sshdyn  ! equivalent ssh in lead [m] 
     743      ! 
     744      ! temporary 
     745      REAL(wp) :: zintn, zintb                     ! time interpolation weights [] 
     746      REAL(wp), DIMENSION(jpi,jpj) :: zsnwiceload  ! snow and ice load [m] 
     747      ! 
     748      ! compute ice load used to define the equivalent ssh in lead 
     749      IF( ln_ice_embd ) THEN 
     750         !                                             
     751         ! average interpolation coeff as used in dynspg = (1/nn_fsbc)   * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     752         !                                               = (1/nn_fsbc)^2 * {SUM[n]        , n=0,nn_fsbc-1} 
     753         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     754         ! 
     755         ! average interpolation coeff as used in dynspg = (1/nn_fsbc)   *    {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     756         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     757         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     758         ! 
     759         zsnwiceload(:,:) = ( zintn * psnwice_mass(:,:) + zintb * psnwice_mass_b(:,:) ) * r1_rau0 
     760         ! 
     761      ELSE 
     762         zsnwiceload(:,:) = 0.0_wp 
     763      ENDIF 
     764      ! compute equivalent ssh in lead 
     765      ice_var_sshdyn(:,:) = pssh(:,:) + zsnwiceload(:,:) 
     766      ! 
     767   END FUNCTION ice_var_sshdyn 
     768 
     769    
     770   !!------------------------------------------------------------------- 
     771   !!                ***  INTERFACE ice_var_itd   *** 
     772   !! 
     773   !! ** Purpose :  converting N-cat ice to jpl ice categories 
     774   !!------------------------------------------------------------------- 
     775   SUBROUTINE ice_var_itd_1c1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     776      !!------------------------------------------------------------------- 
     777      !! ** Purpose :  converting 1-cat ice to 1 ice category 
     778      !!------------------------------------------------------------------- 
     779      REAL(wp), DIMENSION(:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
     780      REAL(wp), DIMENSION(:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
     781      !!------------------------------------------------------------------- 
     782      zh_i(:) = zhti(:) 
     783      zh_s(:) = zhts(:) 
     784      za_i(:) = zati(:) 
     785   END SUBROUTINE ice_var_itd_1c1c 
     786 
     787   SUBROUTINE ice_var_itd_Nc1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     788      !!------------------------------------------------------------------- 
     789      !! ** Purpose :  converting N-cat ice to 1 ice category 
     790      !!------------------------------------------------------------------- 
     791      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
     792      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
     793      !!------------------------------------------------------------------- 
     794      ! 
     795      za_i(:) = SUM( zati(:,:), dim=2 ) 
     796      ! 
     797      WHERE( za_i(:) /= 0._wp ) 
     798         zh_i(:) = SUM( zhti(:,:) * zati(:,:), dim=2 ) / za_i(:) 
     799         zh_s(:) = SUM( zhts(:,:) * zati(:,:), dim=2 ) / za_i(:) 
     800      ELSEWHERE 
     801         zh_i(:) = 0._wp 
     802         zh_s(:) = 0._wp 
     803      END WHERE 
     804      ! 
     805   END SUBROUTINE ice_var_itd_Nc1c 
     806    
     807   SUBROUTINE ice_var_itd_1cMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     808      !!------------------------------------------------------------------- 
     809      !! 
     810      !! ** Purpose :  converting 1-cat ice to jpl ice categories 
    664811      !! 
    665812      !!                  ice thickness distribution follows a gaussian law 
    … …  
    801948      END DO 
    802949      ! 
    803    END SUBROUTINE ice_var_itd 
    804  
    805  
    806    SUBROUTINE ice_var_itd2( zhti, zhts, zati, zh_i, zh_s, za_i ) 
    807       !!------------------------------------------------------------------- 
    808       !!                ***  ROUTINE ice_var_itd2   *** 
     950   END SUBROUTINE ice_var_itd_1cMc 
     951 
     952   SUBROUTINE ice_var_itd_NcMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     953      !!------------------------------------------------------------------- 
    809954      !! 
    810955      !! ** Purpose :  converting N-cat ice to jpl ice categories 
    … …  
    845990      idim = SIZE( zhti, 1 ) 
    846991      icat = SIZE( zhti, 2 ) 
    847       ! 
    848       ALLOCATE( jlfil(idim,jpl), jlfil2(idim,jpl) )       ! allocate arrays 
    849       ALLOCATE( jlmin(idim), jlmax(idim) ) 
    850  
    851       ! --- initialize output fields to 0 --- ! 
    852       zh_i(1:idim,1:jpl) = 0._wp 
    853       zh_s(1:idim,1:jpl) = 0._wp 
    854       za_i(1:idim,1:jpl) = 0._wp 
    855       ! 
    856       ! --- fill the categories --- ! 
    857       !     find where cat-input = cat-output and fill cat-output fields   
    858       jlmax(:) = 0 
    859       jlmin(:) = 999 
    860       jlfil(:,:) = 0 
    861       DO jl1 = 1, jpl 
    862          DO jl2 = 1, icat 
     992      !                                 ! ---------------------- ! 
     993      IF( icat == jpl ) THEN            ! input cat = output cat ! 
     994         !                              ! ---------------------- ! 
     995         zh_i(:,:) = zhti(:,:) 
     996         zh_s(:,:) = zhts(:,:) 
     997         za_i(:,:) = zati(:,:) 
     998         !                              ! ---------------------- ! 
     999      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
     1000         !                              ! ---------------------- ! 
     1001         CALL  ice_var_itd_1cMc( zhti(:,1), zhts(:,1), zati(:,1), zh_i(:,:), zh_s(:,:), za_i(:,:) ) 
     1002         !                              ! ---------------------- ! 
     1003      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
     1004         !                              ! ---------------------- ! 
     1005         CALL  ice_var_itd_Nc1c( zhti(:,:), zhts(:,:), zati(:,:), zh_i(:,1), zh_s(:,1), za_i(:,1) )          
     1006         !                              ! ----------------------- ! 
     1007      ELSE                              ! input cat /= output cat ! 
     1008         !                              ! ----------------------- ! 
     1009          
     1010         ALLOCATE( jlfil(idim,jpl), jlfil2(idim,jpl) )       ! allocate arrays 
     1011         ALLOCATE( jlmin(idim), jlmax(idim) ) 
     1012 
     1013         ! --- initialize output fields to 0 --- ! 
     1014         zh_i(1:idim,1:jpl) = 0._wp 
     1015         zh_s(1:idim,1:jpl) = 0._wp 
     1016         za_i(1:idim,1:jpl) = 0._wp 
     1017         ! 
     1018         ! --- fill the categories --- ! 
     1019         !     find where cat-input = cat-output and fill cat-output fields   
     1020         jlmax(:) = 0 
     1021         jlmin(:) = 999 
     1022         jlfil(:,:) = 0 
     1023         DO jl1 = 1, jpl 
     1024            DO jl2 = 1, icat 
     1025               DO ji = 1, idim 
     1026                  IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN 
     1027                     ! fill the right category 
     1028                     zh_i(ji,jl1) = zhti(ji,jl2) 
     1029                     zh_s(ji,jl1) = zhts(ji,jl2) 
     1030                     za_i(ji,jl1) = zati(ji,jl2) 
     1031                     ! record categories that are filled 
     1032                     jlmax(ji) = MAX( jlmax(ji), jl1 ) 
     1033                     jlmin(ji) = MIN( jlmin(ji), jl1 ) 
     1034                     jlfil(ji,jl1) = jl1 
     1035                  ENDIF 
     1036               END DO 
     1037            END DO 
     1038         END DO 
     1039         ! 
     1040         ! --- fill the gaps between categories --- !   
     1041         !     transfer from categories filled at the previous step to the empty ones in between 
     1042         DO ji = 1, idim 
     1043            jl1 = jlmin(ji) 
     1044            jl2 = jlmax(ji) 
     1045            IF( jl1 > 1 ) THEN 
     1046               ! fill the lower cat (jl1-1) 
     1047               za_i(ji,jl1-1) = ztrans * za_i(ji,jl1) 
     1048               zh_i(ji,jl1-1) = hi_mean(jl1-1) 
     1049               ! remove from cat jl1 
     1050               za_i(ji,jl1  ) = ( 1._wp - ztrans ) * za_i(ji,jl1) 
     1051            ENDIF 
     1052            IF( jl2 < jpl ) THEN 
     1053               ! fill the upper cat (jl2+1) 
     1054               za_i(ji,jl2+1) = ztrans * za_i(ji,jl2) 
     1055               zh_i(ji,jl2+1) = hi_mean(jl2+1) 
     1056               ! remove from cat jl2 
     1057               za_i(ji,jl2  ) = ( 1._wp - ztrans ) * za_i(ji,jl2) 
     1058            ENDIF 
     1059         END DO 
     1060         ! 
     1061         jlfil2(:,:) = jlfil(:,:)  
     1062         ! fill categories from low to high 
     1063         DO jl = 2, jpl-1 
    8631064            DO ji = 1, idim 
    864                IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN 
    865                   ! fill the right category 
    866                   zh_i(ji,jl1) = zhti(ji,jl2) 
    867                   zh_s(ji,jl1) = zhts(ji,jl2) 
    868                   za_i(ji,jl1) = zati(ji,jl2) 
    869                   ! record categories that are filled 
    870                   jlmax(ji) = MAX( jlmax(ji), jl1 ) 
    871                   jlmin(ji) = MIN( jlmin(ji), jl1 ) 
    872                   jlfil(ji,jl1) = jl1 
     1065               IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 
     1066                  ! fill high 
     1067                  za_i(ji,jl) = ztrans * za_i(ji,jl-1) 
     1068                  zh_i(ji,jl) = hi_mean(jl) 
     1069                  jlfil(ji,jl) = jl 
     1070                  ! remove low 
     1071                  za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1) 
    8731072               ENDIF 
    8741073            END DO 
    8751074         END DO 
    876       END DO 
    877       ! 
    878       ! --- fill the gaps between categories --- !   
    879       !     transfer from categories filled at the previous step to the empty ones in between 
    880       DO ji = 1, idim 
    881          jl1 = jlmin(ji) 
    882          jl2 = jlmax(ji) 
    883          IF( jl1 > 1 ) THEN 
    884             ! fill the lower cat (jl1-1) 
    885             za_i(ji,jl1-1) = ztrans * za_i(ji,jl1) 
    886             zh_i(ji,jl1-1) = hi_mean(jl1-1) 
    887             ! remove from cat jl1 
    888             za_i(ji,jl1  ) = ( 1._wp - ztrans ) * za_i(ji,jl1) 
    889          ENDIF 
    890          IF( jl2 < jpl ) THEN 
    891             ! fill the upper cat (jl2+1) 
    892             za_i(ji,jl2+1) = ztrans * za_i(ji,jl2) 
    893             zh_i(ji,jl2+1) = hi_mean(jl2+1) 
    894             ! remove from cat jl2 
    895             za_i(ji,jl2  ) = ( 1._wp - ztrans ) * za_i(ji,jl2) 
    896          ENDIF 
    897       END DO 
    898       ! 
    899       jlfil2(:,:) = jlfil(:,:)  
    900       ! fill categories from low to high 
    901       DO jl = 2, jpl-1 
    902          DO ji = 1, idim 
    903             IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 
    904                ! fill high 
    905                za_i(ji,jl) = ztrans * za_i(ji,jl-1) 
    906                zh_i(ji,jl) = hi_mean(jl) 
    907                jlfil(ji,jl) = jl 
    908                ! remove low 
    909                za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1) 
    910             ENDIF 
    911          END DO 
    912       END DO 
    913       ! 
    914       ! fill categories from high to low 
    915       DO jl = jpl-1, 2, -1 
    916          DO ji = 1, idim 
    917             IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 
    918                ! fill low 
    919                za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1) 
    920                zh_i(ji,jl) = hi_mean(jl)  
    921                jlfil2(ji,jl) = jl 
    922                ! remove high 
    923                za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1) 
    924             ENDIF 
    925          END DO 
    926       END DO 
    927       ! 
    928       DEALLOCATE( jlfil, jlfil2 )      ! deallocate arrays 
    929       DEALLOCATE( jlmin, jlmax ) 
    930       ! 
    931    END SUBROUTINE ice_var_itd2 
    932  
    933  
    934    SUBROUTINE ice_var_bv 
    935       !!------------------------------------------------------------------- 
    936       !!                ***  ROUTINE ice_var_bv *** 
    937       !! 
    938       !! ** Purpose :   computes mean brine volume (%) in sea ice 
    939       !! 
    940       !! ** Method  : e = - 0.054 * S (ppt) / T (C) 
    941       !! 
    942       !! References : Vancoppenolle et al., JGR, 2007 
    943       !!------------------------------------------------------------------- 
    944       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    945       !!------------------------------------------------------------------- 
    946       ! 
    947 !!gm I prefere to use WHERE / ELSEWHERE  to set it to zero only where needed   <<<=== to be done 
    948 !!   instead of setting everything to zero as just below 
    949       bv_i (:,:,:) = 0._wp 
    950       DO jl = 1, jpl 
    951          DO jk = 1, nlay_i 
    952             WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 )    
    953                bv_i(:,:,jl) = bv_i(:,:,jl) - rTmlt * sz_i(:,:,jk,jl) * r1_nlay_i / ( t_i(:,:,jk,jl) - rt0 ) 
    954             END WHERE 
    955          END DO 
    956       END DO 
    957       WHERE( vt_i(:,:) > epsi20 )   ;   bvm_i(:,:) = SUM( bv_i(:,:,:) * v_i(:,:,:) , dim=3 ) / vt_i(:,:) 
    958       ELSEWHERE                     ;   bvm_i(:,:) = 0._wp 
    959       END WHERE 
    960       ! 
    961    END SUBROUTINE ice_var_bv 
    962  
    963  
    964    SUBROUTINE ice_var_enthalpy 
    965       !!------------------------------------------------------------------- 
    966       !!                   ***  ROUTINE ice_var_enthalpy ***  
    967       !!                  
    968       !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature 
    969       !! 
    970       !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
    971       !!------------------------------------------------------------------- 
    972       INTEGER  ::   ji, jk   ! dummy loop indices 
    973       REAL(wp) ::   ztmelts  ! local scalar  
    974       !!------------------------------------------------------------------- 
    975       ! 
    976       DO jk = 1, nlay_i             ! Sea ice energy of melting 
    977          DO ji = 1, npti 
    978             ztmelts      = - rTmlt  * sz_i_1d(ji,jk) 
    979             t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point => likely conservation issue 
    980                                                                 !   (sometimes zdf scheme produces abnormally high temperatures)    
    981             e_i_1d(ji,jk) = rhoi * ( rcpi  * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) )           & 
    982                &                   + rLfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) )   & 
    983                &                   - rcp   * ztmelts ) 
    984          END DO 
    985       END DO 
    986       DO jk = 1, nlay_s             ! Snow energy of melting 
    987          DO ji = 1, npti 
    988             e_s_1d(ji,jk) = rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) 
    989          END DO 
    990       END DO 
    991       ! 
    992    END SUBROUTINE ice_var_enthalpy 
    993  
    994    FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b) 
    995       !!--------------------------------------------------------------------- 
    996       !!                   ***  ROUTINE ice_var_sshdyn  *** 
    997       !!                      
    998       !! ** Purpose :  compute the equivalent ssh in lead when sea ice is embedded 
    999       !! 
    1000       !! ** Method  :  ssh_lead = ssh + (Mice + Msnow) / rau0 
    1001       !! 
    1002       !! ** Reference : Jean-Michel Campin, John Marshall, David Ferreira, 
    1003       !!                Sea ice-ocean coupling using a rescaled vertical coordinate z*,  
    1004       !!                Ocean Modelling, Volume 24, Issues 1-2, 2008 
    1005       !!---------------------------------------------------------------------- 
    1006       ! 
    1007       ! input 
    1008       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh            !: ssh [m] 
    1009       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psnwice_mass    !: mass of snow and ice at current  ice time step [Kg/m2] 
    1010       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psnwice_mass_b  !: mass of snow and ice at previous ice time step [Kg/m2] 
    1011       ! 
    1012       ! output 
    1013       REAL(wp), DIMENSION(jpi,jpj) :: ice_var_sshdyn  ! equivalent ssh in lead [m] 
    1014       ! 
    1015       ! temporary 
    1016       REAL(wp) :: zintn, zintb                     ! time interpolation weights [] 
    1017       REAL(wp), DIMENSION(jpi,jpj) :: zsnwiceload  ! snow and ice load [m] 
    1018       ! 
    1019       ! compute ice load used to define the equivalent ssh in lead 
    1020       IF( ln_ice_embd ) THEN 
    1021          !                                             
    1022          ! average interpolation coeff as used in dynspg = (1/nn_fsbc)   * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
    1023          !                                               = (1/nn_fsbc)^2 * {SUM[n]        , n=0,nn_fsbc-1} 
    1024          zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    1025          ! 
    1026          ! average interpolation coeff as used in dynspg = (1/nn_fsbc)   *    {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
    1027          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
    1028          zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    1029          ! 
    1030          zsnwiceload(:,:) = ( zintn * psnwice_mass(:,:) + zintb * psnwice_mass_b(:,:) ) * r1_rau0 
    1031          ! 
    1032       ELSE 
    1033          zsnwiceload(:,:) = 0.0_wp 
     1075         ! 
     1076         ! fill categories from high to low 
     1077         DO jl = jpl-1, 2, -1 
     1078            DO ji = 1, idim 
     1079               IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 
     1080                  ! fill low 
     1081                  za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1) 
     1082                  zh_i(ji,jl) = hi_mean(jl)  
     1083                  jlfil2(ji,jl) = jl 
     1084                  ! remove high 
     1085                  za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1) 
     1086               ENDIF 
     1087            END DO 
     1088         END DO 
     1089         ! 
     1090         DEALLOCATE( jlfil, jlfil2 )      ! deallocate arrays 
     1091         DEALLOCATE( jlmin, jlmax ) 
     1092         ! 
    10341093      ENDIF 
    1035       ! compute equivalent ssh in lead 
    1036       ice_var_sshdyn(:,:) = pssh(:,:) + zsnwiceload(:,:) 
    1037       ! 
    1038    END FUNCTION ice_var_sshdyn 
    1039  
     1094      ! 
     1095   END SUBROUTINE ice_var_itd_NcMc 
    10401096 
    10411097#else 

  • NEMO/releases/release-4.0/src/OCE/BDY/bdydta.F90

    r10952 r11228  
    357357                  jfld_hts = jfld_htst(jbdy) 
    358358                  jfld_ai  = jfld_ait(jbdy) 
    359                   IF    ( jpl /= 1 .AND. nice_cat == 1 ) THEN                       ! case input cat = 1 
    360                      CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 
    361                         &               dta_bdy(jbdy)%h_i     , dta_bdy(jbdy)%h_s     , dta_bdy(jbdy)%a_i    ) 
    362                   ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 
    363                      CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 
    364                         &               dta_bdy(jbdy)%h_i     , dta_bdy(jbdy)%h_s     , dta_bdy(jbdy)%a_i    ) 
    365                   ENDIF 
     359                  CALL ice_var_itd( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 
     360                     &              dta_bdy(jbdy)%h_i       , dta_bdy(jbdy)%h_s       , dta_bdy(jbdy)%a_i      ) 
    366361               ENDIF 
    367362#endif 

  • NEMO/releases/release-4.0/src/SAS/nemogcm.F90

    r10601 r11228  
    165165#else 
    166166      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS 
    167       ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications 
    168       ENDIF 
    169 #endif 
     167      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop( ldfinal = .TRUE. )   ! end mpp communications 
     168      ENDIF 
     169#endif 
     170      ! 
     171      IF(lwm) THEN 
     172         IF( nstop == 0 ) THEN   ;   STOP 0 
     173         ELSE                    ;   STOP 999 
     174         ENDIF 
     175      ENDIF 
    170176      ! 
    171177   END SUBROUTINE nemo_gcm 
    … …  
    311317         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   " 
    312318         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  " 
    313          WRITE(numout,*) "       )  )                        `     (   (   " 
     319         WRITE(numout,*) "       )  ) jgs                    `     (   (   " 
    314320         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    315321         WRITE(numout,*) 
     322 
    316323         DO ji = 1, SIZE(cltxt) 
    317             IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode 
     324            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode 
    318325         END DO 
    319326         WRITE(numout,*) 
    320327         WRITE(numout,*) 
    321328         DO ji = 1, SIZE(cltxt2) 
    322             IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size 
     329            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size 
    323330         END DO 
    324331         ! 
    … …  
    467474      ! 
    468475      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 
    469          &                                                'Compile with key_nosignedzero enabled' ) 
     476         &                                                'Compile with key_nosignedzero enabled:',   & 
     477         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' ) 
    470478      ! 
    471479#if defined key_agrif 
Note: See TracChangeset for help on using the changeset viewer.