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

Changeset 10475


Ignore:
Timestamp:
2019-01-08T19:00:51+01:00 (4 years ago)
Author:
clem
Message:

some light cleaning

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/ICE/icedyn_adv_umx.F90

    r10446 r10475  
    193193            zamsk = 0._wp 
    194194            ! 
    195             zhvar(:,:,:) = pv_ip(:,:,:) * z1_ai(:,:,:) 
     195            zhvar(:,:,:) = pv_ip(:,:,:) * z1_aip(:,:,:) 
    196196            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, pv_ip )                 ! mp volume 
    197197         ENDIF 
     
    271271      CASE ( 20 )                          !== centered second order ==! 
    272272         ! 
    273          CALL cen2( pamsk, jt, kt, pdt, pt, pu, pv, puc, pvc, ptc, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho ) 
     273         CALL cen2( pamsk, jt, kt, pdt, pt, pu, pv, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho ) 
    274274         ! 
    275275      CASE ( 1:5 )                         !== 1st to 5th order ULTIMATE-MACHO scheme ==! 
    276276         ! 
    277          CALL macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, puc, pvc, pubox, pvbox, ptc, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho ) 
     277         CALL macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho ) 
    278278         ! 
    279279      END SELECT 
     
    282282      ! new fluxes = u*H  *  u*a / u 
    283283      ! ---------------------------- 
    284       IF( pamsk == 0. ) THEN 
     284      IF( pamsk == 0._wp ) THEN 
    285285         DO jl = 1, jpl 
    286286            DO jj = 1, jpjm1 
     
    440440                  &       + pv     (ji,jj   ) - pv     (ji  ,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    441441               ! 
    442                pt_ups(ji,jj,jl) = ( pt (ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     442               pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
    443443            END DO 
    444444         END DO 
     
    449449 
    450450    
    451    SUBROUTINE cen2( pamsk, jt, kt, pdt, pt, pu, pv, puc, pvc, ptc, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
     451   SUBROUTINE cen2( pamsk, jt, kt, pdt, pt, pu, pv, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
    452452      !!--------------------------------------------------------------------- 
    453453      !!                    ***  ROUTINE cen2  *** 
     
    462462      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt               ! tracer fields 
    463463      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components 
    464       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   puc, pvc         ! 2 ice velocity * A components 
    465       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   ptc              ! tracer content at before time step  
    466464      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer  
    467465      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes  
     
    478476            DO jj = 1, jpjm1 
    479477               DO ji = 1, fs_jpim1 
    480                   pfu_ho(ji,jj,jl) = 0.5 * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
    481                   pfv_ho(ji,jj,jl) = 0.5 * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    482                END DO 
    483             END DO 
    484          END DO 
     478                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
     479                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
     480               END DO 
     481            END DO 
     482         END DO 
     483         ! 
    485484         IF    ( kn_limiter == 1 ) THEN 
    486485            CALL nonosc( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
     
    497496               DO jj = 1, jpjm1 
    498497                  DO ji = 1, fs_jpim1 
    499                      pfu_ho(ji,jj,jl) = 0.5 * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
     498                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
    500499                  END DO 
    501500               END DO 
     
    518517               DO jj = 1, jpjm1 
    519518                  DO ji = 1, fs_jpim1 
    520                      pfv_ho(ji,jj,jl) = 0.5 * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
     519                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
    521520                  END DO 
    522521               END DO 
     
    529528               DO jj = 1, jpjm1 
    530529                  DO ji = 1, fs_jpim1 
    531                      pfv_ho(ji,jj,jl) = 0.5 * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
     530                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    532531                  END DO 
    533532               END DO 
     
    550549               DO jj = 1, jpjm1 
    551550                  DO ji = 1, fs_jpim1 
    552                      pfu_ho(ji,jj,jl) = 0.5 * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
     551                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
    553552                  END DO 
    554553               END DO 
     
    564563 
    565564    
    566    SUBROUTINE macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, puc, pvc, pubox, pvbox, ptc, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
     565   SUBROUTINE macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
    567566      !!--------------------------------------------------------------------- 
    568567      !!                    ***  ROUTINE macho  *** 
     
    581580      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt               ! tracer fields 
    582581      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components 
    583       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   puc, pvc         ! 2 ice velocity * A components 
    584582      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pubox, pvbox     ! upstream velocity 
    585       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   ptc              ! tracer content at before time step  
    586583      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer  
    587584      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes  
     
    714711            DO jj = 1, jpjm1 
    715712               DO ji = 1, fs_jpim1   ! vector opt. 
    716                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                           pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    717                      &                                    - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
     713                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
     714                     &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    718715               END DO 
    719716            END DO 
     
    727724                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    728725                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    729                      &                                               -              zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )  
     726                     &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )  
    730727               END DO 
    731728            END DO 
     
    741738!!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj) 
    742739                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
    743                      &                                               -              zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
    744                      &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                         ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
     740                     &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
     741                     &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
    745742                     &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 
    746743               END DO 
     
    756753                  zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    757754!!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj) 
    758                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
    759                      &                                               -          zcu * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
    760                      &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                   ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
    761                      &                                               - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 
     755                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
     756                     &                                                            - zcu  * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
     757                     &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
     758                     &                                                   - 0.5_wp * zcu  * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 
    762759               END DO 
    763760            END DO 
     
    773770!!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj) 
    774771                  zdx4 = zdx2 * zdx2 
    775                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (            (                   pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
    776                      &                                                     -          zcu * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
    777                      &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) *     (                   ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
    778                      &                                                     - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 
     772                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (        (                       pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
     773                     &                                                            - zcu  * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
     774                     &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) * (                       ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
     775                     &                                                   - 0.5_wp * zcu  * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 
    779776                     &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl)     & 
    780777                     &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) ) 
     
    793790               DO ji = 1, fs_jpim1 
    794791                  IF( pt_u(ji,jj,jl) < 0._wp ) THEN 
    795                      pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                           pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    796                         &                                    - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
     792                     pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
     793                        &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    797794                  ENDIF 
    798795               END DO 
     
    871868            DO jj = 1, jpjm1 
    872869               DO ji = 1, fs_jpim1 
    873                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                          ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    874                      &                                     - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
     870                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
     871                     &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    875872               END DO 
    876873            END DO 
     
    882879               DO ji = 1, fs_jpim1 
    883880                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    884                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (     ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    885                      &                                     - zcv * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    886                END DO 
    887             END DO 
    888          END DO 
    889          CALL lbc_lnk( 'icedyn_adv_umx', pt_v, 'V',  1. ) 
     881                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
     882                     &                                                            - zcv *   ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
     883               END DO 
     884            END DO 
     885         END DO 
    890886         ! 
    891887      CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24) 
     
    896892                  zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    897893!!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj) 
    898                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
    899                      &                                     -                        zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
     894                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                        pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
     895                     &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
    900896                     &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
    901897                     &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 
     
    911907                  zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    912908!!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj) 
    913                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                        ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
    914                      &                                               -          zcv * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
    915                      &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                   ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
    916                      &                                               - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 
     909                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                        pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
     910                     &                                                            - zcv  * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
     911                     &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
     912                     &                                                   - 0.5_wp * zcv  * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 
    917913               END DO 
    918914            END DO 
     
    928924                  zdy4 = zdy2 * zdy2 
    929925                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
    930                      &                                                     -          zcv * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
    931                      &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) *     (                   ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
    932                      &                                                     - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 
     926                     &                                                            - zcv  * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
     927                     &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) * (                       ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
     928                     &                                                   - 0.5_wp * zcv  * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 
    933929                     &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl)     & 
    934930                     &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) ) 
     
    947943               DO ji = 1, fs_jpim1 
    948944                  IF( pt_v(ji,jj,jl) < 0._wp ) THEN 
    949                      pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                          ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    950                         &                                     - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
     945                     pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
     946                        &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    951947                  ENDIF 
    952948               END DO 
     
    984980      ! 
    985981      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    986       REAL(wp) ::   zpos, zneg, zbig, zsml, zup, zdo, z1_dt              ! local scalars 
    987       REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zsign, zcoef, zzt      !   -      - 
     982      REAL(wp) ::   zpos, zneg, zbig, zup, zdo, z1_dt              ! local scalars 
     983      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zcoef, zzt       !   -      - 
    988984      REAL(wp), DIMENSION(jpi,jpj    ) :: zbup, zbdo 
    989985      REAL(wp), DIMENSION(jpi,jpj,jpl) :: zbetup, zbetdo, zti_ups, ztj_ups 
    990986      !!---------------------------------------------------------------------- 
    991987      zbig = 1.e+40_wp 
    992       zsml = epsi20 
    993988       
    994989      ! antidiffusive flux : high order minus low order 
     
    10261021            DO jj = 2, jpjm1 
    10271022               DO ji = fs_2, fs_jpim1 
    1028                   IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj,jl) - pt_ups(ji,jj,jl) ) <= 0. .AND.  & 
    1029                      & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0. ) THEN 
     1023                  IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
     1024                     & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 
    10301025                     ! 
    1031                      IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj,jl) - zti_ups(ji,jj,jl) ) <= 0. .AND.  & 
    1032                         & pfv_ho(ji,jj,jl) * ( ztj_ups(ji,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0. ) THEN 
    1033                         pfu_ho(ji,jj,jl)=0. 
    1034                         pfv_ho(ji,jj,jl)=0. 
     1026                     IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj  ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
     1027                        & pfv_ho(ji,jj,jl) * ( ztj_ups(ji  ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN 
     1028                        pfu_ho(ji,jj,jl)=0._wp 
     1029                        pfv_ho(ji,jj,jl)=0._wp 
    10351030                     ENDIF 
    10361031                     ! 
    1037                      IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji  ,jj,jl) - pt_ups(ji-1,jj,jl) ) <= 0. .AND.  & 
    1038                         & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj,jl) - pt_ups(ji,jj-1,jl) ) <= 0. ) THEN 
    1039                         pfu_ho(ji,jj,jl)=0. 
    1040                         pfv_ho(ji,jj,jl)=0. 
     1032                     IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj  ,jl) ) <= 0._wp .AND.  & 
     1033                        & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji  ,jj-1,jl) ) <= 0._wp ) THEN 
     1034                        pfu_ho(ji,jj,jl)=0._wp 
     1035                        pfv_ho(ji,jj,jl)=0._wp 
    10411036                     ENDIF 
    10421037                     ! 
     
    10761071            DO ji = fs_2, fs_jpim1   ! vector opt. 
    10771072               ! 
    1078                zup  = MAX( zbup(ji,jj), zbup(ji-1,jj  ), zbup(ji+1,jj  ), zbup(ji  ,jj-1), zbup(ji  ,jj+1) )  ! search max/min in neighbourhood 
    1079                zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj  ), zbdo(ji+1,jj  ), zbdo(ji  ,jj-1), zbdo(ji  ,jj+1) ) 
    1080                ! 
    1081                zpos = MAX( 0., pfu_ho(ji-1,jj,jl) ) - MIN( 0., pfu_ho(ji  ,jj,jl) ) &  ! positive/negative part of the flux 
    1082                   & + MAX( 0., pfv_ho(ji,jj-1,jl) ) - MIN( 0., pfv_ho(ji,jj  ,jl) ) 
    1083                zneg = MAX( 0., pfu_ho(ji  ,jj,jl) ) - MIN( 0., pfu_ho(ji-1,jj,jl) ) & 
    1084                   & + MAX( 0., pfv_ho(ji,jj  ,jl) ) - MIN( 0., pfv_ho(ji,jj-1,jl) ) 
    1085                ! 
    1086                zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1)) & 
     1073               zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood 
     1074               zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) ) 
     1075               ! 
     1076               zpos = MAX( 0._wp, pfu_ho(ji-1,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji  ,jj  ,jl) ) &  ! positive/negative part of the flux 
     1077                  & + MAX( 0._wp, pfv_ho(ji  ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj  ,jl) ) 
     1078               zneg = MAX( 0._wp, pfu_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj  ,jl) ) & 
     1079                  & + MAX( 0._wp, pfv_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj-1,jl) ) 
     1080               ! 
     1081               zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 
    10871082                  &          ) * ( 1. - pamsk ) 
    1088                zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1)) & 
     1083               zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 
    10891084                  &          ) * ( 1. - pamsk ) 
    10901085               ! 
    10911086               !                                  ! up & down beta terms 
    1092                IF( zpos > 0. ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 
    1093                ELSE                 ; zbetup(ji,jj,jl) = 0. ! zbig 
     1087               IF( zpos > 0._wp ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 
     1088               ELSE                    ; zbetup(ji,jj,jl) = 0._wp ! zbig 
    10941089               ENDIF 
    10951090               ! 
    1096                IF( zneg > 0. ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 
    1097                ELSE                 ; zbetdo(ji,jj,jl) = 0. ! zbig 
     1091               IF( zneg > 0._wp ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 
     1092               ELSE                    ; zbetdo(ji,jj,jl) = 0._wp ! zbig 
    10981093               ENDIF 
    10991094               ! 
    11001095               ! if all the points are outside ice cover 
    1101                IF( zup == -zbig )   zbetup(ji,jj,jl) = 0. ! zbig 
    1102                IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0. ! zbig             
     1096               IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig 
     1097               IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig             
    11031098               ! 
    11041099            END DO 
     
    11151110               zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 
    11161111               zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 
    1117                zcu = 0.5  + SIGN( 0.5 , pfu_ho(ji,jj,jl) ) 
     1112               zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) ) 
    11181113               ! 
    11191114               zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu ) 
     
    11281123               zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 
    11291124               zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 
    1130                zcv = 0.5  + SIGN( 0.5 , pfv_ho(ji,jj,jl) ) 
     1125               zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) ) 
    11311126               ! 
    11321127               zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv ) 
Note: See TracChangeset for help on using the changeset viewer.