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 13662 for NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/ICE/icedyn_rdgrft.F90 – NEMO

Ignore:
Timestamp:
2020-10-22T20:49:56+02:00 (4 years ago)
Author:
clem
Message:

update to almost r4.0.4

Location:
NEMO/branches/2019/dev_r11842_SI3-10_EAP
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11842_SI3-10_EAP

    • Property svn:externals

      •  

        old new  
        1 ^/utils/build/arch@HEAD       arch 
        2 ^/utils/build/makenemo@HEAD   makenemo 
        3 ^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
        6 ^/vendors/FCM@HEAD            ext/FCM 
        7 ^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         1^/utils/build/arch@12130      arch 
         2^/utils/build/makenemo@12191  makenemo 
         3^/utils/build/mk@11662        mk 
         4^/utils/tools_r4.0-HEAD@12672 tools 
         5^/vendors/AGRIF/dev@10586     ext/AGRIF 
         6^/vendors/FCM@10134           ext/FCM 
         7^/vendors/IOIPSL@9655         ext/IOIPSL 
         8 
         9# SETTE mapping (inactive) 
         10#^/utils/CI/sette@12135        sette 

  • NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/ICE/icedyn_rdgrft.F90

    r13574 r13662  
    346346               ELSEIF( zGsum(ji,jl-1) < rn_gstar ) THEN 
    347347                  apartf(ji,jl) = z1_gstar * ( rn_gstar     - zGsum(ji,jl-1) ) *  & 
    348                      &                       ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar        ) * z1_gstar ) 
     348                     &                       ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar     ) * z1_gstar ) 
    349349               ELSE 
    350350                  apartf(ji,jl) = 0._wp 
    … …  
    499499      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    500500      REAL(wp)                  ::   airft1, oirft1, aprft1 
    501       REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg  ! area etc of new ridges 
    502       REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft  ! area etc of rafted ice 
     501      REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg  ! area etc of new ridges 
     502      REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft  ! area etc of rafted ice 
    503503      ! 
    504504      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
    … …  
    527527      DO jl1 = 1, jpl 
    528528 
    529          CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 
     529         IF( nn_icesal /= 2 )  THEN       
     530            CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 
     531         ENDIF 
    530532 
    531533         DO ji = 1, npti 
    … …  
    570572               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft  
    571573 
    572                IF ( ln_pnd_H12 ) THEN 
     574               IF ( ln_pnd_LEV ) THEN 
    573575                  aprdg1     = a_ip_2d(ji,jl1) * afrdg 
    574576                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) 
    … …  
    577579                  aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 
    578580                  vprft (ji) = v_ip_2d(ji,jl1) * afrft 
     581                  IF ( ln_pnd_lids ) THEN 
     582                     vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 
     583                     vlrft (ji) = v_il_2d(ji,jl1) * afrft 
     584                  ENDIF 
    579585               ENDIF 
    580586 
    … …  
    603609               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1    - sirft(ji) 
    604610               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1    - oirft1 
    605                IF ( ln_pnd_H12 ) THEN 
     611               IF ( ln_pnd_LEV ) THEN 
    606612                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    607613                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
     614                  IF ( ln_pnd_lids ) THEN 
     615                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 
     616                  ENDIF 
    608617               ENDIF 
    609618            ENDIF 
    … …  
    697706                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    698707                     &                                  vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    699                   IF ( ln_pnd_H12 ) THEN 
     708                  IF ( ln_pnd_LEV ) THEN 
    700709                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   & 
    701710                        &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   ) 
    702711                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         &  
    703712                        &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   ) 
     713                     IF ( ln_pnd_lids ) THEN 
     714                        v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + (   vlrdg(ji) * rn_fpndrdg * fvol   (ji) & 
     715                           &                                   + vlrft(ji) * rn_fpndrft * zswitch(ji) ) 
     716                     ENDIF 
    704717                  ENDIF 
    705718                   
    … …  
    732745      !---------------- 
    733746      ! In case ridging/rafting lead to very small negative values (sometimes it happens) 
    734       CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d ) 
     747      CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 
    735748      ! 
    736749   END SUBROUTINE rdgrft_shift 
    … …  
    845858         CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    846859         CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     860         CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    847861         DO jl = 1, jpl 
    848862            DO jk = 1, nlay_s 
    … …  
    871885         CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    872886         CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     887         CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    873888         DO jl = 1, jpl 
    874889            DO jk = 1, nlay_s 
Note: See TracChangeset for help on using the changeset viewer.