Ignore:
Timestamp:
2015-10-26T15:49:40+01:00 (6 years ago)
Author:
cetlod
Message:

merge the simplification branch onto the trunk, see ticket #1612

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r5603 r5836  
    77   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL 
    88   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file 
    9    !!            3.0  ! 2008-01  (S. Masson) add dom_uniq  
    10    !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     9   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq  
    1110   !!---------------------------------------------------------------------- 
    1211 
    1312   !!---------------------------------------------------------------------- 
    1413   !!   dom_wri        : create and write mesh and mask file(s) 
    15    !!   dom_uniq       : 
     14   !!   dom_uniq       : identify unique point of a grid (TUVF) 
    1615   !!---------------------------------------------------------------------- 
    1716   USE dom_oce         ! ocean space and time domain 
     
    2625   PRIVATE 
    2726 
    28    PUBLIC dom_wri        ! routine called by inidom.F90 
    29  
     27   PUBLIC   dom_wri              ! routine called by inidom.F90 
     28   PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90 
    3029   !! * Substitutions 
    3130#  include "vectopt_loop_substitute.h90" 
     
    3635   !!---------------------------------------------------------------------- 
    3736CONTAINS 
     37 
     38   SUBROUTINE dom_wri_coordinate 
     39      !!---------------------------------------------------------------------- 
     40      !!                  ***  ROUTINE dom_wri_coordinate  *** 
     41      !!                    
     42      !! ** Purpose :   Create the NetCDF file which contains all the 
     43      !!              standard coordinate information plus the surface, 
     44      !!              e1e2u and e1e2v. By doing so, those surface will 
     45      !!              not be changed by the reduction of e1u or e2v scale  
     46      !!              factors in some straits.  
     47      !!                 NB: call just after the read of standard coordinate 
     48      !!              and the reduction of scale factors in some straits 
     49      !! 
     50      !! ** output file :   coordinate_e1e2u_v.nc 
     51      !!---------------------------------------------------------------------- 
     52      INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file 
     53      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
     54      !                                   !  workspaces 
     55      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw  
     56      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 
     57      !!---------------------------------------------------------------------- 
     58      ! 
     59      IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate') 
     60      ! 
     61      IF(lwp) WRITE(numout,*) 
     62      IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file' 
     63      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~' 
     64       
     65      clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations) 
     66       
     67      !  create 'coordinate_e1e2u_v.nc' file 
     68      ! ============================ 
     69      ! 
     70      CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
     71      ! 
     72      !                                                         ! horizontal mesh (inum3) 
     73      CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude 
     74      CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 ) 
     75      CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 ) 
     76      CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 ) 
     77       
     78      CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude 
     79      CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 ) 
     80      CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 ) 
     81      CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 ) 
     82       
     83      CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
     84      CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 ) 
     85      CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 ) 
     86      CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 ) 
     87       
     88      CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
     89      CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 ) 
     90      CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 ) 
     91      CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 ) 
     92       
     93      CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 ) 
     94      CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 ) 
     95 
     96      CALL iom_close( inum0 ) 
     97      ! 
     98      IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate') 
     99      ! 
     100   END SUBROUTINE dom_wri_coordinate 
     101 
    38102 
    39103   SUBROUTINE dom_wri 
Note: See TracChangeset for help on using the changeset viewer.