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 5972 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OFF_SRC/domrea.F90 – NEMO

Ignore:
Timestamp:
2015-12-02T09:52:20+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded to head of trunk (r5936)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r5967 r5972  
    44   !! Ocean initialization : domain initialization 
    55   !!============================================================================== 
     6   !! History :  OPA  ! 1990-10  (C. Levy - G. Madec)  Original code 
     7   !!                 ! 1992-01  (M. Imbard) insert time step initialization 
     8   !!                 ! 1996-06  (G. Madec) generalized vertical coordinate  
     9   !!                 ! 1997-02  (G. Madec) creation of domwri.F 
     10   !!                 ! 2001-05  (E.Durand - G. Madec) insert closed sea 
     11   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module 
     12   !!---------------------------------------------------------------------- 
    613 
    714   !!---------------------------------------------------------------------- 
     
    1017   !!   dom_ctl        : control print for the ocean domain 
    1118   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1319   USE oce             !  
     20   USE trc_oce         ! shared ocean/biogeochemical variables 
    1421   USE dom_oce         ! ocean space and time domain 
    1522   USE phycst          ! physical constants 
     23   USE domstp          ! domain: set the time-step 
     24   ! 
    1625   USE in_out_manager  ! I/O manager 
    1726   USE lib_mpp         ! distributed memory computing library 
    18  
    19    USE domstp          ! domain: set the time-step 
    20  
    2127   USE lbclnk          ! lateral boundary condition - MPP exchanges 
    22    USE trc_oce         ! shared ocean/biogeochemical variables 
    2328   USE wrk_nemo   
    2429    
     
    2631   PRIVATE 
    2732 
    28    !! * Routine accessibility 
    29    PUBLIC dom_rea       ! called by opa.F90 
     33   PUBLIC   dom_rea    ! called by nemogcm.F90 
    3034 
    3135   !! * Substitutions 
     
    3337#  include "vectopt_loop_substitute.h90" 
    3438   !!---------------------------------------------------------------------- 
    35    !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     39   !! NEMO/OFF 3.7 , NEMO Consortium (2015) 
    3640   !! $Id$ 
    3741   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3842   !!---------------------------------------------------------------------- 
    39  
    4043CONTAINS 
    4144 
     
    5154      !!      - dom_stp: defined the model time step 
    5255      !!      - dom_rea: read the meshmask file if nmsh=1 
    53       !! 
    54       !! History : 
    55       !!        !  90-10  (C. Levy - G. Madec)  Original code 
    56       !!        !  91-11  (G. Madec) 
    57       !!        !  92-01  (M. Imbard) insert time step initialization 
    58       !!        !  96-06  (G. Madec) generalized vertical coordinate  
    59       !!        !  97-02  (G. Madec) creation of domwri.F 
    60       !!        !  01-05  (E.Durand - G. Madec) insert closed sea 
    61       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    62       !!---------------------------------------------------------------------- 
    63       !! * Local declarations 
    64       INTEGER ::   jk                ! dummy loop argument 
    65       INTEGER ::   iconf = 0         ! temporary integers 
    66       !!---------------------------------------------------------------------- 
    67  
     56      !!---------------------------------------------------------------------- 
     57      INTEGER ::   jk          ! dummy loop index 
     58      INTEGER ::   iconf = 0   ! local integers 
     59      !!---------------------------------------------------------------------- 
     60      ! 
    6861      IF(lwp) THEN 
    6962         WRITE(numout,*) 
     
    7164         WRITE(numout,*) '~~~~~~~~' 
    7265      ENDIF 
    73  
    74       CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
     66      ! 
     67      CALL dom_nam      ! read namelist ( namrun, namdom ) 
    7568      CALL dom_zgr      ! Vertical mesh and bathymetry option 
    7669      CALL dom_grd      ! Create a domain file 
    77  
    78      ! 
    79       ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines 
    80       !        but could be usefull in many other routines 
    81       e12t    (:,:) = e1t(:,:) * e2t(:,:) 
    82       e1e2t   (:,:) = e1t(:,:) * e2t(:,:) 
    83       e12u    (:,:) = e1u(:,:) * e2u(:,:) 
    84       e12v    (:,:) = e1v(:,:) * e2v(:,:) 
    85       e12f    (:,:) = e1f(:,:) * e2f(:,:) 
    86       r1_e12t (:,:) = 1._wp    / e12t(:,:) 
    87       r1_e12u (:,:) = 1._wp    / e12u(:,:) 
    88       r1_e12v (:,:) = 1._wp    / e12v(:,:) 
    89       r1_e12f (:,:) = 1._wp    / e12f(:,:) 
    90       re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    91       re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    92       ! 
    93       hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points 
     70      ! 
     71      !                                      ! associated horizontal metrics 
     72      ! 
     73      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
     74      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:) 
     75      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:) 
     76      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:) 
     77      ! 
     78      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
     79      e1e2u (:,:) = e1u(:,:) * e2u(:,:)   ;   r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) 
     80      e1e2v (:,:) = e1v(:,:) * e2v(:,:)   ;   r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
     81      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 
     82      !    
     83      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     84      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     85      ! 
     86      hu(:,:) = 0._wp                        ! Ocean depth at U- and V-points 
    9487      hv(:,:) = 0._wp 
    9588      DO jk = 1, jpk 
     
    10093      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
    10194      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
    102  
     95      ! 
    10396      CALL dom_stp      ! Time step 
    10497      CALL dom_msk      ! Masks 
    10598      CALL dom_ctl      ! Domain control 
    106  
     99      ! 
    107100   END SUBROUTINE dom_rea 
     101 
    108102 
    109103   SUBROUTINE dom_nam 
     
    115109      !! ** input   : - namrun namelist 
    116110      !!              - namdom namelist 
    117       !!              - namcla namelist 
    118111      !!---------------------------------------------------------------------- 
    119112      USE ioipsl 
    120       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     113      INTEGER  ::   ios   ! Local integer output status for namelist read 
     114      ! 
    121115      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
    122116         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     
    130124         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
    131125         &             ppa2, ppkth2, ppacr2 
    132       NAMELIST/namcla/ nn_cla 
    133126#if defined key_netcdf4 
    134127      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
     
    178171      nstocklist = nn_stocklist 
    179172      nwrite = nn_write 
    180  
    181  
     173      ! 
    182174      !                             ! control of output frequency 
    183175      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
     
    275267      rdth      = rn_rdth 
    276268 
    277       REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection 
    278       READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905) 
    279 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp ) 
    280  
    281       REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection 
    282       READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 ) 
    283 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp ) 
    284       IF(lwm) WRITE( numond, namcla ) 
    285  
    286       IF(lwp) THEN 
    287          WRITE(numout,*) 
    288          WRITE(numout,*) '   Namelist namcla' 
    289          WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla 
    290       ENDIF 
    291  
    292269#if defined key_netcdf4 
    293270      !                             ! NetCDF 4 case   ("key_netcdf4" defined) 
     
    321298   END SUBROUTINE dom_nam 
    322299 
     300 
    323301   SUBROUTINE dom_zgr 
    324302      !!---------------------------------------------------------------------- 
     
    374352   END SUBROUTINE dom_zgr 
    375353 
     354 
    376355   SUBROUTINE dom_ctl 
    377356      !!---------------------------------------------------------------------- 
     
    382361      !! ** Method  :   compute and print extrema of masked scale factors 
    383362      !! 
    384       !! History : 
    385       !!   8.5  !  02-08  (G. Madec)    Original code 
    386       !!---------------------------------------------------------------------- 
    387       !! * Local declarations 
     363      !!---------------------------------------------------------------------- 
    388364      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
    389365      INTEGER, DIMENSION(2) ::   iloc      !  
     
    421397         ijma2 = iloc(2) + njmpp - 1 
    422398      ENDIF 
    423  
     399      ! 
    424400      IF(lwp) THEN 
    425401         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
     
    428404         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 
    429405      ENDIF 
    430  
     406      ! 
    431407   END SUBROUTINE dom_ctl 
     408 
    432409 
    433410   SUBROUTINE dom_grd 
     
    538515         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 
    539516#endif 
    540  
    541517         !                                                         ! horizontal mesh (inum3) 
    542518         CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) 
     
    756732      !!                                     (min value = 1 over land) 
    757733      !!---------------------------------------------------------------------- 
    758       ! 
    759734      INTEGER ::   ji, jj   ! dummy loop indices 
    760735      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
     
    785760   END SUBROUTINE zgr_bot_level 
    786761 
     762 
    787763   SUBROUTINE dom_msk 
    788764      !!--------------------------------------------------------------------- 
     
    799775      !!               tpol     : ??? 
    800776      !!---------------------------------------------------------------------- 
    801       ! 
    802       INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    803       INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
     777      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     778      INTEGER  ::   iif, iil, ijf, ijl   ! local integers 
    804779      INTEGER, POINTER, DIMENSION(:,:) ::  imsk  
    805       ! 
    806780      !!--------------------------------------------------------------------- 
    807781       
     
    853827      ! 3. Ocean/land mask at wu-, wv- and w points  
    854828      !---------------------------------------------- 
    855       wmask (:,:,1) = tmask(:,:,1) ! ???????? 
    856       wumask(:,:,1) = umask(:,:,1) ! ???????? 
    857       wvmask(:,:,1) = vmask(:,:,1) ! ???????? 
    858       DO jk=2,jpk 
    859          wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1) 
    860          wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)    
    861          wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1) 
     829      wmask (:,:,1) = tmask(:,:,1)        ! surface value 
     830      wumask(:,:,1) = umask(:,:,1)  
     831      wvmask(:,:,1) = vmask(:,:,1) 
     832      DO jk = 2, jpk                      ! deeper value 
     833         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
     834         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
     835         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
    862836      END DO 
    863837      ! 
Note: See TracChangeset for help on using the changeset viewer.