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 6827 for branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 – NEMO

Ignore:
Timestamp:
2016-08-01T15:37:15+02:00 (8 years ago)
Author:
flavoni
Message:

#1692 - branch SIMPLIF_2_usrdef: commit routines Fortran to create domain_cfg.nc file, to have domain (input) files for new simplification branch. To be moved in TOOLS directory

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r6140 r6827  
    2424   USE oce             ! ocean variables 
    2525   USE dom_oce         ! domain: ocean 
    26    USE sbc_oce         ! surface boundary condition: ocean 
    2726   USE phycst          ! physical constants 
    2827   USE closea          ! closed seas 
     
    3332   USE domwri          ! domain: write the meshmask file 
    3433   USE domvvl          ! variable volume 
    35    USE c1d             ! 1D vertical configuration 
    36    USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine) 
    3734   ! 
    3835   USE in_out_manager  ! I/O manager 
     36   USE iom             !  
    3937   USE wrk_nemo        ! Memory Allocation 
    4038   USE lib_mpp         ! distributed memory computing library 
     
    137135      ENDIF 
    138136      ! 
    139       IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
    140       ! 
    141                              CALL dom_stp       ! time step 
    142       IF( nmsh /= 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file 
    143       IF( nmsh /= 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file 
    144       IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
     137      CALL cfg_write         ! create the configuration file 
    145138      ! 
    146139      IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
     
    465458   END SUBROUTINE dom_stiff 
    466459 
     460 
     461   SUBROUTINE cfg_write 
     462      !!---------------------------------------------------------------------- 
     463      !!                  ***  ROUTINE cfg_write  *** 
     464      !!                    
     465      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which  
     466      !!              contains all the ocean domain informations required to  
     467      !!              define an ocean configuration. 
     468      !! 
     469      !! ** Method  :   Write in a file all the arrays required to set up an 
     470      !!              ocean configuration. 
     471      !! 
     472      !! ** output file :   domain_cfg.nc : domain size, characteristics, 
     473      !horizontal mesh, 
     474      !!                              Coriolis parameter, depth and vertical 
     475      !scale factors 
     476      !!---------------------------------------------------------------------- 
     477      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
     478      INTEGER           ::   izco, izps, isco, icav 
     479      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file 
     480      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations) 
     481      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace 
     482      !!---------------------------------------------------------------------- 
     483      ! 
     484      IF(lwp) WRITE(numout,*) 
     485      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information' 
     486      IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
     487      ! 
     488      !                       ! ============================= ! 
     489      !                       !  create 'domain_cfg.nc' file  ! 
     490      !                       ! ============================= ! 
     491      !          
     492      clnam = 'domain_cfg'  ! filename (configuration information) 
     493      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     494       
     495      !                             !==  global domain size  ==! 
     496      ! 
     497      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
     498      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
     499      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 ) 
     500      ! 
     501      !                             !==  domain characteristics  ==! 
     502      ! 
     503      !                                   ! lateral boundary of the global 
     504      !                                   domain 
     505      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
     506      ! 
     507      !                                   ! type of vertical coordinate 
     508      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
     509      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
     510      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
     511      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
     512      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
     513      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     514      ! 
     515      !                                   ! ocean cavities under iceshelves 
     516      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
     517      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     518      ! 
     519      !                             !==  horizontal mesh  ! 
     520      ! 
     521      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude 
     522      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 ) 
     523      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 
     524      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 
     525      !                                 
     526      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude 
     527      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 
     528      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 
     529      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 
     530      !                                 
     531      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.) 
     532      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 ) 
     533      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 ) 
     534      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 ) 
     535      ! 
     536      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.) 
     537      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 ) 
     538      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 ) 
     539      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 ) 
     540      ! 
     541      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor 
     542      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 ) 
     543      ! 
     544      !                             !==  vertical mesh - 3D mask  ==! 
     545      !                                                      
     546      CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   !  reference 1D-coordinate 
     547      CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 ) 
     548      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 ) 
     549      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 ) 
     550      !                                                      
     551      CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )   !  depth (t- & w-points) 
     552      CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 ) 
     553      ! 
     554      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e 
     555      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 ) 
     556      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 ) 
     557      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 ) 
     558      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 ) 
     559      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 ) 
     560      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 ) 
     561      !                                          
     562      !                             !==  ocean top and bottom level  ==! 
     563      ! 
     564      CALL iom_rstput( 0, 0, inum, 'bottom level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points 
     565      CALL iom_rstput( 0, 0, inum, 'top    level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF) 
     566      ! 
     567      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio (Not required anyway) 
     568         CALL dom_stiff 
     569         !SF  CALL dom_stiff( z2d ) !commented because at compilation error:  The 
     570                                   !number of actual arguments cannot be greater than the number of dummy 
     571                                   !arguments.   [DOM_STIFF] 
     572                                   !CALL dom_stiff( z2d ) 
     573                                   ! --------------^ compilation aborted for 
     574                                   !/workgpfs/rech/gzi/rgzi011/commit-simplif2-TOOLS/NEMOGCM/CONFIG/TEST/BLD/ppsrc/nemo/domain.f90 
     575         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio 
     576      ENDIF 
     577      ! 
     578      !                                ! ============================ 
     579      !                                !        close the files  
     580      !                                ! ============================ 
     581      CALL iom_close( inum ) 
     582      ! 
     583   END SUBROUTINE cfg_write 
     584 
     585 
     586 
    467587   !!====================================================================== 
    468588END MODULE domain 
Note: See TracChangeset for help on using the changeset viewer.