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 15440 for NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/ICE/icedyn_rhg_evp.F90 – NEMO

Ignore:
Timestamp:
2021-10-23T12:18:24+02:00 (3 years ago)
Author:
cetlod
Message:

dev_PISCO : merge with trunk@15439

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/ICE/icedyn_rhg_evp.F90

    r15349 r15440  
    134134      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast 
    135135      ! 
    136       REAL(wp) ::   zintb, zintn                                        ! dummy argument 
    137136      REAL(wp) ::   zfac_x, zfac_y 
    138       REAL(wp) ::   zshear, zdum1, zdum2 
    139137      ! 
    140138      REAL(wp), DIMENSION(jpi,jpj) ::   zdelta, zp_delt                 ! delta and P/delta at T points 
     
    181179      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_yatrp     ! Y-component of area transport (m2/s) 
    182180      !! -- advect fields at the rheology time step for the calculation of strength 
     181      !!    it seems that convergence is worse when ll_advups=true. So it not really a good idea 
    183182      LOGICAL  ::   ll_advups = .FALSE. 
    184183      REAL(wp) ::   zdt_ups 
     
    704703            ENDIF 
    705704            ! 
    706             CALL rhg_upstream( zdt_ups, u_ice, v_ice, za_i_ups )   ! upstream advection: a_i 
    707             CALL rhg_upstream( zdt_ups, u_ice, v_ice, zv_i_ups )   ! upstream advection: v_i 
     705            CALL rhg_upstream( jter, zdt_ups, u_ice, v_ice, za_i_ups )   ! upstream advection: a_i 
     706            CALL rhg_upstream( jter, zdt_ups, u_ice, v_ice, zv_i_ups )   ! upstream advection: v_i 
    708707            ! 
    709708            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )    ! strength 
     
    967966      REAL(wp)          ::   zresm           ! local real 
    968967      CHARACTER(len=20) ::   clname 
     968      LOGICAL           ::   ll_maxcvg 
     969      REAL(wp), DIMENSION(jpi,jpj,2) ::   zres 
     970      REAL(wp), DIMENSION(2)         ::   ztmp 
    969971      !!---------------------------------------------------------------------- 
    970  
     972      ll_maxcvg = .FALSE. 
     973      ! 
    971974      ! create file 
    972975      IF( kt == nit000 .AND. kiter == 1 ) THEN 
     
    983986            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 
    984987            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime ) 
    985             istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid ) 
     988            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE , (/ idtime /), nvarid ) 
    986989            istatus = NF90_ENDDEF(ncvgid) 
    987990         ENDIF 
     
    9971000      ELSE 
    9981001         zresm = 0._wp 
    999          DO_2D( 0, 0, 0, 0 ) 
    1000             zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    1001                &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
    1002          END_2D 
    1003          CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
     1002         IF( ll_maxcvg ) THEN   ! error max over the domain 
     1003            DO_2D( 0, 0, 0, 0 ) 
     1004               zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     1005                  &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
     1006            END_2D 
     1007            CALL mpp_max( 'icedyn_rhg_evp', zresm ) 
     1008         ELSE                   ! error averaged over the domain 
     1009            DO_2D( 0, 0, 0, 0 ) 
     1010               zres(ji,jj,1) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     1011                  &                 ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) 
     1012               zres(ji,jj,2) = pmsk15(ji,jj) 
     1013            END_2D 
     1014            ztmp(:) = glob_sum_vec( 'icedyn_rhg_evp', zres ) 
     1015            IF( ztmp(2) /= 0._wp )   zresm = ztmp(1) / ztmp(2) 
     1016         ENDIF 
    10041017      ENDIF 
    10051018 
     
    10691082   END SUBROUTINE rhg_evp_rst 
    10701083 
    1071    SUBROUTINE rhg_upstream( pdt, pu, pv, pt ) 
     1084   SUBROUTINE rhg_upstream( jter, pdt, pu, pv, pt ) 
    10721085      !!--------------------------------------------------------------------- 
    10731086      !!                    ***  ROUTINE rhg_upstream  *** 
     
    10751088      !! **  Purpose :   compute the upstream fluxes and upstream guess of tracer 
    10761089      !!---------------------------------------------------------------------- 
     1090      INTEGER                    , INTENT(in   ) ::   jter 
    10771091      REAL(wp)                   , INTENT(in   ) ::   pdt              ! tracer time-step 
    10781092      REAL(wp), DIMENSION(:,:  ) , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components 
     
    10811095      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    10821096      REAL(wp) ::   ztra          ! local scalar 
    1083       REAL(wp), DIMENSION(jpi,jpj) ::   zfu_ups, zfv_ups   ! upstream fluxes 
     1097      LOGICAL  ::   ll_upsxy = .TRUE. 
     1098      REAL(wp), DIMENSION(jpi,jpj) ::   zfu_ups, zfv_ups, zpt   ! upstream fluxes and tracer guess 
    10841099      !!---------------------------------------------------------------------- 
    10851100      DO jl = 1, jpl 
    1086          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    1087             zfu_ups(ji,jj) = MAX( pu(ji,jj)*e2u(ji,jj), 0._wp ) * pt(ji  ,jj  ,jl) + & 
    1088                &             MIN( pu(ji,jj)*e2u(ji,jj), 0._wp ) * pt(ji+1,jj  ,jl) 
    1089             zfv_ups(ji,jj) = MAX( pv(ji,jj)*e1v(ji,jj), 0._wp ) * pt(ji  ,jj  ,jl) + & 
    1090                &             MIN( pv(ji,jj)*e1v(ji,jj), 0._wp ) * pt(ji  ,jj+1,jl) 
    1091          END_2D 
     1101         IF( .NOT. ll_upsxy ) THEN         !** no alternate directions **! 
     1102            ! 
     1103            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     1104               zfu_ups(ji,jj) = MAX(pu(ji,jj)*e2u(ji,jj), 0._wp) * pt(ji,jj,jl) + MIN(pu(ji,jj)*e2u(ji,jj), 0._wp) * pt(ji+1,jj,jl) 
     1105               zfv_ups(ji,jj) = MAX(pv(ji,jj)*e1v(ji,jj), 0._wp) * pt(ji,jj,jl) + MIN(pv(ji,jj)*e1v(ji,jj), 0._wp) * pt(ji,jj+1,jl) 
     1106            END_2D 
     1107            ! 
     1108         ELSE                              !** alternate directions **! 
     1109            ! 
     1110            IF( MOD(jter,2) == 1 ) THEN   !==  odd ice time step:  adv_x then adv_y  ==! 
     1111               ! 
     1112               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls )       !-- flux in x-direction 
     1113                  zfu_ups(ji,jj) = MAX( pu(ji,jj)*e2u(ji,jj), 0._wp ) * pt(ji  ,jj,jl) + & 
     1114                     &             MIN( pu(ji,jj)*e2u(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
     1115               END_2D 
     1116               ! 
     1117               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls )     !-- first guess of tracer from u-flux 
     1118                  ztra       = - ( zfu_ups(ji,jj) - zfu_ups(ji-1,jj) ) 
     1119                  zpt(ji,jj) =   ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     1120               END_2D 
     1121               ! 
     1122               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 )   !-- flux in y-direction 
     1123                  zfv_ups(ji,jj) = MAX( pv(ji,jj)*e1v(ji,jj), 0._wp ) * zpt(ji,jj  ) + & 
     1124                     &             MIN( pv(ji,jj)*e1v(ji,jj), 0._wp ) * zpt(ji,jj+1) 
     1125               END_2D 
     1126               ! 
     1127            ELSE                          !==  even ice time step:  adv_y then adv_x  ==! 
     1128               ! 
     1129               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 )       !-- flux in y-direction 
     1130                  zfv_ups(ji,jj) = MAX( pv(ji,jj)*e1v(ji,jj), 0._wp ) * pt(ji,jj  ,jl) + & 
     1131                     &             MIN( pv(ji,jj)*e1v(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
     1132               END_2D 
     1133               ! 
     1134               DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 )     !-- first guess of tracer from v-flux 
     1135                  ztra       = - ( zfv_ups(ji,jj) - zfv_ups(ji,jj-1) ) 
     1136                  zpt(ji,jj) =   ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     1137               END_2D 
     1138               ! 
     1139               DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 )   !-- flux in x-direction 
     1140                  zfu_ups(ji,jj) = MAX( pu(ji,jj)*e2u(ji,jj), 0._wp ) * zpt(ji  ,jj) + & 
     1141                     &             MIN( pu(ji,jj)*e2u(ji,jj), 0._wp ) * zpt(ji+1,jj) 
     1142               END_2D 
     1143               ! 
     1144            ENDIF 
     1145            ! 
     1146         ENDIF 
     1147         ! 
    10921148         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    1093             ztra = - ( zfu_ups(ji,jj) - zfu_ups(ji-1,jj) + zfv_ups(ji,jj) - zfv_ups(ji,jj-1) ) 
    1094             ! 
    1095             pt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     1149            ztra         = - ( zfu_ups(ji,jj) - zfu_ups(ji-1,jj) + zfv_ups(ji,jj) - zfv_ups(ji,jj-1) ) 
     1150            pt(ji,jj,jl) =   ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
    10961151         END_2D 
    10971152      END DO 
Note: See TracChangeset for help on using the changeset viewer.