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.
domwri.F90 in branches/NERC/dev_r5518_GO6_under_ice_relax/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/NERC/dev_r5518_GO6_under_ice_relax/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90 @ 10047

Last change on this file since 10047 was 10047, checked in by jpalmier, 6 years ago

merge with GO6_package_branch 9385-10020 ; plus debug OMIP_DIC

File size: 18.8 KB
RevLine 
[3]1MODULE domwri
2   !!======================================================================
3   !!                       ***  MODULE domwri  ***
[2715]4   !! Ocean initialization : write the ocean domain mesh file(s)
[3]5   !!======================================================================
[2528]6   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
7   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
8   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
[2715]9   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq
10   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
[2528]11   !!----------------------------------------------------------------------
[3]12
13   !!----------------------------------------------------------------------
[84]14   !!   dom_wri        : create and write mesh and mask file(s)
[2715]15   !!   dom_uniq       :
[3]16   !!----------------------------------------------------------------------
17   USE dom_oce         ! ocean space and time domain
[2528]18   USE in_out_manager  ! I/O manager
19   USE iom             ! I/O library
20   USE lbclnk          ! lateral boundary conditions - mpp exchanges
21   USE lib_mpp         ! MPP library
[3294]22   USE wrk_nemo        ! Memory allocation
23   USE timing          ! Timing
[3]24
25   IMPLICIT NONE
26   PRIVATE
27
[10047]28   PUBLIC dom_wri, dom_uniq  ! routines called by inidom.F90 and iom.F90
[1590]29
30   !! * Substitutions
31#  include "vectopt_loop_substitute.h90"
[3]32   !!----------------------------------------------------------------------
[2528]33   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[6486]34   !! $Id$
[2528]35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE dom_wri
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE dom_wri  ***
42      !!                   
43      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
44      !!      ocean domain informations (mesh and mask arrays). This (these)
45      !!      file(s) is (are) used for visualisation (SAXO software) and
46      !!      diagnostic computation.
47      !!
48      !! ** Method  :   Write in a file all the arrays generated in routines
49      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
50      !!      the vertical coord. used (z-coord, partial steps, s-coord)
[1929]51      !!            MOD(nmsh, 3) = 1  :   'mesh_mask.nc' file
[3]52      !!                         = 2  :   'mesh.nc' and mask.nc' files
[1929]53      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
[3]54      !!                                  'mask.nc' files
55      !!      For huge size domain, use option 2 or 3 depending on your
56      !!      vertical coordinate.
57      !!
[1929]58      !!      if     nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
59      !!      if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays
[2528]60      !!                        corresponding to the depth of the bottom t- and w-points
[1929]61      !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the
[2528]62      !!                        thickness (e3[tw]_ps) of the bottom points
[1929]63      !!
[2528]64      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
65      !!                                   masks, depth and vertical scale factors
[3]66      !!----------------------------------------------------------------------
[2715]67      !!
[2528]68      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file
69      INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file
70      INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file
71      INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file
72      INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file
73      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
74      CHARACTER(len=21) ::   clnam1   ! filename (mesh informations)
75      CHARACTER(len=21) ::   clnam2   ! filename (mask informations)
76      CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations)
77      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations)
78      INTEGER           ::   ji, jj, jk   ! dummy loop indices
[3294]79      !                                   !  workspaces
80      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
81      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
[2715]82      !!----------------------------------------------------------------------
[3294]83      !
84      IF( nn_timing == 1 )  CALL timing_start('dom_wri')
85      !
86      CALL wrk_alloc( jpi, jpj, zprt, zprw )
87      CALL wrk_alloc( jpi, jpj, jpk, zdepu, zdepv )
88      !
[1590]89      IF(lwp) WRITE(numout,*)
90      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
91      IF(lwp) WRITE(numout,*) '~~~~~~~'
92     
93      clnam0 = 'mesh_mask'  ! filename (mesh and mask informations)
94      clnam1 = 'mesh'       ! filename (mesh informations)
95      clnam2 = 'mask'       ! filename (mask informations)
96      clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations)
97      clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations)
98     
99      SELECT CASE ( MOD(nmsh, 3) )
[1161]100         !                                  ! ============================
101      CASE ( 1 )                            !  create 'mesh_mask.nc' file
102         !                                  ! ============================
103         CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
104         inum2 = inum0                                            ! put all the informations
105         inum3 = inum0                                            ! in unit inum0
106         inum4 = inum0
107         
108         !                                  ! ============================
109      CASE ( 2 )                            !  create 'mesh.nc' and
110         !                                  !         'mask.nc' files
111         !                                  ! ============================
112         CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib )
113         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
114         inum3 = inum1                                            ! put mesh informations
115         inum4 = inum1                                            ! in unit inum1
116         !                                  ! ============================
[1590]117      CASE ( 0 )                            !  create 'mesh_hgr.nc'
[1161]118         !                                  !         'mesh_zgr.nc' and
119         !                                  !         'mask.nc'     files
120         !                                  ! ============================
121         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
122         CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
123         CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
[2528]124         !
[1161]125      END SELECT
126     
127      !                                                         ! masks (inum2)
[9321]128      IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[1161]129      CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
130      CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 )
131      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 )
132      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 )
[9321]133      IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[1161]134     
[2715]135      CALL dom_uniq( zprw, 'T' )
[4990]136      DO jj = 1, jpj
137         DO ji = 1, jpi
138            jk=mikt(ji,jj) 
139            zprt(ji,jj) = tmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
140         END DO
141      END DO                             !    ! unique point mask
[9321]142      IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[1161]143      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 
[9321]144      IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[2715]145      CALL dom_uniq( zprw, 'U' )
[4990]146      DO jj = 1, jpj
147         DO ji = 1, jpi
148            jk=miku(ji,jj) 
149            zprt(ji,jj) = umask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
150         END DO
151      END DO
[9321]152      IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[1161]153      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 
[9321]154      IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[2715]155      CALL dom_uniq( zprw, 'V' )
[4990]156      DO jj = 1, jpj
157         DO ji = 1, jpi
158            jk=mikv(ji,jj) 
159            zprt(ji,jj) = vmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
160         END DO
161      END DO
[9321]162      IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[1161]163      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 
[9321]164      IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[2715]165      CALL dom_uniq( zprw, 'F' )
[4990]166      DO jj = 1, jpj
167         DO ji = 1, jpi
168            jk=mikf(ji,jj) 
169            zprt(ji,jj) = fmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
170         END DO
171      END DO
[9321]172      IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[1161]173      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 
174
175      !                                                         ! horizontal mesh (inum3)
176      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude
177      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 )
178      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 )
179      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 )
180     
181      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude
182      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 )
183      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 )
184      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 )
185     
186      CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
187      CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 )
188      CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 )
189      CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 )
190     
191      CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
192      CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 )
193      CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 )
194      CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 )
195     
196      CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 )           !    ! coriolis factor
197     
[2528]198      ! note that mbkt is set to 1 over land ==> use surface tmask
[4990]199      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
[2528]200      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
[4990]201      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
202      CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i2 )       !    ! nb of ocean T-points
203      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
204      CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r4 )       !    ! nb of ocean T-points
[1161]205           
206      IF( ln_sco ) THEN                                         ! s-coordinate
[3680]207         CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )
208         CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )
[1161]209         CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv )
210         CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf )
[2528]211         !
[1161]212         CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef.
213         CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw ) 
214         CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w )
215         CALL iom_rstput( 0, 0, inum4, 'esigt', esigt )
216         CALL iom_rstput( 0, 0, inum4, 'esigw', esigw )
[2528]217         !
[4292]218         CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         !    ! scale factors
219         CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
220         CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
221         CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
[3680]222         CALL iom_rstput( 0, 0, inum4, 'rx1', rx1 )             !    ! Max. grid stiffness ratio
[2528]223         !
[4292]224         CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system
225         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d )
[6487]226         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )     
227         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 )     
[1161]228      ENDIF
[9321]229      IF(nn_timing == 2)  CALL timing_stop('iom_rstput') 
[1161]230      IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
[2528]231         !
[1590]232         IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors
[9321]233            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[4292]234            CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         
235            CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
236            CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
237            CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
[9321]238            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[2528]239         ELSE                                                   !    ! 2D masked bottom ocean scale factors
240            DO jj = 1,jpj   
241               DO ji = 1,jpi
[4990]242                  e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
243                  e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
[2528]244               END DO
245            END DO
[9321]246            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[1590]247            CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp )     
248            CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp )
[9321]249            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[1590]250         END IF
[2528]251         !
[1590]252         IF( nmsh <= 3 ) THEN                                   !    ! 3D depth
[4292]253            CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )     
[2528]254            DO jk = 1,jpk   
255               DO jj = 1, jpjm1   
256                  DO ji = 1, fs_jpim1   ! vector opt.
[4292]257                     zdepu(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk) )
258                     zdepv(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk) )
[2528]259                  END DO   
260               END DO   
261            END DO
[1590]262            CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL lbc_lnk( zdepv, 'V', 1. ) 
[9321]263            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[1590]264            CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 )
265            CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 )
[4292]266            CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 )
[9321]267            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[1590]268         ELSE                                                   !    ! 2D bottom depth
[2528]269            DO jj = 1,jpj   
270               DO ji = 1,jpi
[4990]271                  zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * ssmask(ji,jj)
272                  zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * ssmask(ji,jj)
[2528]273               END DO
274            END DO
[9321]275            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[2528]276            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )     
277            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 ) 
[9321]278            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[1590]279         ENDIF
[2528]280         !
[9321]281         IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[4292]282         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! reference z-coord.
283         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
284         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )
285         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
[9321]286         IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[1161]287      ENDIF
288     
289      IF( ln_zco ) THEN
290         !                                                      ! z-coordinate - full steps
[9321]291         IF(nn_timing == 2)  CALL timing_start('iom_rstput')
[4292]292         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! depth
293         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
294         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )   !    ! scale factors
295         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
[9321]296         IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
[1161]297      ENDIF
298      !                                     ! ============================
299      !                                     !        close the files
300      !                                     ! ============================
[1929]301      SELECT CASE ( MOD(nmsh, 3) )
[1161]302      CASE ( 1 )               
303         CALL iom_close( inum0 )
304      CASE ( 2 )
305         CALL iom_close( inum1 )
306         CALL iom_close( inum2 )
[1929]307      CASE ( 0 )
[1161]308         CALL iom_close( inum2 )
309         CALL iom_close( inum3 )
310         CALL iom_close( inum4 )
311      END SELECT
[2528]312      !
[3294]313      CALL wrk_dealloc( jpi, jpj, zprt, zprw )
314      CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv )
[2715]315      !
[3294]316      IF( nn_timing == 1 )  CALL timing_stop('dom_wri')
317      !
[1161]318   END SUBROUTINE dom_wri
[3]319
320
[2715]321   SUBROUTINE dom_uniq( puniq, cdgrd )
[1161]322      !!----------------------------------------------------------------------
323      !!                  ***  ROUTINE dom_uniq  ***
324      !!                   
325      !! ** Purpose :   identify unique point of a grid (TUVF)
326      !!
327      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
328      !!                2) check which elements have been changed
329      !!----------------------------------------------------------------------
[2528]330      !
[2715]331      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !
332      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !
333      !
334      REAL(wp) ::  zshift   ! shift value link to the process number
335      INTEGER  ::  ji       ! dummy loop indices
336      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
[3294]337      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
[1161]338      !!----------------------------------------------------------------------
[3294]339      !
340      IF( nn_timing == 1 )  CALL timing_start('dom_uniq')
341      !
342      CALL wrk_alloc( jpi, jpj, ztstref )
343      !
[1161]344      ! build an array with different values for each element
345      ! in mpp: make sure that these values are different even between process
346      ! -> apply a shift value according to the process number
347      zshift = jpi * jpj * ( narea - 1 )
[2528]348      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
349      !
[1161]350      puniq(:,:) = ztstref(:,:)                   ! default definition
351      CALL lbc_lnk( puniq, cdgrd, 1. )            ! apply boundary conditions
352      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed
[2528]353      !
[1161]354      puniq(:,:) = 1.                             ! default definition
355      ! fill only the inner part of the cpu with llbl converted into real
[2528]356      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )
357      !
[3294]358      CALL wrk_dealloc( jpi, jpj, ztstref )
[2715]359      !
[3294]360      IF( nn_timing == 1 )  CALL timing_stop('dom_uniq')
361      !
[2715]362   END SUBROUTINE dom_uniq
[3]363
364   !!======================================================================
365END MODULE domwri
Note: See TracBrowser for help on using the repository browser.