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 13899 for NEMO/branches/2020/tickets_icb_1900/src/OCE/DOM/domwri.F90 – NEMO

Ignore:
Timestamp:
2020-11-27T17:26:33+01:00 (4 years ago)
Author:
mathiot
Message:

ticket #1900: update branch to trunk and add ICB test case

Location:
NEMO/branches/2020/tickets_icb_1900
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/tickets_icb_1900

    • 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/sette@13559        sette 

  • NEMO/branches/2020/tickets_icb_1900/src/OCE/DOM/domwri.F90

    r13226 r13899  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   dom_wri        : create and write mesh and mask file(s) 
    15    !!   dom_uniq       : identify unique point of a grid (TUVF) 
    1615   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 
    1716   !!---------------------------------------------------------------------- 
    1817   ! 
    1918   USE dom_oce         ! ocean space and time domain 
     19   USE domutl          !  
    2020   USE phycst ,   ONLY :   rsmall 
    2121   USE wet_dry,   ONLY :   ll_wd  ! Wetting and drying 
    … …  
    7474      !                                  ! ============================ 
    7575      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    76       ! 
    77       !                                                         ! global domain size 
    78       CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
    79       CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
    80       CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 ) 
    81  
    8276      !                                                         ! domain characteristics 
    8377      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
    … …  
    10094       
    10195      CALL dom_uniq( zprw, 'T' ) 
    102       DO_2D_11_11 
     96      DO_2D( 1, 1, 1, 1 ) 
    10397         zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    10498      END_2D 
    10599      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )   
    106100      CALL dom_uniq( zprw, 'U' ) 
    107       DO_2D_11_11 
     101      DO_2D( 1, 1, 1, 1 ) 
    108102         zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    109103      END_2D 
    110104      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )   
    111105      CALL dom_uniq( zprw, 'V' ) 
    112       DO_2D_11_11 
     106      DO_2D( 1, 1, 1, 1 ) 
    113107         zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    114108      END_2D 
    … …  
    182176      !                                     ! ============================ 
    183177   END SUBROUTINE dom_wri 
    184  
    185  
    186    SUBROUTINE dom_uniq( puniq, cdgrd ) 
    187       !!---------------------------------------------------------------------- 
    188       !!                  ***  ROUTINE dom_uniq  *** 
    189       !!                    
    190       !! ** Purpose :   identify unique point of a grid (TUVF) 
    191       !! 
    192       !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element 
    193       !!                2) check which elements have been changed 
    194       !!---------------------------------------------------------------------- 
    195       CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    196       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
    197       ! 
    198       REAL(wp) ::  zshift   ! shift value link to the process number 
    199       INTEGER  ::  ji       ! dummy loop indices 
    200       LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    201       REAL(wp), DIMENSION(jpi,jpj) ::   ztstref 
    202       !!---------------------------------------------------------------------- 
    203       ! 
    204       ! build an array with different values for each element  
    205       ! in mpp: make sure that these values are different even between process 
    206       ! -> apply a shift value according to the process number 
    207       zshift = jpi * jpj * ( narea - 1 ) 
    208       ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) ) 
    209       ! 
    210       puniq(:,:) = ztstref(:,:)                   ! default definition 
    211       CALL lbc_lnk( 'domwri', puniq, cdgrd, 1.0_wp )            ! apply boundary conditions 
    212       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    213       ! 
    214       puniq(:,:) = 1.                             ! default definition 
    215       ! fill only the inner part of the cpu with llbl converted into real  
    216       puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    217       ! 
    218    END SUBROUTINE dom_uniq 
    219178 
    220179 
Note: See TracChangeset for help on using the changeset viewer.