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 13286 for NEMO/trunk/src/OCE/CRS/crsdomwri.F90 – NEMO

Ignore:
Timestamp:
2020-07-09T17:48:29+02:00 (4 years ago)
Author:
smasson
Message:

trunk: merge extra halos branch in trunk, see #2366

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools/@HEAD           tools 
         4^/utils/tools@HEAD            tools 
        55^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        … …  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@12931        sette 
         10^/utils/CI/r12931_sette_ticket2366@HEAD  sette 

  • NEMO/trunk/src/OCE/CRS/crsdomwri.F90

    r13226 r13286  
    5050      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    5151      INTEGER           ::   inum         ! local units for 'mesh_mask.nc' file 
    52       INTEGER           ::   iif, iil, ijf, ijl 
    5352      CHARACTER(len=21) ::   clnam        ! filename (mesh and mask informations) 
    5453      !                                   !  workspace 
    … …  
    7675      CALL iom_rstput( 0, 0, inum, 'fmask', fmask_crs, ktype = jp_i1 ) 
    7776       
    78        
    79       tmask_i_crs(:,:) = tmask_crs(:,:,1) 
    80       iif = nn_hls 
    81       iil = nlci_crs - nn_hls + 1 
    82       ijf = nn_hls 
    83       ijl = nlcj_crs - nn_hls + 1 
    84       
    85       tmask_i_crs( 1:iif ,    :  ) = 0._wp 
    86       tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp 
    87       tmask_i_crs(   :   , 1:ijf ) = 0._wp 
    88       tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp 
    89        
    90        
    91       tpol_crs(1:jpiglo_crs,:) = 1._wp 
    92       fpol_crs(1:jpiglo_crs,:) = 1._wp 
    93       IF( jperio == 3 .OR. jperio == 4 ) THEN 
    94          tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp 
    95          fpol_crs(       1      :jpiglo_crs,:) = 0._wp 
    96          IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN 
    97             DO ji = iif+1, iil-1 
    98                tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) & 
    99                & * tpol_crs(mig_crs(ji),1) 
    100             ENDDO 
    101          ENDIF 
    102       ENDIF 
    103       IF( jperio == 5 .OR. jperio == 6 ) THEN 
    104          tpol_crs(      1       :jpiglo_crs,:)=0._wp 
    105          fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp 
    106       ENDIF 
    107        
    108       CALL iom_rstput( 0, 0, inum, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 
    109                                    !    ! unique point mask 
     77      CALL dom_uniq_crs( zprw, 'T' ) 
     78      zprt = tmask_crs(:,:,1) * zprw 
     79      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 ) 
    11080      CALL dom_uniq_crs( zprw, 'U' ) 
    11181      zprt = umask_crs(:,:,1) * zprw 
    … …  
    211181      REAL(wp) ::  zshift   ! shift value link to the process number 
    212182      INTEGER  ::  ji       ! dummy loop indices 
    213       LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    214       REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: ztstref 
     183      LOGICAL , DIMENSION(jpi_crs,jpj_crs,1) ::   lluniq  ! store whether each point is unique or not 
     184      REAL(wp), DIMENSION(jpi_crs,jpj_crs  ) ::  ztstref 
    215185      !!---------------------------------------------------------------------- 
    216186      ! 
    … …  
    218188      ! in mpp: make sure that these values are different even between process 
    219189      ! -> apply a shift value according to the process number 
    220       zshift = jpi_crs * jpj_crs * ( narea - 1 ) 
     190      zshift = (jpi_crs+1.) * (jpj_crs+1.) * ( narea - 1 )   ! we should use jpimax_crs but not existing 
    221191      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi_crs*jpj_crs) /), (/ jpi_crs, jpj_crs /) ) 
    222192      ! 
    223193      puniq(:,:) = ztstref(:,:)                   ! default definition 
    224194      CALL crs_lbc_lnk( puniq,cdgrd, 1.0_wp )            ! apply boundary conditions 
    225       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    226       ! 
    227       puniq(:,:) = 1.                             ! default definition 
    228       ! fill only the inner part of the cpu with llbl converted into real  
    229       puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 
     195      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
     196      ! 
     197      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) 
    230198      ! 
    231199   END SUBROUTINE dom_uniq_crs 
Note: See TracChangeset for help on using the changeset viewer.