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 5350 for branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90 – NEMO

Ignore:
Timestamp:
2015-06-04T16:12:19+02:00 (9 years ago)
Author:
hadcv
Message:

Update to head of the trunk (r5344).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r5134 r5350  
    127127      REAL(wp) ::   za, zfac              ! local scalar 
    128128      CHARACTER (len = 15) ::   fieldid 
    129       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s) 
    130                                                              ! (ridging ice area - area of new ridges) / dt 
    131       REAL(wp), POINTER, DIMENSION(:,:) ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
    132       REAL(wp), POINTER, DIMENSION(:,:) ::   opning          ! rate of opening due to divergence/shear 
    133       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
    134       REAL(wp), POINTER, DIMENSION(:,:) ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
    135       REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    136       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
     129      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_net     ! net rate at which area is removed    (1/s) 
     130                                                               ! (ridging ice area - area of new ridges) / dt 
     131      REAL(wp), POINTER, DIMENSION(:,:)   ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
     132      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear 
     133      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
     134      REAL(wp), POINTER, DIMENSION(:,:)   ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
     135      REAL(wp), POINTER, DIMENSION(:,:)   ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
     136      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
    137137      ! 
    138138      INTEGER, PARAMETER ::   nitermax = 20     
     
    142142      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    143143 
    144       CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     144      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    145145 
    146146      IF(ln_ctl) THEN 
     
    153153      ! conservation test 
    154154      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     155 
     156      CALL lim_var_zapsmall 
     157      CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    155158 
    156159      !-----------------------------------------------------------------------------! 
     
    235238               ! Reduce the closing rate if more than 100% of the open water  
    236239               ! would be removed.  Reduce the opening rate proportionately. 
    237                IF ( ato_i(ji,jj) > epsi10 .AND. athorn(ji,jj,0) > 0.0 ) THEN 
    238                   za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
    239                   IF ( za > ato_i(ji,jj)) THEN 
    240                      zfac = ato_i(ji,jj) / za 
    241                      closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
    242                      opning(ji,jj) = opning(ji,jj) * zfac 
    243                   ENDIF 
     240               za   = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
     241               IF( za > epsi20 ) THEN 
     242                  zfac = MIN( 1._wp, ato_i(ji,jj) / za ) 
     243                  closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     244                  opning       (ji,jj) = opning       (ji,jj) * zfac 
    244245               ENDIF 
    245246 
     
    251252         ! Reduce the closing rate if more than 100% of any ice category  
    252253         ! would be removed.  Reduce the opening rate proportionately. 
    253  
    254254         DO jl = 1, jpl 
    255255            DO jj = 1, jpj 
    256256               DO ji = 1, jpi 
    257                   IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 
    258                      za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    259                      IF ( za  >  a_i(ji,jj,jl) ) THEN 
    260                         zfac = a_i(ji,jj,jl) / za 
    261                         closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
    262                         opning       (ji,jj) = opning       (ji,jj) * zfac 
    263                      ENDIF 
     257                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
     258                  IF( za  >  epsi20 ) THEN 
     259                     zfac = MIN( 1._wp, a_i(ji,jj,jl) / za ) 
     260                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     261                     opning       (ji,jj) = opning       (ji,jj) * zfac 
    264262                  ENDIF 
    265263               END DO 
     
    368366      ENDIF 
    369367 
    370       ! updates 
    371       CALL lim_var_glo2eqv 
    372       CALL lim_var_zapsmall 
    373368      CALL lim_var_agg( 1 )  
    374369 
     
    377372      !-----------------------------------------------------------------------------! 
    378373      IF(ln_ctl) THEN  
     374         CALL lim_var_glo2eqv 
     375 
    379376         CALL prt_ctl_info(' ') 
    380377         CALL prt_ctl_info(' - Cell values : ') 
     
    531528         DO jj = 2, jpjm1 
    532529            DO ji = 2, jpim1 
    533                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present 
     530               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
    534531                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
    535532                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
     
    566563         DO jj = 1, jpj - 1 
    567564            DO ji = 1, jpi - 1 
    568                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN       ! ice is present 
     565               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
    569566                  numts_rm = 1 ! number of time steps for the running mean 
    570567                  IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
     
    637634 
    638635      Gsum(:,:,-1) = 0._wp 
    639  
    640       DO jj = 1, jpj 
    641          DO ji = 1, jpi 
    642             IF( ato_i(ji,jj) > epsi10 ) THEN   ;   Gsum(ji,jj,0) = ato_i(ji,jj) 
    643             ELSE                               ;   Gsum(ji,jj,0) = 0._wp 
    644             ENDIF 
    645          END DO 
    646       END DO 
     636      Gsum(:,:,0 ) = ato_i(:,:) 
    647637 
    648638      ! for each value of h, you have to add ice concentration then 
    649639      DO jl = 1, jpl 
    650          DO jj = 1, jpj  
    651             DO ji = 1, jpi 
    652                IF( a_i(ji,jj,jl) > epsi10 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 
    653                ELSE                                ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 
    654                ENDIF 
    655             END DO 
    656          END DO 
     640         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
    657641      END DO 
    658642 
     
    828812      LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging) 
    829813      ! 
    830       LOGICAL ::   neg_ato_i      ! flag for ato_i(i,j) < -puny 
    831       LOGICAL ::   large_afrac    ! flag for afrac > 1 
    832       LOGICAL ::   large_afrft    ! flag for afrac > 1 
    833814      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
    834815      INTEGER ::   ij                ! horizontal index, combines i and j loops 
     
    850831      REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges 
    851832      REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice 
    852       REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! areal age content of ridged & rifging ice 
    853833      REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
    854834 
     
    859839      REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges 
    860840      REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges 
     841      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged 
    861842 
    862843      REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted 
     
    864845      REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice 
    865846      REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice 
    866       REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! areal age content of rafted ice & rafting ice 
     847      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! ice age of ice rafted 
    867848 
    868849      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice 
     
    872853      !!---------------------------------------------------------------------- 
    873854 
    874       CALL wrk_alloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    875       CALL wrk_alloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    876       CALL wrk_alloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    877       CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    878       CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    879       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    880       CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
    881       CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
     855      CALL wrk_alloc( (jpi+1)*(jpj+1),       indxi, indxj ) 
     856      CALL wrk_alloc( jpi, jpj,              vice_init, vice_final, eice_init, eice_final ) 
     857      CALL wrk_alloc( jpi, jpj,              afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     858      CALL wrk_alloc( jpi, jpj,              vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     859      CALL wrk_alloc( jpi, jpj,              afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     860      CALL wrk_alloc( jpi, jpj, jpl,         aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     861      CALL wrk_alloc( jpi, jpj, nlay_i,      eirft, erdg1, erdg2, ersw ) 
     862      CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init ) 
    882863 
    883864      ! Conservation check 
     
    898879      ! 1) Compute change in open water area due to closing and opening. 
    899880      !------------------------------------------------------------------------------- 
    900  
    901       neg_ato_i = .false. 
    902  
    903881      DO jj = 1, jpj 
    904882         DO ji = 1, jpi 
    905883            ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        & 
    906884               &                        + opning(ji,jj)                          * rdt_ice 
    907             IF( ato_i(ji,jj) < -epsi10 ) THEN 
    908                neg_ato_i = .TRUE. 
    909             ELSEIF( ato_i(ji,jj) < 0._wp ) THEN    ! roundoff error 
     885            IF    ( ato_i(ji,jj) < -epsi10 ) THEN    ! there is a bug 
     886               IF(lwp)   WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj) 
     887            ELSEIF( ato_i(ji,jj) < 0._wp   ) THEN    ! roundoff error 
    910888               ato_i(ji,jj) = 0._wp 
    911889            ENDIF 
    912890         END DO 
    913891      END DO 
    914  
    915       ! if negative open water area alert it 
    916       IF( neg_ato_i .AND. lwp ) THEN       ! there is a bug 
    917          DO jj = 1, jpj  
    918             DO ji = 1, jpi 
    919                IF( ato_i(ji,jj) < -epsi10 ) THEN  
    920                   WRITE(numout,*) ''   
    921                   WRITE(numout,*) 'Ridging error: ato_i < 0' 
    922                   WRITE(numout,*) 'ato_i : ', ato_i(ji,jj) 
    923                ENDIF 
    924             END DO 
    925          END DO 
    926       ENDIF 
    927892 
    928893      !----------------------------------------------------------------- 
    929894      ! 2) Save initial state variables 
    930895      !----------------------------------------------------------------- 
    931  
    932       DO jl = 1, jpl 
    933          aicen_init(:,:,jl) = a_i(:,:,jl) 
    934          vicen_init(:,:,jl) = v_i(:,:,jl) 
    935          vsnwn_init(:,:,jl) = v_s(:,:,jl) 
    936          ! 
    937          smv_i_init(:,:,jl) = smv_i(:,:,jl) 
    938          oa_i_init (:,:,jl) = oa_i (:,:,jl) 
    939       END DO 
    940  
    941       esnwn_init(:,:,:) = e_s(:,:,1,:) 
    942  
    943       DO jl = 1, jpl   
    944          DO jk = 1, nlay_i 
    945             eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl) 
    946          END DO 
    947       END DO 
     896      aicen_init(:,:,:)   = a_i  (:,:,:) 
     897      vicen_init(:,:,:)   = v_i  (:,:,:) 
     898      vsnwn_init(:,:,:)   = v_s  (:,:,:) 
     899      smv_i_init(:,:,:)   = smv_i(:,:,:) 
     900      esnwn_init(:,:,:)   = e_s  (:,:,1,:) 
     901      eicen_init(:,:,:,:) = e_i  (:,:,:,:) 
     902      oa_i_init (:,:,:)   = oa_i (:,:,:) 
    948903 
    949904      ! 
     
    972927         END DO 
    973928 
    974          large_afrac = .false. 
    975          large_afrft = .false. 
    976  
    977929         DO ij = 1, icells 
    978930            ji = indxi(ij) 
     
    988940            arft2(ji,jj) = arft1(ji,jj) / kraft 
    989941 
    990             oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    991             oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    992             oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1) 
    993             oirft2(ji,jj)= oirft1(ji,jj) / kraft 
    994  
    995942            !--------------------------------------------------------------- 
    996943            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
     
    1000947            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 
    1001948 
    1002             IF (afrac(ji,jj) > kamax + epsi10) THEN  !riging 
    1003                large_afrac = .true. 
    1004             ELSEIF (afrac(ji,jj) > kamax) THEN  ! roundoff error 
     949            IF( afrac(ji,jj) > kamax + epsi10 ) THEN  ! there is a bug 
     950               IF(lwp)   WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
     951            ELSEIF( afrac(ji,jj) > kamax ) THEN       ! roundoff error 
    1005952               afrac(ji,jj) = kamax 
    1006953            ENDIF 
    1007             IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting 
    1008                large_afrft = .true. 
    1009             ELSEIF (afrft(ji,jj) > kamax) THEN  ! roundoff error 
     954 
     955            IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 
     956               IF(lwp)   WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)  
     957            ELSEIF( afrft(ji,jj) > kamax) THEN       ! roundoff error 
    1010958               afrft(ji,jj) = kamax 
    1011959            ENDIF 
     
    1019967            vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 
    1020968 
    1021             vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    1022             esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    1023             srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
    1024             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
     969            vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     970            esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     971            srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     972            oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) 
     973            oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1)  
    1025974 
    1026975            ! rafting volumes, heat contents ... 
    1027             virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
    1028             vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    1029             esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    1030             smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
     976            virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
     977            vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     978            esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     979            smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
     980            oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj)  
     981            oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft  
    1031982 
    1032983            ! substract everything 
    1033             a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1(ji,jj)  - arft1(ji,jj) 
    1034             v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1(ji,jj)  - virft(ji,jj) 
    1035             v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg(ji,jj)  - vsrft(ji,jj) 
    1036             e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj)  - esrft(ji,jj) 
     984            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1 (ji,jj) - arft1 (ji,jj) 
     985            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1 (ji,jj) - virft (ji,jj) 
     986            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg (ji,jj) - vsrft (ji,jj) 
     987            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj) 
     988            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj) 
    1037989            oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj) 
    1038             smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj) 
    1039990 
    1040991            !----------------------------------------------------------------- 
    1041992            ! 3.5) Compute properties of new ridges 
    1042993            !----------------------------------------------------------------- 
    1043             !------------- 
     994            !--------- 
    1044995            ! Salinity 
    1045             !------------- 
     996            !--------- 
    1046997            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
    1047998            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
     
    10501001             
    10511002            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
    1052             wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids              
     1003            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! increase in ice volume du to seawater frozen in voids              
    10531004 
    10541005            !------------------------------------             
     
    11341085         ENDIF 
    11351086 
    1136          IF( large_afrac .AND. lwp ) THEN   ! there is a bug 
    1137             DO ij = 1, icells 
    1138                ji = indxi(ij) 
    1139                jj = indxj(ij) 
    1140                IF( afrac(ji,jj) > kamax + epsi10 ) THEN  
    1141                   WRITE(numout,*) '' 
    1142                   WRITE(numout,*) ' ardg > a_i' 
    1143                   WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
    1144                ENDIF 
    1145             END DO 
    1146          ENDIF 
    1147          IF( large_afrft .AND. lwp ) THEN  ! there is a bug 
    1148             DO ij = 1, icells 
    1149                ji = indxi(ij) 
    1150                jj = indxj(ij) 
    1151                IF( afrft(ji,jj) > kamax + epsi10 ) THEN  
    1152                   WRITE(numout,*) '' 
    1153                   WRITE(numout,*) ' arft > a_i' 
    1154                   WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 
    1155                ENDIF 
    1156             END DO 
    1157          ENDIF 
    1158  
    11591087         !------------------------------------------------------------------------------- 
    11601088         ! 4) Add area, volume, and energy of new ridge to each category jl2 
     
    11901118               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea 
    11911119 
    1192             END DO ! ij 
     1120            END DO 
    11931121 
    11941122            ! Transfer ice energy to category jl2 by ridging 
     
    12171145                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 
    12181146                  smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)     
    1219                   oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)     
     1147                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj) 
    12201148               ENDIF 
    12211149               ! 
     
    12571185      ENDIF 
    12581186      ! 
    1259       CALL wrk_dealloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    1260       CALL wrk_dealloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    1261       CALL wrk_dealloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    1262       CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    1263       CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1264       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    1265       CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
    1266       CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
     1187      CALL wrk_dealloc( (jpi+1)*(jpj+1),        indxi, indxj ) 
     1188      CALL wrk_dealloc( jpi, jpj,               vice_init, vice_final, eice_init, eice_final ) 
     1189      CALL wrk_dealloc( jpi, jpj,               afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     1190      CALL wrk_dealloc( jpi, jpj,               vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     1191      CALL wrk_dealloc( jpi, jpj,               afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     1192      CALL wrk_dealloc( jpi, jpj, jpl,          aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     1193      CALL wrk_dealloc( jpi, jpj, nlay_i,       eirft, erdg1, erdg2, ersw ) 
     1194      CALL wrk_dealloc( jpi, jpj, nlay_i, jpl, eicen_init ) 
    12671195      ! 
    12681196   END SUBROUTINE lim_itd_me_ridgeshift 
Note: See TracChangeset for help on using the changeset viewer.