Changeset 9710


Ignore:
Timestamp:
2018-05-31T13:46:36+02:00 (2 years ago)
Author:
frrh
Message:

Use existing dom_uniq routine to mask duplicate points.
This routine does essentailly what I already do and
although it's slightly excessive for what we need,
it allows us to reduce the number of lines
of code we need by calling an existing routine
(which is tried and tested!).

Location:
branches/UKMO/dev_r5518_GO6_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DOM
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r9707 r9710  
    3131   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    3232   USE wrk_nemo        ! Memory allocation 
     33   USE domwri 
    3334   USE timing          ! Timing 
    3435 
     
    139140      REAL(wp) ::  zphi_drake_passage, zshlat_antarc 
    140141      REAL(wp), POINTER, DIMENSION(:,:) ::  zwf 
    141       REAL(wp) :: uv(jpi,jpj) 
     142      REAL(wp) :: uvt(jpi,jpj)   ! dummy array for masking purposes. 
    142143      !! 
    143144      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
     
    291292      ! Set up mask for diagnostics on T points, to exclude duplicate 
    292293      ! data points in wrap and N-fold regions.  
    293       DO jk = 1, jpk 
    294          tmask_i_diag(:,:,jk) = tmask(:,:,jk) * tmask_i(:,:) 
     294      CALL dom_uniq( uvt, 'T' ) 
     295      DO jk = 1, jpk 
     296         tmask_i_diag(:,:,jk) = tmask(:,:,jk) * uvt(:,:) 
    295297      END DO 
    296298 
     
    300302      umask_i_diag(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 
    301303      CALL lbc_lnk( umask_i_diag, 'U', 1. ) 
    302       ! Now mask out any wrap columns 
    303       umask_i_diag( 1 :iif,:,:) = 0._wp       ! first columns 
    304       umask_i_diag(iil:jpi,:,:) = 0._wp       ! last  columns (including mpp extra columns) 
    305       ! Now mask out any extra bottom rows 
    306       umask_i_diag(:,1:ijf,:) = 0._wp         ! first rows 
    307  
    308       ! Now find which points change sign during a U lbc_lnk to find 
    309       ! out which points to mask in the N fold.    
    310       uv(:,:) = 1.0 
    311       CALL lbc_lnk( uv, 'U', -1. ) 
    312  
    313       ! Now find out which points have changed sign and mask them  
    314       DO jj = 1, jpj 
    315          DO ji = 1, jpi 
    316             IF (uv(ji,jj) < 0.0) THEN 
    317                umask_i_diag(ji,jj,:) = 0.0 
    318             END IF 
    319          END DO 
    320       END DO 
     304 
     305      ! Now mask out any duplicate points 
     306      CALL dom_uniq( uvt, 'U' ) 
     307      DO jk = 1, jpk 
     308         umask_i_diag(:,:,jk) = umask_i_diag(:,:,jk) * uvt(:,:) 
     309      END DO 
     310 
    321311 
    322312      ! Set up mask for diagnostics on V points, to exclude duplicate 
     
    326316      CALL lbc_lnk( vmask_i_diag, 'V', 1. ) 
    327317 
    328       ! Now mask out any wrap columns 
    329       vmask_i_diag( 1 :iif,:,:) = 0._wp       ! first columns 
    330       vmask_i_diag(iil:jpi,:,:) = 0._wp       ! last  columns (including mpp extra columns) 
    331       ! Now mask out any extra rows 
    332       vmask_i_diag(:,1:ijf,:) = 0._wp         ! first rows 
    333  
    334       ! Now find which points change sign during a V lbc_lnk to find 
    335       ! out which points to mask in the N fold.    
    336       uv(:,:) = 1.0 
    337       CALL lbc_lnk( uv, 'V', -1. ) 
    338  
    339       ! Now find out which points have changed sign and mask them  
    340       DO jj = 1, jpj 
    341          DO ji = 1, jpi 
    342             IF (uv(ji,jj) < 0.0) THEN 
    343                vmask_i_diag(ji,jj,:) = 0.0 
    344             END IF 
    345          END DO 
    346       END DO 
     318      CALL lbc_lnk( vmask_i_diag, 'V', 1. ) 
     319 
     320      ! Now mask out any duplicate points 
     321      CALL dom_uniq( uvt, 'V' ) 
     322      DO jk = 1, jpk 
     323         vmask_i_diag(:,:,jk) = vmask_i_diag(:,:,jk) * uvt(:,:) 
     324      END DO 
     325 
    347326 
    348327 
  • branches/UKMO/dev_r5518_GO6_diag_bitcomp/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r9321 r9710  
    2626   PRIVATE 
    2727 
    28    PUBLIC dom_wri        ! routine called by inidom.F90 
     28   PUBLIC dom_wri, dom_uniq  ! routines called by inidom.F90 and iom.F90 
    2929 
    3030   !! * Substitutions 
Note: See TracChangeset for help on using the changeset viewer.