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

Changeset 1161


Ignore:
Timestamp:
2008-07-01T13:50:07+02:00 (16 years ago)
Author:
smasson
Message:

improve mesh_mask file, see ticket:228

Location:
trunk/NEMO/OPA_SRC/DOM
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/DOM/dom_oce.F90

    r1152 r1161  
    144144 
    145145   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    146       hdept, hdepw, e3tp, e3wp   !: ??? 
     146      hdept, hdepw, e3tp, e3wp   !: bottom depth and thickness at T and W points 
    147147 
    148148   !! s-coordinate and hybrid z-s-coordinate 
  • trunk/NEMO/OPA_SRC/DOM/domwri.F90

    r1152 r1161  
    1515   USE in_out_manager 
    1616   USE iom 
     17   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     18   USE lib_mpp 
    1719 
    1820   IMPLICIT NONE 
     
    8082       clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations) 
    8183 
     84      SELECT CASE (nmsh) 
     85         !                                  ! ============================ 
     86      CASE ( 1 )                            !  create 'mesh_mask.nc' file 
     87         !                                  ! ============================ 
     88         CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
     89         inum2 = inum0                                            ! put all the informations 
     90         inum3 = inum0                                            ! in unit inum0 
     91         inum4 = inum0 
     92          
     93         !                                  ! ============================ 
     94      CASE ( 2 )                            !  create 'mesh.nc' and  
     95         !                                  !         'mask.nc' files 
     96         !                                  ! ============================ 
     97         CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 
     98         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
     99         inum3 = inum1                                            ! put mesh informations  
     100         inum4 = inum1                                            ! in unit inum1  
     101         !                                  ! ============================ 
     102      CASE ( 3 )                            !  create 'mesh_hgr.nc' 
     103         !                                  !         'mesh_zgr.nc' and 
     104         !                                  !         'mask.nc'     files 
     105         !                                  ! ============================ 
     106         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
     107         CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 
     108         CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 
     109          
     110      END SELECT 
     111       
     112      !                                                         ! masks (inum2)  
     113      CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask 
     114      CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 ) 
     115      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 ) 
     116      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 
     117       
     118       
     119      zprt = tmask(:,:,1) * dom_uniq('T')                               !    ! unique point mask 
     120      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )   
     121      zprt = umask(:,:,1) * dom_uniq('U') 
     122      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
     123      zprt = vmask(:,:,1) * dom_uniq('V') 
     124      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
     125      zprt = fmask(:,:,1) * dom_uniq('F') 
     126      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )   
     127 
     128      !                                                         ! horizontal mesh (inum3) 
     129      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude 
     130      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 ) 
     131      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 ) 
     132      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 ) 
     133       
     134      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude 
     135      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 ) 
     136      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 ) 
     137      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 ) 
     138       
     139      CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
     140      CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 ) 
     141      CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 ) 
     142      CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 ) 
     143       
     144      CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
     145      CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 ) 
     146      CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 ) 
     147      CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 ) 
     148       
     149      CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 )           !    ! coriolis factor 
     150       
    82151!       note that mbathy has been modified in dommsk or in solver. 
    83152!       it is the number of non-zero "w" levels in the water, and the minimum  
     
    86155! 
    87156      zprt = tmask(:,:,1)*(mbathy-1) 
    88  
    89       SELECT CASE (nmsh) 
    90          !                                     ! ============================ 
    91          CASE ( 1 )                            !  create 'mesh_mask.nc' file 
    92             !                                  ! ============================ 
    93             CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
    94             inum2 = inum0                                            ! put all the informations 
    95             inum3 = inum0                                            ! in unit inum0 
    96             inum4 = inum0 
    97  
    98             !                                  ! ============================ 
    99          CASE ( 2 )                            !  create 'mesh.nc' and  
    100             !                                  !         'mask.nc' files 
    101             !                                  ! ============================ 
    102             CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 
    103             CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    104             inum3 = inum1                                            ! put mesh informations  
    105             inum4 = inum1                                            ! in unit inum1  
    106             !                                  ! ============================ 
    107          CASE ( 3 )                            !  create 'mesh_hgr.nc' 
    108             !                                  !         'mesh_zgr.nc' and 
    109             !                                  !         'mask.nc'     files 
    110             !                                  ! ============================ 
    111             CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    112             CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 
    113             CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 
    114  
    115          END SELECT 
    116  
    117          !                                                         ! masks (inum2)  
    118          CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )  
    119          CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 ) 
    120          CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 ) 
    121          CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 
    122  
    123          !                                                         ! horizontal mesh (inum3) 
    124          CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude 
    125          CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 ) 
    126          CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 ) 
    127          CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 ) 
    128  
    129          CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude 
    130          CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 ) 
    131          CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 ) 
    132          CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 ) 
    133  
    134          CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
    135          CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 ) 
    136          CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 ) 
    137          CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 ) 
    138  
    139          CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
    140          CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 ) 
    141          CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 ) 
    142          CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 ) 
    143  
    144          CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 )           !    ! coriolis factor 
    145  
    146          CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 ) 
    147  
     157      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 ) 
     158             
    148159#if ! defined key_zco 
    149          IF( ln_sco ) THEN                                         ! s-coordinate 
    150             CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )      !    ! depth 
    151             CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )  
    152             CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv ) 
    153             CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf ) 
     160      IF( ln_sco ) THEN                                         ! s-coordinate 
     161         CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )         !    ! depth 
     162         CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )  
     163         CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv ) 
     164         CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf ) 
     165          
     166         CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef. 
     167         CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw )   
     168         CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w ) 
     169         CALL iom_rstput( 0, 0, inum4, 'esigt', esigt ) 
     170         CALL iom_rstput( 0, 0, inum4, 'esigw', esigw ) 
     171          
     172         CALL iom_rstput( 0, 0, inum4, 'e3t', e3t )             !    ! scale factors 
     173         CALL iom_rstput( 0, 0, inum4, 'e3u', e3u ) 
     174         CALL iom_rstput( 0, 0, inum4, 'e3v', e3v ) 
     175         CALL iom_rstput( 0, 0, inum4, 'e3w', e3w ) 
     176          
     177         CALL iom_rstput( 0, 0, inum4, 'gdept_0' , gdept_0 )    !    ! stretched system 
     178         CALL iom_rstput( 0, 0, inum4, 'gdepw_0' , gdepw_0 ) 
     179      ENDIF 
     180       
     181      IF( ln_zps ) THEN                                         ! z-coordinate - partial steps 
     182         CALL iom_rstput( 0, 0, inum4, 'hdept' , hdept  )       !    ! bottom depth 
     183         CALL iom_rstput( 0, 0, inum4, 'hdepw' , hdepw  )  
     184          
     185         CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp   )       !    ! bottom scale factors 
     186         CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp   )  
     187    
     188         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! reference z-coord. 
     189         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 
     190         CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   ) 
     191         CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   ) 
     192      ENDIF 
     193       
     194#endif 
     195       
     196      IF( ln_zco ) THEN 
     197         !                                                      ! z-coordinate - full steps 
     198         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! depth 
     199         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 
     200         CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )     !    ! scale factors 
     201         CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   ) 
     202      ENDIF 
     203      !                                     ! ============================ 
     204      !                                     !        close the files  
     205      !                                     ! ============================ 
     206      SELECT CASE ( nmsh ) 
     207      CASE ( 1 )                 
     208         CALL iom_close( inum0 ) 
     209      CASE ( 2 ) 
     210         CALL iom_close( inum1 ) 
     211         CALL iom_close( inum2 ) 
     212      CASE ( 3 ) 
     213         CALL iom_close( inum2 ) 
     214         CALL iom_close( inum3 ) 
     215         CALL iom_close( inum4 ) 
     216      END SELECT 
     217       
     218   END SUBROUTINE dom_wri 
     219 
     220 
     221   FUNCTION dom_uniq( cdgrd )   RESULT( puniq ) 
     222      !!---------------------------------------------------------------------- 
     223      !!                  ***  ROUTINE dom_uniq  *** 
     224      !!                    
     225      !! ** Purpose :   identify unique point of a grid (TUVF) 
     226      !! 
     227      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element 
     228      !!                2) check which elements have been changed 
     229      !! 
     230      !!---------------------------------------------------------------------- 
     231      CHARACTER(len=1)            , INTENT(in   ) ::  cdgrd   !  
     232      REAL(wp), DIMENSION(jpi,jpj)                ::  puniq   !  
     233 
     234      REAL(wp), DIMENSION(jpi,jpj  ) ::  ztstref   ! array with different values for each element  
     235      REAL(wp)                       ::  zshift    ! shift value link to the process number 
     236      LOGICAL , DIMENSION(jpi,jpj,1) ::  lldbl     ! is the point unique or not? 
     237      INTEGER                        ::  ji        ! dummy loop indices 
     238      !!---------------------------------------------------------------------- 
     239 
     240      ! build an array with different values for each element  
     241      ! in mpp: make sure that these values are different even between process 
     242      ! -> apply a shift value according to the process number 
     243      zshift = jpi * jpj * ( narea - 1 ) 
     244      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji, wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) ) 
    154245    
    155             CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )        !    ! scaling coef. 
    156             CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw )   
    157             CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w ) 
    158             CALL iom_rstput( 0, 0, inum4, 'esigt', esigt ) 
    159             CALL iom_rstput( 0, 0, inum4, 'esigw', esigw ) 
    160  
    161             CALL iom_rstput( 0, 0, inum4, 'e3t', e3t )       !    ! scale factors 
    162             CALL iom_rstput( 0, 0, inum4, 'e3u', e3u ) 
    163             CALL iom_rstput( 0, 0, inum4, 'e3v', e3v ) 
    164             CALL iom_rstput( 0, 0, inum4, 'e3w', e3w ) 
    165  
    166             CALL iom_rstput( 0, 0, inum4, 'gdept_0' , gdept_0 )  !    ! stretched system 
    167             CALL iom_rstput( 0, 0, inum4, 'gdepw_0' , gdepw_0 ) 
    168          ENDIF 
    169  
    170          IF( ln_zps ) THEN                                         ! z-coordinate - partial steps 
    171             CALL iom_rstput( 0, 0, inum4, 'hdept' , hdept  )    !    ! depth 
    172             CALL iom_rstput( 0, 0, inum4, 'hdepw' , hdepw  )  
    173  
    174             CALL iom_rstput( 0, 0, inum4, 'e3t' , e3t )      !    ! scale factors 
    175             CALL iom_rstput( 0, 0, inum4, 'e3u' , e3u ) 
    176             CALL iom_rstput( 0, 0, inum4, 'e3v' , e3v ) 
    177             CALL iom_rstput( 0, 0, inum4, 'e3w' , e3w ) 
    178  
    179             CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )   !    ! reference z-coord. 
    180             CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 
    181             CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   ) 
    182             CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   ) 
    183          ENDIF 
    184  
    185 #endif 
    186  
    187          IF( ln_zco ) THEN 
    188          !                                                         ! z-coordinate - full steps 
    189             CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )   !    ! depth 
    190             CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 
    191             CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )   !    ! scale factors 
    192             CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   ) 
    193          ENDIF 
    194          !                                     ! ============================ 
    195          !                                     !        close the files  
    196          !                                     ! ============================ 
    197          SELECT CASE ( nmsh ) 
    198             CASE ( 1 )                 
    199                CALL iom_close( inum0 ) 
    200             CASE ( 2 ) 
    201                CALL iom_close( inum1 ) 
    202                CALL iom_close( inum2 ) 
    203             CASE ( 3 ) 
    204                CALL iom_close( inum2 ) 
    205                CALL iom_close( inum3 ) 
    206                CALL iom_close( inum4 ) 
    207          END SELECT 
    208  
    209    END SUBROUTINE dom_wri 
     246      puniq(:,:) = ztstref(:,:)                   ! default definition 
     247      CALL lbc_lnk( puniq, cdgrd, 1. )            ! apply boundary conditions 
     248      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
     249       
     250      puniq(:,:) = 1.                             ! default definition 
     251      ! fill only the inner part of the cpu with llbl converted into real  
     252      puniq(nldi:nlei,nldj:nlej) = REAL(COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ), wp) 
     253 
     254   END FUNCTION dom_uniq 
     255 
    210256 
    211257   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.