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 15574 for NEMO/branches/2021/dev_r14318_RK3_stage1/src/ICE/icedyn_adv_pra.F90 – NEMO

Ignore:
Timestamp:
2021-12-03T20:32:50+01:00 (3 years ago)
Author:
techene
Message:

#2605 #2715 trunk merged into dev_r14318_RK3_stage1

Location:
NEMO/branches/2021/dev_r14318_RK3_stage1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14318_RK3_stage1

    • Property svn:externals
      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 
  • NEMO/branches/2021/dev_r14318_RK3_stage1/src/ICE/icedyn_adv_pra.F90

    r14215 r15574  
    115115      CALL icemax3D( ph_ip, zhip_max) 
    116116      CALL icemax3D( zs_i , zsi_max ) 
    117       CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
     117      CALL lbc_lnk( 'icedyn_adv_pra', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
    118118      ! 
    119119      ! enthalpies 
     
    265265         ! --- Lateral boundary conditions --- ! 
    266266         !     caution: for gradients (sx and sy) the sign changes 
    267          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ice , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp  & ! ice volume 
    268             &                                , sxxice, 'T', 1._wp, syyice, 'T',  1._wp, sxyice, 'T',  1._wp  & 
    269             &                                , z0snw , 'T', 1._wp, sxsn  , 'T', -1._wp, sysn  , 'T', -1._wp  & ! snw volume 
    270             &                                , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  ) 
    271          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
    272             &                                , sxxsal, 'T', 1._wp, syysal, 'T',  1._wp, sxysal, 'T',  1._wp  & 
    273             &                                , z0ai  , 'T', 1._wp, sxa   , 'T', -1._wp, sya   , 'T', -1._wp  & ! ice concentration 
    274             &                                , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  ) 
    275          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
    276             &                                , sxxage, 'T', 1._wp, syyage, 'T',  1._wp, sxyage, 'T',  1._wp  ) 
    277          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy 
    278             &                                , sxxc0 , 'T', 1._wp, syyc0 , 'T',  1._wp, sxyc0 , 'T',  1._wp  ) 
    279          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy 
    280             &                                , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
     267         CALL lbc_lnk( 'icedyn_adv_pra', z0ice , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp  & ! ice volume 
     268            &                          , sxxice, 'T', 1._wp, syyice, 'T',  1._wp, sxyice, 'T',  1._wp  & 
     269            &                          , z0snw , 'T', 1._wp, sxsn  , 'T', -1._wp, sysn  , 'T', -1._wp  & ! snw volume 
     270            &                          , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  & 
     271            &                          , z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
     272            &                          , sxxsal, 'T', 1._wp, syysal, 'T',  1._wp, sxysal, 'T',  1._wp  & 
     273            &                          , z0ai  , 'T', 1._wp, sxa   , 'T', -1._wp, sya   , 'T', -1._wp  & ! ice concentration 
     274            &                          , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  & 
     275            &                          , z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
     276            &                          , sxxage, 'T', 1._wp, syyage, 'T',  1._wp, sxyage, 'T',  1._wp  ) 
     277         CALL lbc_lnk( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy 
     278            &                          , sxxc0 , 'T', 1._wp, syyc0 , 'T',  1._wp, sxyc0 , 'T',  1._wp  ) 
     279         CALL lbc_lnk( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy 
     280            &                          , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
    281281         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    282             CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
    283                &                                , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
    284                &                                , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
    285                &                                , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
    286             IF ( ln_pnd_lids ) THEN 
    287                CALL lbc_lnk_multi( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp  & ! melt pond lid volume 
    288                   &                                , sxxvl,'T', 1._wp, syyvl,'T',  1._wp, sxyvl,'T',  1._wp  ) 
     282            IF( ln_pnd_lids ) THEN 
     283               CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     284                  &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
     285                  &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
     286                  &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  & 
     287                  &                          , z0vl , 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp  & ! melt pond lid volume 
     288                  &                          , sxxvl, 'T', 1._wp, syyvl, 'T',  1._wp, sxyvl, 'T',  1._wp  ) 
     289            ELSE 
     290               CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     291                  &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
     292                  &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
     293                  &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
    289294            ENDIF 
    290295         ENDIF 
     
    766771      ! 
    767772      DO jl = 1, jpl 
    768          DO_2D( 1, 1, 1, 1 ) 
     773         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    769774            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    770775               ! 
     
    813818      !                                           ! -- check e_i/v_i -- ! 
    814819      DO jl = 1, jpl 
    815          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     820         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    816821            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    817822               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     
    827832      !                                           ! -- check e_s/v_s -- ! 
    828833      DO jl = 1, jpl 
    829          DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     834         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    830835            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    831836               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     
    870875      ! -- check snow load -- ! 
    871876      DO jl = 1, jpl 
    872          DO_2D( 1, 1, 1, 1 ) 
     877         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    873878            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    874879               ! 
     
    11681173      !! ** Purpose :  compute the max of the 9 points around 
    11691174      !!---------------------------------------------------------------------- 
    1170       REAL(wp), DIMENSION(:,:,:)      , INTENT(in ) ::   pice   ! input 
    1171       REAL(wp), DIMENSION(:,:,:)      , INTENT(out) ::   pmax   ! output 
    1172       REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1175      REAL(wp), DIMENSION(:,:,:), INTENT(in ) ::   pice   ! input 
     1176      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pmax   ! output 
     1177      ! 
     1178      REAL(wp), DIMENSION(Nis0:Nie0) ::   zmax1, zmax2 
     1179      REAL(wp)                       ::   zmax3 
    11731180      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    11741181      !!---------------------------------------------------------------------- 
     1182      ! basic version: get the max of epsi20 + 9 neighbours 
     1183!!$      DO jl = 1, jpl 
     1184!!$         DO_2D( 0, 0, 0, 0 ) 
     1185!!$            pmax(ji,jj,jl) = MAX( epsi20, pice(ji-1,jj-1,jl), pice(ji,jj-1,jl), pice(ji+1,jj-1,jl),   & 
     1186!!$               &                          pice(ji-1,jj  ,jl), pice(ji,jj  ,jl), pice(ji+1,jj  ,jl),   & 
     1187!!$               &                          pice(ji-1,jj+1,jl), pice(ji,jj+1,jl), pice(ji+1,jj+1,jl) ) 
     1188!!$         END_2D 
     1189!!$      END DO 
     1190      ! optimized version : does a little bit more than 2 max of epsi20 + 3 neighbours 
    11751191      DO jl = 1, jpl 
    1176          DO jj = Njs0-1, Nje0+1 
    1177             DO ji = Nis0, Nie0 
    1178                zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 
    1179             END DO 
     1192         DO ji = Nis0, Nie0 
     1193            zmax1(ji) = MAX( epsi20, pice(ji,Njs0-1,jl), pice(ji-1,Njs0-1,jl), pice(ji+1,Njs0-1,jl) ) 
     1194            zmax2(ji) = MAX( epsi20, pice(ji,Njs0  ,jl), pice(ji-1,Njs0  ,jl), pice(ji+1,Njs0  ,jl) ) 
    11801195         END DO 
    1181          DO jj = Njs0, Nje0 
    1182             DO ji = Nis0, Nie0 
    1183                pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
    1184             END DO 
    1185          END DO 
     1196         DO_2D( 0, 0, 0, 0 ) 
     1197            zmax3 = MAX( epsi20, pice(ji,jj+1,jl), pice(ji-1,jj+1,jl), pice(ji+1,jj+1,jl) ) 
     1198            pmax(ji,jj,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) 
     1199            zmax1(ji) = zmax2(ji) 
     1200            zmax2(ji) = zmax3 
     1201         END_2D 
    11861202      END DO 
    11871203   END SUBROUTINE icemax3D 
     
    11921208      !! ** Purpose :  compute the max of the 9 points around 
    11931209      !!---------------------------------------------------------------------- 
    1194       REAL(wp), DIMENSION(:,:,:,:)    , INTENT(in ) ::   pice   ! input 
    1195       REAL(wp), DIMENSION(:,:,:,:)    , INTENT(out) ::   pmax   ! output 
    1196       REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1210      REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) ::   pice   ! input 
     1211      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) ::   pmax   ! output 
     1212      ! 
     1213      REAL(wp), DIMENSION(Nis0:Nie0) ::   zmax1, zmax2 
     1214      REAL(wp)                       ::   zmax3 
    11971215      INTEGER  ::   jlay, ji, jj, jk, jl   ! dummy loop indices 
    11981216      !!---------------------------------------------------------------------- 
    11991217      jlay = SIZE( pice , 3 )   ! size of input arrays 
     1218      ! basic version: get the max of epsi20 + 9 neighbours 
     1219!!$      DO jl = 1, jpl 
     1220!!$         DO jk = 1, jlay 
     1221!!$            DO_2D( 0, 0, 0, 0 ) 
     1222!!$               pmax(ji,jj,jk,jl) = MAX( epsi20, pice(ji-1,jj-1,jk,jl), pice(ji,jj-1,jk,jl), pice(ji+1,jj-1,jk,jl),   & 
     1223!!$                  &                             pice(ji-1,jj  ,jk,jl), pice(ji,jj  ,jk,jl), pice(ji+1,jj  ,jk,jl),   & 
     1224!!$                  &                             pice(ji-1,jj+1,jk,jl), pice(ji,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 
     1225!!$            END_2D 
     1226!!$         END DO 
     1227!!$      END DO 
     1228      ! optimized version : does a little bit more than 2 max of epsi20 + 3 neighbours 
    12001229      DO jl = 1, jpl 
    12011230         DO jk = 1, jlay 
    1202             DO jj = Njs0-1, Nje0+1 
    1203                DO ji = Nis0, Nie0 
    1204                   zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 
    1205                END DO 
    1206             END DO 
    1207             DO jj = Njs0, Nje0 
    1208                DO ji = Nis0, Nie0 
    1209                   pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
    1210                END DO 
    1211             END DO 
     1231            DO ji = Nis0, Nie0 
     1232               zmax1(ji) = MAX( epsi20, pice(ji,Njs0-1,jk,jl), pice(ji-1,Njs0-1,jk,jl), pice(ji+1,Njs0-1,jk,jl) ) 
     1233               zmax2(ji) = MAX( epsi20, pice(ji,Njs0  ,jk,jl), pice(ji-1,Njs0  ,jk,jl), pice(ji+1,Njs0  ,jk,jl) ) 
     1234            END DO 
     1235            DO_2D( 0, 0, 0, 0 ) 
     1236               zmax3 = MAX( epsi20, pice(ji,jj+1,jk,jl), pice(ji-1,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 
     1237               pmax(ji,jj,jk,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) 
     1238               zmax1(ji) = zmax2(ji) 
     1239               zmax2(ji) = zmax3 
     1240            END_2D 
    12121241         END DO 
    12131242      END DO 
Note: See TracChangeset for help on using the changeset viewer.