Changeset 11607


Ignore:
Timestamp:
2019-09-27T11:59:22+02:00 (11 months ago)
Author:
jchanut
Message:

#2222, remove slight unconsistencies in update with or without key_vertical defined

Location:
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_update.F90

    r11603 r11607  
    284284      !! 
    285285      INTEGER :: ji,jj,jk,jn 
    286       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: tabres_child 
     286      INTEGER  :: N_in, N_out 
     287      REAL(wp) :: ztb, ztnu, ztno 
    287288      REAL(wp) :: h_in(k1:k2) 
    288289      REAL(wp) :: h_out(1:jpk) 
    289       INTEGER  :: N_in, N_out 
    290       REAL(wp) :: zrho_xy, h_diff 
    291       REAL(wp) :: tabin(k1:k2,n1:n2) 
     290      REAL(wp) :: tabin(k1:k2,jpts) 
     291      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jpts) :: tabres_child 
    292292      !!--------------------------------------------- 
    293293      ! 
    294294      IF (before) THEN 
    295295         AGRIF_SpecialValue = -999._wp 
    296          zrho_xy = Agrif_rhox() * Agrif_rhoy()  
    297296         DO jn = n1,n2-1 
    298297            DO jk=k1,k2 
     
    300299                  DO ji=i1,i2 
    301300                     tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 
    302                                            * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp 
     301                                           * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1._wp)*999._wp 
    303302                  END DO 
    304303               END DO 
     
    314313         END DO 
    315314      ELSE 
    316          tabres_child(:,:,:,:) = 0. 
     315         tabres_child(:,:,:,:) = 0._wp 
    317316         AGRIF_SpecialValue = 0._wp 
    318317         DO jj=j1,j2 
     
    332331               ENDDO 
    333332               IF (N_in > 0) THEN !Remove this? 
    334                   h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    335                   IF (h_diff < -1.e-4) THEN 
    336                      print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out)) 
    337                      print *,h_in(1:N_in) 
    338                      print *,h_out(1:N_out) 
    339                      STOP 
    340                   ENDIF 
    341333                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    342334               ENDIF 
     
    346338         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    347339            ! Add asselin part 
    348             DO jn = n1,n2-1 
    349                DO jk=1,jpk 
    350                   DO jj=j1,j2 
    351                      DO ji=i1,i2 
    352                         IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
    353                            tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
    354                                  & + atfp * ( tabres_child(ji,jj,jk,jn) & 
    355                                  &          - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     340            DO jn = 1,jpts 
     341               DO jk = 1, jpkm1 
     342                  DO jj = j1, j2 
     343                     DO ji = i1, i2 
     344                        IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 
     345                           ztb  = tsb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 
     346                           ztnu = tabres_child(ji,jj,jk,jn) * e3t_n(ji,jj,jk) 
     347                           ztno = tsn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
     348                           tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
     349                                     &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
    356350                        ENDIF 
    357                      ENDDO 
    358                   ENDDO 
    359                ENDDO 
    360             ENDDO 
    361          ENDIF 
    362          DO jn = n1,n2-1 
    363             DO jk=1,jpk 
    364                DO jj=j1,j2 
    365                   DO ji=i1,i2 
    366                      IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN  
    367                         tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     351                     END DO 
     352                  END DO 
     353               END DO 
     354            END DO 
     355         ENDIF 
     356         DO jn = 1,jpts 
     357            DO jk = 1, jpkm1 
     358               DO jj = j1, j2 
     359                  DO ji = i1, i2 
     360                     IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN  
     361                        tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) 
    368362                     END IF 
    369363                  END DO 
     
    371365            END DO 
    372366         END DO 
     367         ! 
     368         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     369            tsb(i1:i2,j1:j2,1:jpkm1,1:jpts)  = tsn(i1:i2,j1:j2,1:jpkm1,1:jpts) 
     370         ENDIF 
    373371      ENDIF 
    374372      !  
     
    460458      ! 
    461459      INTEGER ::   ji, jj, jk 
    462       REAL(wp)::   zrhoy 
     460      REAL(wp)::   zrhoy, zub, zunu, zuno 
    463461! VERTICAL REFINEMENT BEGIN 
    464462      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child 
     
    527525            ENDDO 
    528526         ENDDO 
    529  
     527         ! 
    530528         DO jk=1,jpk 
    531529            DO jj=j1,j2 
    532530               DO ji=i1,i2 
    533531                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    534                      ub(ji,jj,jk) = ub(ji,jj,jk) &  
    535                            & + atfp * ( tabres_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     532                     zub  = ub(ji,jj,jk) * e3u_b(ji,jj,jk)  ! fse3t_b prior update should be used 
     533                     zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 
     534                     zunu = tabres_child(ji,jj,jk) * e3u_n(ji,jj,jk) 
     535                     ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) &       
     536                                    & * umask(ji,jj,jk) / e3u_b(ji,jj,jk) 
    536537                  ENDIF 
    537538                  ! 
     
    540541            END DO 
    541542         END DO 
     543         ! 
     544         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     545            ub(i1:i2,j1:j2,1:jpkm1)  = un(i1:i2,j1:j2,1:jpkm1) 
     546         ENDIF 
     547         ! 
    542548      ENDIF 
    543549      !  
     
    647653      ! 
    648654      INTEGER  ::   ji, jj, jk 
    649       REAL(wp) ::   zrhox 
     655      REAL(wp) ::   zrhox, zvb, zvnu, zvno 
    650656! VERTICAL REFINEMENT BEGIN 
    651657      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child 
     
    692698                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    693699                  IF (h_diff < -1.e-4) then 
    694 !Even if bathy at T points match it's possible for the U points to be deeper in the child grid.  
     700!Even if bathy at T points match it's possible for the V points to be deeper in the child grid.  
    695701!In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell. 
    696702                     excess = 0._wp 
     
    712718            ENDDO 
    713719         ENDDO 
    714  
    715          DO jk=1,jpk 
     720         ! 
     721         DO jk=1,jpkm1 
    716722            DO jj=j1,j2 
    717723               DO ji=i1,i2 
    718                   ! 
    719                   IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN ! Add asselin part 
    720                      vb(ji,jj,jk) = vb(ji,jj,jk) &  
    721                            & + atfp * ( tabres_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     724                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     725                     zvb  = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 
     726                     zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 
     727                     zvnu = tabres_child(ji,jj,jk) * e3v_n(ji,jj,jk) 
     728                     vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) &       
     729                                    & * vmask(ji,jj,jk) / e3v_b(ji,jj,jk) 
    722730                  ENDIF 
    723731                  ! 
     
    726734            END DO 
    727735         END DO 
     736         ! 
     737         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     738            vb(i1:i2,j1:j2,1:jpkm1)  = vn(i1:i2,j1:j2,1:jpkm1) 
     739         ENDIF 
     740         ! 
    728741      ENDIF 
    729742      !  
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_top_update.F90

    r11603 r11607  
    124124            ENDDO 
    125125         ENDDO 
    126  
     126         ! 
    127127         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    128128            ! Add asselin part 
    129129            DO jn = 1,jptra 
    130                DO jk=1,jpk 
     130               DO jk=1,jpkm1 
    131131                  DO jj=j1,j2 
    132132                     DO ji=i1,i2 
    133133                        IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
    134                            trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) &  
    135                                  & + atfp * ( tabres_child(ji,jj,jk,jn) & 
    136                                  &          - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     134                           ztb  = trb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 
     135                           ztnu = tabres_child(ji,jj,jk,jn) * e3t_n(ji,jj,jk) 
     136                           ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
     137                           trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
     138                                     &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
    137139                        ENDIF 
    138140                     ENDDO 
     
    142144         ENDIF 
    143145         DO jn = 1,jptra 
    144             DO jk=1,jpk 
     146            DO jk=1,jpkm1 
    145147               DO jj=j1,j2 
    146148                  DO ji=i1,i2 
    147149                     IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN  
    148                         trn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     150                        trn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) 
    149151                     END IF 
    150152                  END DO 
     
    152154            END DO 
    153155         END DO 
     156         ! 
     157         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     158            trb(i1:i2,j1:j2,1:jpkm1,1:jptra)  = trn(i1:i2,j1:j2,1:jpkm1,1:jptra) 
     159         ENDIF 
     160         ! 
     161 
    154162      ENDIF 
    155163      !  
Note: See TracChangeset for help on using the changeset viewer.