Changeset 6801


Ignore:
Timestamp:
2016-07-08T17:26:24+02:00 (4 years ago)
Author:
clem
Message:

finalizing rheology

Location:
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r6796 r6801  
    262262 
    263263            ! ice fraction at U-V points 
    264             zaU(ji,jj) = ( at_i(ji,jj) * e1t(ji+1,jj) + at_i(ji+1,jj) * e1t(ji,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 
    265             zaV(ji,jj) = ( at_i(ji,jj) * e2t(ji,jj+1) + at_i(ji,jj+1) * e2t(ji,jj) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 
     264            zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e12t(ji,jj) + at_i(ji+1,jj) * e12t(ji+1,jj) ) * r1_e12u(ji,jj) * umask(ji,jj,1) 
     265            zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e12t(ji,jj) + at_i(ji,jj+1) * e12t(ji,jj+1) ) * r1_e12v(ji,jj) * vmask(ji,jj,1) 
    266266 
    267267            ! Ice/snow mass at U-V points 
     
    269269            zm2 = ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
    270270            zm3 = ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
    271             zmassU = ( zm1 * e1t(ji+1,jj) + zm2 * e1t(ji,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 
    272             zmassV = ( zm1 * e2t(ji,jj+1) + zm3 * e2t(ji,jj) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 
     271            zmassU = 0.5_wp * ( zm1 * e12t(ji,jj) + zm2 * e12t(ji+1,jj) ) * r1_e12u(ji,jj) * umask(ji,jj,1) 
     272            zmassV = 0.5_wp * ( zm1 * e12t(ji,jj) + zm3 * e12t(ji,jj+1) ) * r1_e12v(ji,jj) * vmask(ji,jj,1) 
    273273 
    274274            ! Ocean currents at U-V points 
     
    422422                  ! tau_bottom/v_ice 
    423423                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) ) 
    424                   ztauB = - tau_icebfr(ji,jj) / zvel 
     424                  zTauB = - tau_icebfr(ji,jj) / zvel 
    425425 
    426426                  ! Coriolis at V-points (energy conserving formulation) 
     
    433433 
    434434                  ! landfast switch => 0 = static friction ; 1 = sliding friction 
    435                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztauB * v_ice(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     435                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    436436                   
    437437                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
     
    466466                  ! tau_bottom/u_ice 
    467467                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 
    468                   ztauB = - tau_icebfr(ji,jj) / zvel 
     468                  zTauB = - tau_icebfr(ji,jj) / zvel 
    469469 
    470470                  ! Coriolis at U-points (energy conserving formulation) 
     
    477477 
    478478                  ! landfast switch => 0 = static friction ; 1 = sliding friction 
    479                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztauB * u_ice(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     479                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    480480 
    481481                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
     
    511511                  ! tau_bottom/u_ice 
    512512                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 
    513                   ztauB = - tau_icebfr(ji,jj) / zvel 
     513                  zTauB = - tau_icebfr(ji,jj) / zvel 
    514514 
    515515                  ! Coriolis at U-points (energy conserving formulation) 
     
    522522 
    523523                  ! landfast switch => 0 = static friction ; 1 = sliding friction 
    524                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztauB * u_ice(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     524                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    525525 
    526526                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
     
    565565 
    566566                  ! landfast switch => 0 = static friction ; 1 = sliding friction 
    567                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztauB * v_ice(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     567                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    568568                   
    569569                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90

    r6204 r6801  
    392392      INTEGER :: ji,jj,jn 
    393393      REAL(wp) :: zalpha 
    394       REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr  
    395394      !!-----------------------------------------------------------------------       
    396395      ! 
     
    529528            END DO 
    530529         END DO 
     530      ELSE 
     531         DO jj=MAX(j1,2),j2 
     532            DO ji=MAX(i1,2),i2 
     533               uice_agr(ji,jj) = tabres(ji,jj) 
     534            END DO 
     535         END DO 
    531536      ENDIF 
    532537#else 
     
    541546            END DO 
    542547         END DO 
     548      ELSE 
     549         DO jj= j1, j2 
     550            DO ji= i1, i2 
     551               uice_agr(ji,jj) = tabres(ji,jj) 
     552            END DO 
     553         END DO 
    543554      ENDIF 
    544555#endif 
     
    566577                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 
    567578               ENDIF 
     579            END DO 
     580         END DO 
     581      ELSE 
     582         DO jj=MAX(j1,2),j2 
     583            DO ji=MAX(i1,2),i2 
     584               vice_agr(ji,jj) = tabres(ji,jj) 
    568585            END DO 
    569586         END DO 
     
    580597            END DO 
    581598         END DO 
     599      ELSE 
     600         DO jj= j1 ,j2 
     601            DO ji = i1, i2 
     602               vice_agr(ji,jj) = tabres(ji,jj) 
     603            END DO 
     604         END DO 
    582605      ENDIF 
    583606#endif 
     
    585608 
    586609 
    587    SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before ) 
     610   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, k1, k2, before ) 
    588611      !!----------------------------------------------------------------------- 
    589612      !!                    *** ROUTINE interp_adv_ice ***                            
     
    593616      !!              put -9999 where no ice for correct extrapolation              
    594617      !!----------------------------------------------------------------------- 
    595       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    596       REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres 
     618      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     619      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    597620      LOGICAL, INTENT(in) :: before 
    598621      !! 
     
    601624      ! 
    602625      IF( before ) THEN 
    603          DO jj=j1,j2 
    604             DO ji=i1,i2 
    605                IF( tms(ji,jj) == 0. ) THEN 
    606                   tabres(ji,jj,:) = -9999.  
    607                ELSE 
    608                   tabres(ji,jj, 1) = frld  (ji,jj) 
    609                   tabres(ji,jj, 2) = hicif (ji,jj) 
    610                   tabres(ji,jj, 3) = hsnif (ji,jj) 
    611                   tabres(ji,jj, 4) = tbif  (ji,jj,1) 
    612                   tabres(ji,jj, 5) = tbif  (ji,jj,2) 
    613                   tabres(ji,jj, 6) = tbif  (ji,jj,3) 
    614                   tabres(ji,jj, 7) = qstoif(ji,jj) 
    615                ENDIF 
    616             END DO 
    617          END DO 
     626         DO jj=j1,j2 
     627       DO ji=i1,i2 
     628          IF( tms(ji,jj) == 0. ) THEN 
     629             tabres(ji,jj,:) = -9999  
     630          ELSE 
     631             tabres(ji,jj, 1) = frld  (ji,jj) 
     632             tabres(ji,jj, 2) = hicif (ji,jj) 
     633             tabres(ji,jj, 3) = hsnif (ji,jj) 
     634             tabres(ji,jj, 4) = tbif  (ji,jj,1) 
     635             tabres(ji,jj, 5) = tbif  (ji,jj,2) 
     636             tabres(ji,jj, 6) = tbif  (ji,jj,3) 
     637             tabres(ji,jj, 7) = qstoif(ji,jj) 
     638          ENDIF 
     639       END DO 
     640         END DO 
     641      ELSE 
     642    DO jj=j1,j2 
     643       DO ji=i1,i2 
     644               DO jk=k1, k2 
     645             tabice_agr(ji,jj,jk) = tabres(ji,jj,jk) 
     646               END DO 
     647       END DO 
     648    END DO 
    618649      ENDIF 
    619650      ! 
Note: See TracChangeset for help on using the changeset viewer.