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 14170 – NEMO

Changeset 14170


Ignore:
Timestamp:
2020-12-14T19:43:17+01:00 (3 years ago)
Author:
jchanut
Message:

#2222, 2129: 1) Corrected ssh initialization from parent in line with what has been introduced by Sibylle 2) Fixed bug in dyn interp with expliciit free surface 3) Added check on number of levels in child grid without vertical remapping (must be < jpk_parent) 4) Removed the constrain on initialization from parent only when starting from climatology (requires Euler first step though).

Location:
NEMO/trunk/src/NST
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/NST/agrif_oce_interp.F90

    r14122 r14170  
    7676      IF(lwp) WRITE(numout,*) ' ' 
    7777 
    78       IF ( ln_rstart ) &  
    79          & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 
    80  
    8178      IF ( .NOT.Agrif_Parent(l_1st_euler) ) &  
    8279         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 
    … …  
    8683      Agrif_UseSpecialValue = .TRUE. 
    8784 
    88       ts(:,:,:,:,:) = 0.0_wp 
    89       uu(:,:,:,:)   = 0.0_wp 
    90       vv(:,:,:,:)   = 0.0_wp  
    91       ssh(:,:,:)    = 0._wp 
     85      ts(:,:,:,:,Kbb) = 0.0_wp 
     86      uu(:,:,:,Kbb)   = 0.0_wp 
     87      vv(:,:,:,Kbb)   = 0.0_wp  
    9288        
    9389      Krhs_a = Kbb   ;   Kmm_a = Kbb 
    9490 
    9591      CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
    96       CALL Agrif_Init_Variable(sshini_id, procname=interpsshn) 
    9792 
    9893      Agrif_UseSpecialValue = ln_spc_dyn 
    … …  
    108103      Krhs_a = Kaa   ;   Kmm_a = Kmm 
    109104 
    110       ssh(:,:,Kbb) = ssh(:,:,Kbb) * tmask(:,:,1) 
    111  
    112105      DO jn = 1, jpts 
    113106         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb) * tmask(:,:,:) 
    … …  
    118111      CALL lbc_lnk_multi( 'agrif_istate_oce', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
    119112      CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T',  1.0_wp ) 
    120       CALL lbc_lnk( 'agrif_istate_oce', ssh(:,:,Kbb), 'T', 1.0_wp ) 
    121113 
    122114   END SUBROUTINE Agrif_istate_oce 
    123115 
    124116 
    125    SUBROUTINE Agrif_istate_ssh( Kbb, Kmm ) 
     117   SUBROUTINE Agrif_istate_ssh( Kbb, Kmm, Kaa ) 
    126118      !!---------------------------------------------------------------------- 
    127119      !!                 *** ROUTINE agrif_istate_ssh *** 
    … …  
    132124      IMPLICIT NONE 
    133125      ! 
    134       INTEGER, INTENT(in)  :: Kbb, Kmm  
     126      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa  
    135127      !!---------------------------------------------------------------------- 
    136128      IF(lwp) WRITE(numout,*) ' ' 
    … …  
    139131      IF(lwp) WRITE(numout,*) ' ' 
    140132 
    141       IF ( ln_rstart ) &  
    142          & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 
    143  
    144133      IF ( .NOT.Agrif_Parent(l_1st_euler) ) &  
    145134         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 
    146135 
    147       Kmm_a = Kmm 
    148       ssh(:,:,Kmm) = 0._wp 
    149  
     136      Krhs_a = Kbb   ;   Kmm_a = Kbb 
     137      ! 
    150138      Agrif_SpecialValue    = 0._wp 
    151139      Agrif_UseSpecialValue = .TRUE. 
    152140      l_ini_child           = .TRUE. 
    153141      ! 
     142      ssh(:,:,Kbb) = 0._wp 
    154143      CALL Agrif_Init_Variable(sshini_id, procname=interpsshn) 
    155144      ! 
    156145      Agrif_UseSpecialValue = .FALSE. 
    157146      l_ini_child           = .FALSE. 
    158       CALL lbc_lnk( 'dom_vvl_rst', ssh(:,:,Kmm), 'T', 1._wp ) 
     147      ! 
     148      Krhs_a = Kaa   ;   Kmm_a = Kmm 
     149      ! 
     150      CALL lbc_lnk( 'Agrif_istate_ssh', ssh(:,:,Kbb), 'T', 1._wp ) 
     151      ! 
     152      ssh(:,:,Kmm) = ssh(:,:,Kbb) 
     153      ssh(:,:,Kaa) = 0._wp 
    159154 
    160155   END SUBROUTINE Agrif_istate_ssh 
    … …  
    203198 
    204199      IF( .NOT.ln_dynspg_ts ) THEN ! Get transports 
    205          ubdy(:,:) = 0._wp   ;   vbdy(:,:) = 0._wp  
     200         ubdy(:,:) = 0._wp    ;  vbdy(:,:) = 0._wp 
     201         utint_stage(:,:) = 0 ;  vtint_stage(:,:) = 0 
    206202         CALL Agrif_Bc_variable( unb_interp_id, procname=interpunb ) 
    207203         CALL Agrif_Bc_variable( vnb_interp_id, procname=interpvnb ) 
    … …  
    274270         IF( .NOT.ln_dynspg_ts ) THEN  
    275271            DO ji = mi0(ibdy1), mi1(ibdy2) 
    276                uu_b(ji,:,Krhs_a) = 0._wp 
    277                DO jk = 1, jpkm1 
    278                   DO jj = 1, jpj 
    279                      uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    280                   END DO 
    281                END DO 
    282272               DO jj = 1, jpj 
    283273                  uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    … …  
    304294         ! 
    305295         ibdy1 = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()  
    306          ibdy2 = jpiglo - ( nn_hls + 1 )              ! 
     296         ibdy2 = jpiglo - ( nn_hls + 1 )      
     297         ! 
    307298         IF( .NOT.ln_dynspg_ts ) THEN  
    308299            DO ji = mi0(ibdy1), mi1(ibdy2) 
    309                vv_b(ji,:,Krhs_a) = 0._wp 
    310                DO jk = 1, jpkm1 
    311                   DO jj = 1, jpj 
    312                      vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    313                   END DO 
    314                END DO 
    315300               DO jj = 1, jpj 
    316301                  vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    … …  
    318303            END DO 
    319304         ENDIF 
    320  
     305         ! 
    321306         DO ji = mi0(ibdy1), mi1(ibdy2) 
    322307            zvb(ji,:) = 0._wp 
    … …  
    345330         IF( .NOT.ln_dynspg_ts ) THEN 
    346331            DO jj = mj0(jbdy1), mj1(jbdy2) 
    347                vv_b(:,jj,Krhs_a) = 0._wp 
    348                DO jk = 1, jpkm1 
    349                   DO ji = 1, jpi 
    350                      vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    351                   END DO 
    352                END DO 
    353                DO ji=1,jpi 
    354                   vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)  
    355                   uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
     332               DO ji = 1, jpi 
     333                  uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     334                  vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    356335               END DO 
    357336            END DO 
    … …  
    401380         IF( .NOT.ln_dynspg_ts ) THEN 
    402381            DO jj = mj0(jbdy1), mj1(jbdy2) 
    403                vv_b(:,jj,Krhs_a) = 0._wp 
    404                DO jk = 1, jpkm1 
    405                   DO ji = 1, jpi 
    406                      vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    407                   END DO 
    408                END DO 
    409                DO ji=1,jpi 
     382               DO ji = 1, jpi 
    410383                  vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    411384               END DO 
    … …  
    432405         jbdy1 = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()   
    433406         jbdy2 = jpjglo - ( nn_hls + 1 ) 
     407         ! 
    434408         IF( .NOT.ln_dynspg_ts ) THEN 
    435409            DO jj = mj0(jbdy1), mj1(jbdy2) 
    436                uu_b(:,jj,Krhs_a) = 0._wp 
    437                DO jk = 1, jpkm1 
    438                   DO ji = 1, jpi 
    439                      uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    440                   END DO 
    441                END DO 
    442                DO ji=1,jpi 
     410               DO ji = 1, jpi 
    443411                  uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    444412               END DO 
    445413            END DO 
    446414         ENDIF 
    447  
     415         ! 
    448416         DO jj = mj0(jbdy1), mj1(jbdy2) 
    449417            zub(:,jj) = 0._wp 
    … …  
    991959      ELSE 
    992960         IF( l_ini_child ) THEN 
    993             ssh(i1:i2,j1:j2,Kmm_a) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
     961            ssh(i1:i2,j1:j2,Krhs_a) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
    994962         ELSE 
    995963            hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 

  • NEMO/trunk/src/NST/agrif_oce_sponge.F90

    r14086 r14170  
    441441                  N_in = mbkt_parent(ji,jj) 
    442442                  ! Input grid (account for partial cells if any): 
    443                   DO jk=1,N_in 
    444                      z_in(jk) = tabres(ji,jj,jk,n2) - tabres(ji,jj,k2,n2) 
    445                      tabin(jk,1:jpts) = tabres(ji,jj,jk,1:jpts) 
    446                   END DO 
     443                  IF ( N_in > 0 ) THEN  
     444                     DO jk=1,N_in 
     445                        z_in(jk) = tabres(ji,jj,jk,n2) - tabres(ji,jj,k2,n2) 
     446                        tabin(jk,1:jpts) = tabres(ji,jj,jk,1:jpts) 
     447                     END DO 
    447448                   
    448                   ! Intermediate grid: 
    449                   DO jk = 1, N_in 
    450                      h_in_i(jk) = e3t0_parent(ji,jj,jk) * &  
    451                        &       (1._wp + tabres(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 
    452                   END DO 
    453                   z_in_i(1) = 0.5_wp * h_in_i(1) 
    454                   DO jk=2,N_in 
    455                      z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 
    456                   END DO 
    457                   z_in_i(1:N_in) = z_in_i(1:N_in)  - tabres(ji,jj,k2,n2) 
    458  
     449                     ! Intermediate grid: 
     450                     DO jk = 1, N_in 
     451                        h_in_i(jk) = e3t0_parent(ji,jj,jk) * &  
     452                          &       (1._wp + tabres(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 
     453                     END DO 
     454                     z_in_i(1) = 0.5_wp * h_in_i(1) 
     455                     DO jk=2,N_in 
     456                        z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 
     457                     END DO 
     458                     z_in_i(1:N_in) = z_in_i(1:N_in)  - tabres(ji,jj,k2,n2) 
     459                  END IF 
    459460                  ! Output (Child) grid: 
    460461                  N_out = mbkt(ji,jj) 

  • NEMO/trunk/src/NST/agrif_top_sponge.F90

    r14148 r14170  
    130130                  N_in = mbkt_parent(ji,jj) 
    131131                  ! Input grid (account for partial cells if any): 
    132                   DO jk=1,N_in 
    133                      z_in(jk) = tabres(ji,jj,jk,n2) - tabres(ji,jj,k2,n2) 
    134                      tabin(jk,1:jptra) = tabres(ji,jj,jk,1:jptra) 
    135                   END DO 
     132                  IF ( N_in > 0 ) THEN  
     133                     DO jk=1,N_in 
     134                        z_in(jk) = tabres(ji,jj,jk,n2) - tabres(ji,jj,k2,n2) 
     135                        tabin(jk,1:jptra) = tabres(ji,jj,jk,1:jptra) 
     136                     END DO 
    136137                   
    137                   ! Intermediate grid: 
    138                   DO jk = 1, N_in 
    139                      h_in_i(jk) = e3t0_parent(ji,jj,jk) * &  
    140                        &       (1._wp + tabres(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 
    141                   END DO 
    142                   z_in_i(1) = 0.5_wp * h_in_i(1) 
    143                   DO jk=2,N_in 
    144                      z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 
    145                   END DO 
    146                   z_in_i(1:N_in) = z_in_i(1:N_in)  - tabres(ji,jj,k2,n2) 
    147  
     138                     ! Intermediate grid: 
     139                     DO jk = 1, N_in 
     140                        h_in_i(jk) = e3t0_parent(ji,jj,jk) * &  
     141                          &       (1._wp + tabres(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 
     142                     END DO 
     143                     z_in_i(1) = 0.5_wp * h_in_i(1) 
     144                     DO jk=2,N_in 
     145                        z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 
     146                     END DO 
     147                     z_in_i(1:N_in) = z_in_i(1:N_in)  - tabres(ji,jj,k2,n2) 
     148                  END IF 
    148149                  ! Output (Child) grid: 
    149150                  N_out = mbkt(ji,jj) 

  • NEMO/trunk/src/NST/agrif_user.F90

    r14162 r14170  
    877877      ! 
    878878      ! Some checks 
     879      IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) )                    CALL ctl_stop( 'STOP',    & 
     880         &   'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' )  
    879881      IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x   + nbghostcells_x   )   CALL ctl_stop( 'STOP',    & 
    880882         &   'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 
Note: See TracChangeset for help on using the changeset viewer.