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 8061 – NEMO

Changeset 8061


Ignore:
Timestamp:
2017-05-24T10:02:23+02:00 (7 years ago)
Author:
vancop
Message:

Quick commit on empirical melt ponds

Location:
branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r7319 r8061  
    281281   ! MV MP 2016 
    282282   !                                     !!** melt pond namelist (namicemp) 
    283    LOGICAL , PUBLIC ::   ln_limMP         !: activate melt ponds or not 
    284    INTEGER , PUBLIC ::   nn_limMP         !: type of melt pond implementation (1=full, 2=radiation only, 3=freshwater only) 
     283   LOGICAL , PUBLIC ::   ln_pnd           !: activate ponds or not 
     284   INTEGER , PUBLIC ::   nn_pnd_scheme    !: type of melt pond scheme:   =0 prescribed, =1 empirical, =2 topographic 
     285   INTEGER , PUBLIC ::   nn_pnd_cpl       !: type of melt pond coupling: =0 passive, =1 full, =2 radiation only, =3 freshwater only 
     286   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1), only if nn_pnd_scheme = 0 
    285287   ! END MV MP 2016 
    286288 
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r7319 r8061  
    417417      !-------------------------------------------------------------------- 
    418418      ! 
    419       IF ( ln_limMP ) THEN 
    420          a_ip(:,:,:) = 0.1_wp 
    421          v_ip(:,:,:) = 0.1_wp 
    422          h_ip(:,:,:) = 0._wp 
    423          a_ip_frac(:,:,:) = 0._wp 
    424  
    425          at_ip(:,:) = 0._wp 
    426          vt_ip(:,:) = 0._wp 
    427       ENDIF 
     419      !IF ( ln_pnd   ) THEN 
     420      SELECT CASE ( nn_pnd_scheme ) 
     421 
     422         z1_jpl =  1 / REAL(jpl) 
     423 
     424         CASE ( 0 )           !--- Prescribed melt ponds 
     425 
     426            DO jl = 1, jpl 
     427 
     428               a_ip(:,:,jl) = rn_apnd * z1_jpl * zswitch(:,:) 
     429               h_ip(:,:,jl) = 0.1 * zswitch(:,:) 
     430 
     431            END DO 
     432 
     433         CASE ( 1, 2 )        !--- Prognostic melt ponds 
     434 
     435            DO jl = 1, jpl 
     436 
     437               a_ip(:,:,jl) = 0.1 * zswitch(:,:) 
     438               h_ip(:,:,jl) = 0.1 * zswitch(:,:) 
     439 
     440            END DO 
     441 
     442      END SELECT 
     443 
     444      v_ip(:,:,:)      = a_ip(:,:,:)  * h_i_p(:,:,:) 
     445      a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
    428446 
    429447      ! END MV MP 2016 
     
    473491 
    474492      ! MV MP 2016 
    475       IF ( ln_limMP ) THEN 
     493      IF ( nn_pnd_scheme > 1 ) THEN 
    476494         sxap  (:,:,:) = 0._wp    ; sxvp  (:,:,:) = 0._wp  
    477495         syap  (:,:,:) = 0._wp    ; syvp  (:,:,:) = 0._wp  
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r7319 r8061  
    608608            esrdg (ij) = e_s  (ji,jj,1,jl1) * afrac(ij) 
    609609            !MV MP 2016 
    610             IF ( ln_limMP ) THEN 
     610            IF ( nn_pnd_scheme > 1 ) THEN 
    611611               vprdg(ij) = v_ip(ji,jj, jl1) * afrac(ij) 
    612612            ENDIF 
     
    620620            vsrft (ij) = v_s  (ji,jj,  jl1) * afrft(ij) 
    621621            !MV MP 2016 
    622             IF ( ln_limMP ) THEN 
     622            IF ( nn_pnd_scheme > 1 ) THEN 
    623623               vprft(ij) = v_ip(ji,jj,jl1) * afrft(ij) 
    624624            ENDIF 
     
    665665            !------------------------------------------             
    666666            !  Place part of the melt pond volume into the ocean.  
    667             IF ( ln_limMP .AND. ( ( nn_limMP .EQ. 3 ) .OR. ( nn_limMP .EQ. 1 ) ) )  THEN 
     667            IF ( ( nn_pnd_scheme > 0 ) .AND. ( ( nn_pnd_cpl .EQ. 1 ) .OR. ( nn_pnd_cpl .EQ. 3 ) ) ) 
    668668               wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + ( rhofw * vprdg(ij) * ( 1._wp - rn_fpondrdg )   &  
    669669               &                                 + rhofw * vprft(ij) * ( 1._wp - rn_fpondrft ) ) * r1_rdtice  ! fresh water source for ocean 
     
    688688 
    689689            ! MV MP 2016 
    690             IF ( ln_limMP ) THEN 
     690            IF ( nn_pnd_scheme > 0 ) THEN 
    691691               v_ip (ji,jj,jl1) = v_ip (ji,jj,jl1) - vprdg (ij) - vprft (ij) 
    692692            ENDIF 
     
    757757                  &                                        esrft (ij) * rn_fsnowrft * zswitch(ij) ) 
    758758               ! MV MP 2016 
    759                IF ( ln_limMP ) THEN 
     759               IF ( nn_pnd_scheme > 0 ) THEN 
    760760                  v_ip (ji,jj,jl2) = v_ip (ji,jj,jl2)  + ( vprdg (ij) * rn_fpondrdg * fvol(ij)  +  & 
    761761                  &                                        vprft (ij) * rn_fpondrft * zswitch(ij) ) 
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r7319 r8061  
    358358            a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin  
    359359            ! MV MP 2016 
    360             IF ( ln_limMP ) THEN 
     360            IF ( nn_pnd_scheme > 0 ) THEN 
    361361               a_ip(ii,ij,1) = a_ip(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 
    362362            ENDIF 
     
    587587 
    588588            ! MV MP 2016  
    589             IF ( ln_limMP ) THEN 
     589            IF ( nn_pnd_scheme > 0 ) THEN 
    590590            !--------------------- 
    591591            ! Pond fraction 
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90

    r8060 r8061  
    8383      !!------------------------------------------------------------------- 
    8484      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    85       NAMELIST/namicemp/  ln_limMP, nn_limMP 
     85      NAMELIST/namicemp/  ln_pnd, nn_pnd_scheme, nn_pnd_cpl, rn_apnd 
    8686      !!------------------------------------------------------------------- 
    8787 
     
    9999         WRITE(numout,*) 'lim_mp_init : ice parameters for melt ponds' 
    100100         WRITE(numout,*) '~~~~~~~~~~~~' 
    101          WRITE(numout,*)'    Activate melt ponds                                         ln_limMP      = ', ln_limMP   
    102          WRITE(numout,*)'    Type of melt pond implementation (1=all,2=rad, 3=fw, 4=no)  nn_limMP      = ', nn_limMP   
     101         WRITE(numout,*)'    Activate melt ponds                                         ln_pnd        = ', ln_pnd 
     102         WRITE(numout,*)'    Type of melt pond scheme =0 presc, =1 empirical = 2 topo    nn_pnd_scheme = ', nn_pnd_scheme 
     103         WRITE(numout,*)'    Type of melt pond coupling =0 pass., =1 full, =2 rad, 3=fw  nn_pnd_cpl    = ', nn_pnd_cp 
     104         WRITE(numout,*)'    Prescribed pond fraction                                    rn_apnd       = ', rn_apnd 
    103105      ENDIF 
    104106      ! 
    105107   END SUBROUTINE lim_mp_init 
     108 
     109 
    106110 
    107111   SUBROUTINE lim_mp( kt ) 
     
    128132      IF( nn_timing == 1 )  CALL timing_start('lim_mp') 
    129133 
    130       CALL lim_mp_cesm ! test routine with hyper simple melt ponds 
    131  
    132       !CALL lim_mp_topo    (at_i, a_i,                                       & 
    133       !          &          vt_i, v_i, v_s,            t_i, s_i, a_ip_frac,  & 
    134       !          &          h_ip,     t_su) 
    135  
     134      SELECT CASE ( nn_pnd_scheme ) 
     135 
     136          CASE (1) 
     137 
     138             CALL lim_mp_cesm ! empirical melt ponds 
     139 
     140          CASE (2) 
     141 
     142             CALL lim_mp_topo    (at_i, a_i,                                       & 
     143                       &          vt_i, v_i, v_s,            t_i, s_i, a_ip_frac,  & 
     144                       &          h_ip,     t_su) 
     145 
     146      END SELECT 
    136147 
    137148      ! we should probably not aggregate here since we do it in lim_var_agg 
     
    142153 
    143154   END SUBROUTINE lim_mp  
     155 
     156 
    144157 
    145158   SUBROUTINE lim_mp_cesm 
     
    149162       !! ** Purpose    : Compute melt pond evolution 
    150163       !! 
    151        !! ** Method     : Accumulation of meltwater and exponential release 
     164       !! ** Method     : Empirical method. A fraction of meltwater is accumulated  
     165       !!                 in pond volume. It is then released exponentially when 
     166       !!                 surface is freezingAccumulation of meltwater and exponential release 
    152167       !! 
    153168       !! ** Tunable parameters : 
     
    155170       !!  
    156171       !! ** Note       : Stolen from CICE for quick test of the melt pond 
    157        !!                 interface 
     172       !!                 radiation and freshwater interfaces 
    158173       !! 
    159174       !! ** References : Holland, M. M. et al (J Clim 2012) 
     
    161176       !!------------------------------------------------------------------- 
    162177 
    163        INTEGER, POINTER, DIMENSION(:,:)    :: indxi             ! compressed indices for cells with ice melting 
    164        INTEGER, POINTER, DIMENSION(:,:)    :: indxj             ! 
     178       INTEGER, POINTER, DIMENSION(:    :: indxi             ! compressed indices for cells with ice melting 
     179       INTEGER, POINTER, DIMENSION(:    :: indxj             ! 
    165180 
    166181       REAL(wp), POINTER, DIMENSION(:,:)   :: zwfx_mlw          ! available meltwater for melt ponding 
     
    175190       REAL(wp)                            :: zhs               ! dummy snow depth 
    176191       REAL(wp)                            :: zTp               ! reference temperature 
    177        REAL(wp)                            :: zrexp             ! rate constant to refreeze melt ponds 
    178192       REAL(wp)                            :: zdTs              ! dummy temperature difference 
    179193       REAL(wp)                            :: z1_rhofw          ! inverse freshwater density 
    180194       REAL(wp)                            :: z1_zpnd_aspect    ! inverse pond aspect ratio 
    181195 
     196       INTEGER                             :: ji, jj, jl, ij    ! loop indices 
     197       INTEGER                             :: icells            ! size of dummy array 
     198 
    182199       !!------------------------------------------------------------------- 
    183200 
    184        CALL wrk_alloc( jpi,jpj, zwfx_mlw ) 
    185201       CALL wrk_alloc( jpi*jpj, indxi, indxj) 
     202       CALL wrk_alloc( jpi,jpj,     zwfx_mlw ) 
     203       CALL wrk_alloc( jpi,jpj,jpl, zrfrac   ) 
    186204 
    187205       z1_rhofw       = 1. / rhofw  
    188206       z1_zpnd_aspect = 1. / zpnd_aspect 
    189        zTp            = -2 + rt0. 
     207       zTp            = -2.  
    190208 
    191209       !------------------------------------------------------------------ 
     
    215233               IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
    216234                  icells = icells + 1 
    217                   indxi(icells) = i 
    218                   indxj(icells) = j 
     235                  indxi(icells) = ji 
     236                  indxj(icells) = jj 
    219237               ENDIF 
    220238            END DO                 ! ji 
     
    231249            IF ( zhi < rn_himin) THEN   !--- Remove ponds on thin ice if ice is too thin 
    232250 
    233                wfx_pnd(ji,jj)   = wfx_pnd(ji,jj) + v_ip(ji,jj,jl) !--- Give freshwater to the ocean 
    234  
    235                a_ip(ji,jj,jl)      = 0._wp                        !--- Dump ponds 
     251               a_ip(ji,jj,jl)      = 0._wp                               !--- Dump ponds 
    236252               v_ip(ji,jj,jl)      = 0._wp 
    237253               a_ip_frac(ji,jj,jl) = 0._wp 
    238254               h_ip(ji,jj,jl)      = 0._wp 
    239255 
     256               IF ( ( nn_pnd_cpl .EQ. 1 ) .OR. ( nn_pnd_cpl .EQ. 3 ) ) & !--- Give freshwater to the ocean 
     257                  wfx_pnd(ji,jj)   = wfx_pnd(ji,jj) + v_ip(ji,jj,jl)  
     258 
     259 
    240260            ELSE                        !--- Update pond characteristics 
    241261 
    242262               !--- Add retained melt water 
    243                v_ip(ji,jj,jl) = v_ip(ji,jj,jl) + rfrac(ji,jj,jl) * z1_rhofw * zwfx_mlw(ji,jj) * a_i(ji,jj,jl) 
     263               v_ip(ji,jj,jl)      = v_ip(ji,jj,jl) + zrfrac(ji,jj,jl) * z1_rhofw * zwfx_mlw(ji,jj) * a_i(ji,jj,jl) * rdt_ice 
    244264 
    245265               !--- Shrink pond due to refreezing 
    246                zdTs = MAX ( zTp - t_su(ji,jj,jl) , 0. ) 
     266               zdTs                = MAX ( zTp - t_su(ji,jj,jl) + rt0 , 0. ) 
    247267                
    248                v_ip(ji,jj,jl) = v_ip(ji,jj,jl) * EXP( rexp * zdTs / zTp ) 
    249             
     268               zvpold              = v_ip(ji,jj,jl) 
     269 
     270               v_ip(ji,jj,jl)      = v_ip(ji,jj,jl) * EXP( zrexp * zdTs / zTp ) 
     271 
     272               !--- Dump meltwater due to refreezing ( of course this is wrong 
     273               !--- but this parameterization is too simple ) 
     274               IF ( ( nn_pnd_cpl .EQ. 1 ) .OR. ( nn_pnd_cpl .EQ. 3 ) ) THEN 
     275 
     276                  wfx_pnd(ji,jj)   = wfx_pnd(ji,jj) + rhofw * ( v_ip(ji,jj,jl) - zvpold ) * r1_rdtice 
     277 
     278               ENDIF 
     279 
    250280               a_ip_frac(ji,jj,jl) = MIN( 1._wp , SQRT( v_ip(ji,jj,jl) * z1_zpnd_aspect / a_i(ji,jj,jl) ) ) 
    251281 
     
    263293            ENDIF 
    264294 
    265          END DO 
    266  
    267       END DO ! jpl 
     295          END DO 
     296 
     297       END DO ! jpl 
     298 
     299       !--- Remove retained meltwater from surface fluxes  
     300 
     301       IF ( ( nn_pnd_cpl .EQ. 1 ) .OR. ( nn_pnd_cpl .EQ. 3 ) ) THEN 
     302 
     303           wfx_snw(:,:) = wfx_snw(:,:) *  ( 1. - zrmin - ( zrmax - zrmin ) * at_i(:,:) ) 
     304 
     305           wfx_sum(:,:) = wfx_sum(:,:) *  ( 1. - zrmin - ( zrmax - zrmin ) * at_i(:,:) ) 
     306 
     307       ENDIF 
    268308 
    269309   END SUBROUTINE lim_mp_cesm 
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r7306 r8061  
    152152 
    153153      ! MV MP 2016 
    154       IF ( ln_limMP ) THEN 
     154      IF ( nn_pnd_scheme > 0 ) THEN 
    155155         DO jl = 1, jpl  
    156156            WRITE(zchar,'(I2.2)') jl 
     
    316316         END DO 
    317317         ! MV MP 2016 
    318          IF ( ln_limMP ) THEN 
     318         IF ( nn_pnd_scheme > 0 ) THEN 
    319319            DO jl = 1, jpl  
    320320               WRITE(zchar,'(I2.2)') jl 
     
    439439 
    440440      ! MV MP 2016 
    441       IF ( ln_limMP ) THEN 
     441      IF ( nn_pnd_scheme > 0 ) THEN 
    442442         DO jl = 1, jpl  
    443443            WRITE(zchar,'(I2.2)') jl 
     
    575575         END DO 
    576576         ! MV MP 2016 
    577          IF ( ln_limMP ) THEN 
     577         IF ( nn_pnd_scheme > 0 ) THEN 
    578578            DO jl = 1, jpl  
    579579               WRITE(zchar,'(I2.2)') jl 
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r7319 r8061  
    7979      ! With melt ponds, we have to diffuse them 
    8080      ! We hard code the number of variables to diffuse 
    81       ! since we can't put an IF ( ln_limMP ) for a declaration 
     81      ! since we can't put an IF ( nn_pnd_scheme ) for a declaration 
    8282      ! ideally, the ihdf_vars should probably be passed as an argument and 
    83       ! defined somewhere depending on ln_limMP 
     83      ! defined somewhere depending on nn_pnd_scheme 
    8484      ! END MV MP 2016 
    8585      INTEGER , PARAMETER                    ::   ihdf_vars  = 8 ! Number of variables in which we apply horizontal diffusion 
     
    217217               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_s(:,:,1,jl) )    ! Snow heat content 
    218218               ! MV MP 2016 
    219                IF ( ln_limMP ) THEN 
     219               IF ( nn_pnd_scheme > 0 ) THEN 
    220220                  CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, a_ip(:,:,jl) )  ! Melt pond fraction 
    221221                  CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_ip(:,:,jl) )  ! Melt pond volume 
     
    265265            END DO 
    266266            ! MV MP 2016 
    267             IF ( ln_limMP ) THEN 
     267            IF ( nn_pnd_scheme > 0 ) THEN 
    268268               z0ap  (:,:,jl)  = a_ip (:,:,jl) * e12t(:,:) ! Melt pond fraction 
    269269               z0vp  (:,:,jl)  = v_ip (:,:,jl) * e12t(:,:) ! Melt pond volume 
     
    365365                  END DO 
    366366                  ! MV MP 2016 
    367                   IF ( ln_limMP ) THEN 
     367                  IF ( nn_pnd_scheme > 0 ) THEN 
    368368                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   &   !--- melt pond fraction --- 
    369369                     &                                         sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  ) 
     
    395395            END DO 
    396396            ! MV MP 2016 
    397             IF ( ln_limMP ) THEN 
     397            IF ( nn_pnd_scheme > 0 ) THEN 
    398398               a_ip  (:,:,jl)   = z0ap (:,:,jl) * r1_e12t(:,:) 
    399399               v_ip  (:,:,jl)   = z0vp (:,:,jl) * r1_e12t(:,:) 
     
    442442            zhdfptab(:,:,jm)= e_s  (:,:,1,jl); jm = jm + 1 
    443443            ! MV MP 2016 
    444             IF ( ln_limMP ) THEN 
     444            IF ( nn_pnd_scheme > 0 ) THEN 
    445445               zhdfptab(:,:,jm)= a_ip  (:,:,  jl); jm = jm + 1 
    446446               zhdfptab(:,:,jm)= v_ip  (:,:,  jl); jm = jm + 1 
     
    481481            e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 
    482482            ! MV MP 2016 
    483             IF ( ln_limMP ) THEN 
     483            IF ( nn_pnd_scheme > 0 ) THEN 
    484484               a_ip (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    485485               v_ip (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     
    539539 
    540540                        ! MV MP 2016 
    541                         IF ( ln_limMP ) THEN 
     541                        IF ( nn_pnd_scheme > 0 ) THEN 
    542542                           a_ip (ji,jj,jl)        = rswitch * a_ip (ji,jj,jl) 
    543543                           v_ip (ji,jj,jl)        = rswitch * v_ip (ji,jj,jl) 
     
    563563               a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 
    564564               ! MV MP 2016 
    565                IF ( ln_limMP ) THEN 
     565               IF ( nn_pnd_scheme > 0 ) THEN 
    566566                  ! correct pond fraction to avoid a_ip > a_i 
    567567                  a_ip(ji,jj,jpl) = a_ip(ji,jj,jpl) * a_i(ji,jj,jpl) / MAX( za_old , epsi20 ) * rswitch 
     
    598598 
    599599      ! MV MP 2016 (remove once we get rid of a_i_frac and ht_i) 
    600       IF ( ln_limMP ) THEN 
     600      IF ( nn_pnd_scheme > 0 ) THEN 
    601601          at_ip(:,:) = SUM( a_ip(:,:,:), dim = 3 ) 
    602602          vt_ip(:,:) = SUM( v_ip(:,:,:), dim = 3 ) 
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r7306 r8061  
    9292 
    9393      ! MV MP 2016 
    94       IF ( ln_limMP ) THEN 
     94      IF ( nn_pnd_scheme > 0 ) 
    9595         at_ip(:,:) = SUM( a_ip, dim=3 ) 
    9696         vt_ip(:,:) = SUM( v_ip, dim=3 ) 
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r7293 r8061  
    208208 
    209209      ! MV MP 2016 
    210       IF ( ln_limMP ) THEN 
     210      IF ( nn_pnd_scheme >= 0 ) THEN ! change once we are sure 
    211211         CALL iom_put( "iceamp"  , at_ip  * zswi        )   ! melt pond total fraction 
    212212         CALL iom_put( "icevmp"  , vt_ip  * zswi        )   ! melt pond total volume per unit area 
     
    232232 
    233233      ! MV MP 2016 
    234       IF ( ln_limMP ) THEN 
     234      IF ( nn_pnd_scheme >= 0 ) THEN ! change once we are sure that case = 0 works 
    235235         IF ( iom_use( "iceamp_cat"  ) )  CALL iom_put( "iceamp_cat"     , a_ip   * zswi2   )       ! melt pond frac for categories 
    236236         IF ( iom_use( "icevmp_cat"  ) )  CALL iom_put( "icevmp_cat"     , v_ip   * zswi2   )       ! melt pond frac for categories 
     
    301301 
    302302      ! MV MP 2016 
    303       IF ( ln_limMP ) THEN 
     303      IF ( nn_pnd_scheme >= 0 ) THEN 
    304304         CALL histdef( kid, "si_amp", "Melt pond fraction"      , "%"      ,   & 
    305305      &         jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     
    354354 
    355355      ! MV MP 2016 
    356       IF ( ln_limMP ) THEN 
     356      IF ( nn_pnd_scheme >= 0 ) THEN 
    357357         CALL histwrite( kid, "si_amp", kt, at_ip         , jpi*jpj, (/1/) ) 
    358358         CALL histwrite( kid, "si_vmp", kt, vt_ip         , jpi*jpj, (/1/) ) 
Note: See TracChangeset for help on using the changeset viewer.