Changeset 9134


Ignore:
Timestamp:
2017-12-19T16:37:38+01:00 (3 years ago)
Author:
jchanut
Message:

Correct bug restoring AGRIF reproducibility, add higher order updates for sea-ice, reduce lines length

Location:
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r9116 r9134  
    106106         ibdy2 = 1+nbghostcells  
    107107         ! 
    108          ! Smoothing 
    109          ! --------- 
    110108         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    111109            ua_b(ibdy1:ibdy2,:) = 0._wp 
    112110            DO jk = 1, jpkm1 
    113111               DO jj = 1, jpj 
    114                   ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 
     112                  ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &  
     113                      & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
    115114               END DO 
    116115            END DO 
     
    121120         ! 
    122121         IF( .NOT.lk_agrif_clp ) THEN 
    123             DO jk=1,jpkm1                 ! Smooth 
     122            DO jk=1,jpkm1              ! Smooth 
    124123               DO jj=j1,j2 
    125124                  ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk)) 
    126                   ua(ibdy2,jj,jk) = ua(ibdy2,jj,jk) * umask(ibdy2,jj,jk) 
    127                END DO 
    128             END DO 
    129          ENDIF 
    130          ! 
    131          zub(ibdy1:ibdy2,:) = 0._wp              ! Correct transport 
     125               END DO 
     126            END DO 
     127         ENDIF 
     128         ! 
     129         zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport 
    132130         DO jk = 1, jpkm1 
    133131            DO jj = 1, jpj 
    134                zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) 
     132               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
     133                  & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk) 
    135134            END DO 
    136135         END DO 
     
    141140         DO jk = 1, jpkm1 
    142141            DO jj = 1, jpj 
    143                ua(ibdy1:ibdy2,jj,jk) = (ua(ibdy1:ibdy2,jj,jk)+ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
     142               ua(ibdy1:ibdy2,jj,jk) = ua(ibdy1:ibdy2,jj,jk) & 
     143                 & + (ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk) 
    144144            END DO 
    145145         END DO 
     
    149149            DO jk = 1, jpkm1 
    150150               DO jj = 1, jpj 
    151                   zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) 
     151                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) &  
     152                     & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 
    152153               END DO 
    153154            END DO 
     
    157158            DO jk = 1, jpkm1 
    158159               DO jj = 1, jpj 
    159                   va(ibdy1:ibdy2,jj,jk) = (va(ibdy1:ibdy2,jj,jk)+va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
    160                END DO 
    161             END DO 
    162          ENDIF 
    163          ! 
     160                  va(ibdy1:ibdy2,jj,jk) = va(ibdy1:ibdy2,jj,jk) &  
     161                    & + (va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 
     162               END DO 
     163            END DO 
     164         ENDIF 
     165         ! 
     166         DO jk = 1, jpkm1              ! Mask domain edges 
     167            DO jj = 1, jpj 
     168               ua(1,jj,jk) = 0._wp 
     169               va(1,jj,jk) = 0._wp 
     170            END DO 
     171         END DO  
    164172      ENDIF 
    165173 
     
    169177         ibdy2 = nlci-2  
    170178         ! 
    171          ! Smoothing 
    172          ! --------- 
    173179         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    174180            ua_b(ibdy1:ibdy2,:) = 0._wp 
    175181            DO jk = 1, jpkm1 
    176182               DO jj = 1, jpj 
    177                   ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 
     183                  ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &  
     184                      & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
    178185               END DO 
    179186            END DO 
     
    184191         ! 
    185192         IF( .NOT.lk_agrif_clp ) THEN 
    186             DO jk=1,jpkm1                 ! Smooth 
     193            DO jk=1,jpkm1              ! Smooth 
    187194               DO jj=j1,j2 
    188195                  ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk)) 
    189                   ua(ibdy1,jj,jk) = ua(ibdy1,jj,jk) * umask(ibdy1,jj,jk) 
    190                END DO 
    191             END DO 
    192          ENDIF 
    193          ! 
    194          zub(ibdy1:ibdy2,:) = 0._wp              ! Correct transport 
     196               END DO 
     197            END DO 
     198         ENDIF 
     199         ! 
     200         zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport 
    195201         DO jk = 1, jpkm1 
    196202            DO jj = 1, jpj 
    197                zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) 
     203               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
     204                  & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
    198205            END DO 
    199206         END DO 
     
    204211         DO jk = 1, jpkm1 
    205212            DO jj = 1, jpj 
    206                ua(ibdy1:ibdy2,jj,jk) = (ua(ibdy1:ibdy2,jj,jk)+ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
     213               ua(ibdy1:ibdy2,jj,jk) = ua(ibdy1:ibdy2,jj,jk) &  
     214                 & + (ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
    207215            END DO 
    208216         END DO 
     
    214222            DO jk = 1, jpkm1 
    215223               DO jj = 1, jpj 
    216                   zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) 
     224                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 
     225                     & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 
    217226               END DO 
    218227            END DO 
     
    222231            DO jk = 1, jpkm1 
    223232               DO jj = 1, jpj 
    224                   va(ibdy1:ibdy2,jj,jk) = (va(ibdy1:ibdy2,jj,jk)+va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
    225                END DO 
    226             END DO 
    227          ENDIF 
    228          ! 
     233                  va(ibdy1:ibdy2,jj,jk) = va(ibdy1:ibdy2,jj,jk) &  
     234                      & + (va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
     235               END DO 
     236            END DO 
     237         ENDIF 
     238         ! 
     239         DO jk = 1, jpkm1              ! Mask domain edges 
     240            DO jj = 1, jpj 
     241               ua(nlci-1,jj,jk) = 0._wp 
     242               va(nlci  ,jj,jk) = 0._wp 
     243            END DO 
     244         END DO  
    229245      ENDIF 
    230246 
     
    234250         jbdy2 = 1+nbghostcells  
    235251         ! 
    236          ! Smoothing 
    237          ! --------- 
    238252         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    239253            va_b(:,jbdy1:jbdy2) = 0._wp 
    240254            DO jk = 1, jpkm1 
    241255               DO ji = 1, jpi 
    242                   va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) 
     256                  va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &  
     257                      & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
    243258               END DO 
    244259            END DO 
     
    249264         ! 
    250265         IF ( .NOT.lk_agrif_clp ) THEN 
    251             DO jk = 1, jpkm1              ! Smooth 
     266            DO jk = 1, jpkm1           ! Smooth 
    252267               DO ji = i1, i2 
    253                   va(ji,jbdy2,jk) = 0.25_wp * vmask(ji,jbdy2,jk)    & 
    254                      &        * ( va(ji,jbdy2-1,jk) + 2._wp*va(ji,jbdy2,jk) + va(ji,jbdy2+1,jk) ) 
    255                END DO 
    256             END DO 
    257          ENDIF 
    258          ! 
    259          zvb(:,jbdy1:jbdy2) = 0._wp              ! Correct transport 
     268                  va(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy2-1,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk)) 
     269               END DO 
     270            END DO 
     271         ENDIF 
     272         ! 
     273         zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport 
    260274         DO jk=1,jpkm1 
    261275            DO ji=1,jpi 
    262                zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     276               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
     277                  & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
    263278            END DO 
    264279         END DO 
     
    266281            zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
    267282         END DO 
     283 
    268284         DO jk = 1, jpkm1 
    269285            DO ji = 1, jpi 
    270                va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     286               va(ji,jbdy1:jbdy2,jk) = va(ji,jbdy1:jbdy2,jk) &  
     287                 & + (va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
    271288            END DO 
    272289         END DO 
    273290             
    274291         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    275             zub(:,2) = 0._wp 
     292            zub(:,jbdy1:jbdy2) = 0._wp 
    276293            DO jk = 1, jpkm1 
    277294               DO ji = 1, jpi 
    278                   zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     295                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
     296                     & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
    279297               END DO 
    280298            END DO 
     
    285303            DO jk = 1, jpkm1 
    286304               DO ji = 1, jpi 
    287                   ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
    288                END DO 
    289             END DO 
    290          ENDIF 
    291          ! 
     305                  ua(ji,jbdy1:jbdy2,jk) = ua(ji,jbdy1:jbdy2,jk) &  
     306                    & + (ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     307               END DO 
     308            END DO 
     309         ENDIF 
     310         ! 
     311         DO jk = 1, jpkm1              ! Mask domain edges 
     312            DO ji = 1, jpi 
     313               ua(ji,1,jk) = 0._wp 
     314               va(ji,1,jk) = 0._wp 
     315            END DO 
     316         END DO  
    292317      ENDIF 
    293318 
     
    297322         jbdy2 = nlcj-2  
    298323         ! 
    299          ! Smoothing 
    300          ! --------- 
    301324         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    302325            va_b(:,jbdy1:jbdy2) = 0._wp 
    303326            DO jk = 1, jpkm1 
    304327               DO ji = 1, jpi 
    305                   va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) 
     328                  va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &  
     329                      & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
    306330               END DO 
    307331            END DO 
     
    312336         ! 
    313337         IF ( .NOT.lk_agrif_clp ) THEN 
    314             DO jk = 1, jpkm1              ! Smooth 
     338            DO jk = 1, jpkm1           ! Smooth 
    315339               DO ji = i1, i2 
    316                   va(ji,jbdy1,jk) = 0.25_wp * vmask(ji,jbdy1,jk)    & 
    317                      &        * ( va(ji,jbdy1-1,jk) + 2._wp*va(ji,jbdy1,jk) + va(ji,jbdy1+1,jk) ) 
    318                END DO 
    319             END DO 
    320          ENDIF 
    321          ! 
    322          zvb(:,jbdy1:jbdy2) = 0._wp              ! Correct transport 
     340                  va(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy1-1,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk)) 
     341               END DO 
     342            END DO 
     343         ENDIF 
     344         ! 
     345         zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport 
    323346         DO jk=1,jpkm1 
    324347            DO ji=1,jpi 
    325                zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     348               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
     349                  & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
    326350            END DO 
    327351         END DO 
     
    329353            zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
    330354         END DO 
     355 
    331356         DO jk = 1, jpkm1 
    332357            DO ji = 1, jpi 
    333                va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     358               va(ji,jbdy1:jbdy2,jk) = va(ji,jbdy1:jbdy2,jk) &  
     359                 & + (va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
    334360            END DO 
    335361         END DO 
     
    338364            jbdy1 = jbdy1 + 1 
    339365            jbdy2 = jbdy2 + 1  
    340             zub(:,2) = 0._wp 
     366            zub(:,jbdy1:jbdy2) = 0._wp 
    341367            DO jk = 1, jpkm1 
    342368               DO ji = 1, jpi 
    343                   zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     369                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
     370                     & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
    344371               END DO 
    345372            END DO 
     
    350377            DO jk = 1, jpkm1 
    351378               DO ji = 1, jpi 
    352                   ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
    353                END DO 
    354             END DO 
    355          ENDIF 
    356          ! 
     379                  ua(ji,jbdy1:jbdy2,jk) = ua(ji,jbdy1:jbdy2,jk) &  
     380                    & + ( ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     381               END DO 
     382            END DO 
     383         ENDIF 
     384         ! 
     385         DO jk = 1, jpkm1              ! Mask domain edges 
     386            DO ji = 1, jpi 
     387               ua(ji,nlcj  ,jk) = 0._wp 
     388               va(ji,nlcj-1,jk) = 0._wp 
     389            END DO 
     390         END DO  
    357391      ENDIF 
    358392      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r9116 r9134  
    413413 
    414414   IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    415 !      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    416 !      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
     415!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
     416!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
    417417# if defined key_vertical 
    418       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
     418      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
    419419# else 
    420420      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
     
    603603   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
    604604   !-------------------------------------------------- 
     605# if defined UPD_HIGH 
     606   CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting) 
     607   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     608   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     609#else 
    605610   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 
    606611   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    607612   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     613#endif 
    608614 
    609615END SUBROUTINE agrif_declare_var_lim3 
Note: See TracChangeset for help on using the changeset viewer.