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

Changeset 12119


Ignore:
Timestamp:
2019-12-09T11:55:22+01:00 (4 years ago)
Author:
jchanut
Message:

#2222, remove useless mask checking (and restrict scale factor check at the boundary only until nesting tools are updated in sponge areas). Take into account special values in tracer updates, again, till nesting tools are updated.

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

Legend:

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

    r11769 r12119  
    6565   INTEGER, PUBLIC :: scales_t_id 
    6666   INTEGER, PUBLIC :: avt_id, avm_id, en_id                ! TKE related identificators 
    67    INTEGER, PUBLIC :: umsk_id, vmsk_id 
    6867   INTEGER, PUBLIC :: mbkt_id, ht0_id 
    6968   INTEGER, PUBLIC :: kindic_agr 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90

    r11868 r12119  
    4343   PUBLIC   interptsn, interpsshn, interpavm 
    4444   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    45    PUBLIC   interpe3t, interpumsk, interpvmsk 
     45   PUBLIC   interpe3t 
    4646#if defined key_vertical 
    4747   PUBLIC   interpht0, interpmbkt 
     
    11321132 
    11331133 
    1134    SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     1134   SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before ) 
    11351135      !!---------------------------------------------------------------------- 
    11361136      !!                  ***  ROUTINE interpe3t  *** 
     
    11391139      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    11401140      LOGICAL                              , INTENT(in   ) :: before 
    1141       INTEGER                              , INTENT(in   ) :: nb , ndir 
    11421141      ! 
    11431142      INTEGER :: ji, jj, jk 
    1144       LOGICAL :: western_side, eastern_side, northern_side, southern_side 
    11451143      !!----------------------------------------------------------------------   
    11461144      !     
     
    11481146         ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 
    11491147      ELSE 
    1150          western_side  = (nb == 1).AND.(ndir == 1) 
    1151          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1152          southern_side = (nb == 2).AND.(ndir == 1) 
    1153          northern_side = (nb == 2).AND.(ndir == 2) 
    11541148         ! 
    11551149         DO jk = k1, k2 
    11561150            DO jj = j1, j2 
    11571151               DO ji = i1, i2 
    1158                   ! 
    11591152                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 
    1160                      IF (western_side.AND.(ptab(i1+nbghostcells-1,jj,jk)>0._wp)) THEN 
    1161                         WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1162                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk)  
    1163                         kindic_agr = kindic_agr + 1 
    1164                      ELSEIF (eastern_side.AND.(ptab(i2-nbghostcells+1,jj,jk)>0._wp)) THEN 
    1165                         WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1166                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    1167                         kindic_agr = kindic_agr + 1 
    1168                      ELSEIF (southern_side.AND.(ptab(ji,j1+nbghostcells-1,jk)>0._wp)) THEN 
    1169                         WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
    1170                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    1171                         kindic_agr = kindic_agr + 1 
    1172                      ELSEIF (northern_side.AND.(ptab(ji,j2-nbghostcells+1,jk)>0._wp)) THEN 
    1173                         WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
    1174                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    1175                         kindic_agr = kindic_agr + 1 
    1176                      ENDIF 
     1153                     WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  &  
     1154                     &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 
     1155                     &                 ji+nimpp-1, jj+njmpp-1, jk 
     1156                     kindic_agr = kindic_agr + 1 
    11771157                  ENDIF 
    11781158               END DO 
     
    11831163      !  
    11841164   END SUBROUTINE interpe3t 
    1185  
    1186  
    1187    SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    1188       !!---------------------------------------------------------------------- 
    1189       !!                  ***  ROUTINE interpumsk  *** 
    1190       !!----------------------------------------------------------------------   
    1191       INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    1192       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    1193       LOGICAL                              , INTENT(in   ) ::   before 
    1194       INTEGER                              , INTENT(in   ) ::   nb , ndir 
    1195       ! 
    1196       INTEGER ::   ji, jj, jk 
    1197       LOGICAL ::   western_side, eastern_side    
    1198       !!----------------------------------------------------------------------   
    1199       !     
    1200       IF( before ) THEN 
    1201          ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2) 
    1202       ELSE 
    1203          western_side = (nb == 1).AND.(ndir == 1) 
    1204          eastern_side = (nb == 1).AND.(ndir == 2) 
    1205          DO jk = k1, k2 
    1206             DO jj = j1, j2 
    1207                DO ji = i1, i2 
    1208                    ! Velocity mask at boundary edge points: 
    1209                   IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN 
    1210                      IF (western_side) THEN 
    1211                         WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1212                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 
    1213                         kindic_agr = kindic_agr + 1 
    1214                      ELSEIF (eastern_side) THEN 
    1215                         WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1216                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 
    1217                         kindic_agr = kindic_agr + 1 
    1218                      ENDIF 
    1219                   ENDIF 
    1220                END DO 
    1221             END DO 
    1222          END DO 
    1223          ! 
    1224       ENDIF 
    1225       !  
    1226    END SUBROUTINE interpumsk 
    1227  
    1228  
    1229    SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    1230       !!---------------------------------------------------------------------- 
    1231       !!                  ***  ROUTINE interpvmsk  *** 
    1232       !!----------------------------------------------------------------------   
    1233       INTEGER                              , INTENT(in   ) ::   i1,i2,j1,j2,k1,k2 
    1234       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    1235       LOGICAL                              , INTENT(in   ) ::   before 
    1236       INTEGER                              , INTENT(in   ) :: nb , ndir 
    1237       ! 
    1238       INTEGER ::   ji, jj, jk 
    1239       LOGICAL ::   northern_side, southern_side      
    1240       !!----------------------------------------------------------------------   
    1241       !     
    1242       IF( before ) THEN 
    1243          ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2) 
    1244       ELSE 
    1245          southern_side = (nb == 2).AND.(ndir == 1) 
    1246          northern_side = (nb == 2).AND.(ndir == 2) 
    1247          DO jk = k1, k2 
    1248             DO jj = j1, j2 
    1249                DO ji = i1, i2 
    1250                    ! Velocity mask at boundary edge points: 
    1251                   IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN 
    1252                      IF (southern_side) THEN 
    1253                         WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1254                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 
    1255                         kindic_agr = kindic_agr + 1 
    1256                      ELSEIF (northern_side) THEN 
    1257                         WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1258                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 
    1259                         kindic_agr = kindic_agr + 1 
    1260                      ENDIF 
    1261                   ENDIF 
    1262                END DO 
    1263             END DO 
    1264          END DO 
    1265          ! 
    1266       ENDIF 
    1267       !  
    1268    END SUBROUTINE interpvmsk 
    12691165 
    12701166 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_update.F90

    r11827 r12119  
    4949      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed() 
    5050 
     51#if defined key_vertical 
     52! Effect of this has to be carrefully checked  
     53! depending on what the nesting tools ensure for 
     54! volume conservation: 
    5155      Agrif_UseSpecialValueInUpdate = .FALSE. 
    52 ! jc_alt      Agrif_UseSpecialValueInUpdate = .TRUE. 
     56#else 
     57      Agrif_UseSpecialValueInUpdate = .TRUE. 
     58#endif 
    5359      Agrif_SpecialValueFineGrid    = 0._wp 
    5460      !  
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90

    r12048 r12119  
    259259      ! check if masks and bathymetries match 
    260260      IF(ln_chk_bathy) THEN 
     261         Agrif_UseSpecialValue = .FALSE. 
    261262         ! 
    262263         IF(lwp) WRITE(numout,*) ' ' 
     
    266267# if ! defined key_vertical 
    267268         ! 
    268          ! check if umask agree with parent along western and eastern boundaries: 
    269          CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
    270          ! check if vmask agree with parent along northern and southern boundaries: 
    271          CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
    272          ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
     269         ! check if tmask and vertical scale factors agree with parent in sponge area: 
    273270         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    274271         ! 
     
    346343 
    347344      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
    348       CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
    349       CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
     345 
    350346# if defined key_vertical 
    351347      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
     
    401397 
    402398      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
    403       CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 
    404       CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
    405399 
    406400# if defined key_vertical 
     
    427421      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    428422 
    429       CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )     ! if west,  rhox=3, nn_sponge_len=2 
    430       CALL Agrif_Set_bc( umsk_id, (/0,0/) )                                     ! and nbghost=3: 
    431       CALL Agrif_Set_bc( vmsk_id, (/0,0/) )                                     ! columns 2 to 10 
     423!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
     424! JC: check near the boundary only until matching in sponge has been sorted out: 
     425      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     426 
    432427# if defined key_vertical  
    433428      ! extend the interpolation zone by 1 more point than necessary: 
Note: See TracChangeset for help on using the changeset viewer.