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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/vgrid.f90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/vgrid.f90

    r4213 r6225  
    66! 
    77! DESCRIPTION: 
    8 !> @brief vertical grid manager <br/> 
     8!> @brief This module manage vertical grid. 
    99!> 
    1010!> @details 
     11!>    to set the depth of model levels and the resulting vertical scale 
     12!> factors:<br/> 
     13!> @code 
     14!>    CALL vgrid_zgr_z(dd_gdepw(:), dd_gdept(:), dd_e3w(:), dd_e3t(:),  
     15!>                     dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,  
     16!>                     dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed,  
     17!>                     dd_ppa0, dd_ppa1, dd_ppa2, dd_ppsur) 
     18!> @endcode 
     19!>       - dd_gdepw is array of depth value on W point 
     20!>       - dd_gdept is array of depth value on T point 
     21!>       - dd_e3w   is array of vertical mesh size on W point 
     22!>       - dd_e3t   is array of vertical mesh size on T point 
     23!>       - dd_ppkth              see NEMO documentation 
     24!>       - dd_ppkth2             see NEMO documentation 
     25!>       - dd_ppacr              see NEMO documentation 
     26!>       - dd_ppdzmin            see NEMO documentation 
     27!>       - dd_pphmax             see NEMO documentation 
     28!>       - dd_pp_to_be_computed  see NEMO documentation 
     29!>       - dd_ppa1               see NEMO documentation 
     30!>       - dd_ppa2               see NEMO documentation 
     31!>       - dd_ppa0               see NEMO documentation 
     32!>       - dd_ppsur              see NEMO documentation 
     33!>     
    1134!>  
     35!>    to set the depth and vertical scale factor in partial step z-coordinate 
     36!>  case:<br/> 
     37!> @code 
     38!>    CALL vgrid_zgr_zps(id_mbathy(:,:), dd_bathy(:,:), id_jpkmax, dd_gdepw(:),  
     39!>                       dd_e3t(:), dd_e3zps_min, dd_e3zps_rat) 
     40!> @endcode 
     41!>       - id_mbathy is array of bathymetry level 
     42!>       - dd_bathy  is array of bathymetry 
     43!>       - id_jpkmax is the maximum number of level to be used 
     44!>       - dd_gdepw  is array of vertical mesh size on W point 
     45!>       - dd_e3t    is array of vertical mesh size on T point 
     46!>       - dd_e3zps_min    see NEMO documentation 
     47!>       - dd_e3zps_rat    see NEMO documentation 
     48!> 
     49!>    to check the bathymetry in levels:<br/> 
     50!> @code 
     51!>    CALL vgrid_zgr_bat_ctl(id_mbathy, id_jpkmax, id_jpk) 
     52!> @endcode 
     53!>       - id_mbathy is array of bathymetry level 
     54!>       - id_jpkmax is the maximum number of level to be used 
     55!>       - id_jpk    is the number of level 
     56!>    
     57!>    to compute bathy level in T,U,V,F point from  Bathymetry file:<br/> 
     58!> @code 
     59!>    tl_level(:)=vgrid_get_level(td_bathy, [cd_namelist,] [td_dom,] [id_nlevel]) 
     60!> @endcode 
     61!>       - td_bathy is Bathymetry file structure 
     62!>       - cd_namelist is namelist [optional] 
     63!>       - td_dom is domain structure [optional] 
     64!>       - id_nlevel is number of lelvel to be used [optional] 
     65!>     
    1266!> @author 
    1367!> J.Paul 
    1468! REVISION HISTORY: 
    15 !> @date Nov, 2013 - Initial Version 
    16 ! 
     69!> @date November, 2013 - Initial Version 
     70!> @date Spetember, 2014 
     71!> - add header 
     72!> @date June, 2015 - update subroutine with NEMO 3.6 
     73!> 
    1774!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    18 !> @todo 
    1975!---------------------------------------------------------------------- 
    2076MODULE vgrid 
    21    USE netcdf 
     77   USE netcdf                          ! nf90 library 
    2278   USE kind                            ! F90 kind parameter 
    2379   USE fct                             ! basic usefull function 
    2480   USE global                          ! global parameter 
    2581   USE phycst                          ! physical constant 
    26    USE logger                             ! log file manager 
     82   USE logger                          ! log file manager 
    2783   USE file                            ! file manager 
    2884   USE var                             ! variable manager 
    2985   USE dim                             ! dimension manager 
    3086   USE dom                             ! domain manager 
     87   USE grid                            ! grid manager 
    3188   USE iom                             ! I/O manager 
    3289   USE mpp                             ! MPP manager 
    3390   USE iom_mpp                         ! I/O MPP manager 
    3491   IMPLICIT NONE 
    35    PRIVATE 
    3692   ! NOTE_avoid_public_variables_if_possible 
    3793 
    … …  
    4399   PUBLIC :: vgrid_zgr_bat_ctl 
    44100   PUBLIC :: vgrid_get_level 
    45  
    46 !   PRIVATE ::  
    47  
    48101 
    49102CONTAINS 
    … …  
    66119   !> 
    67120   !> @author G. Madec 
    68    !> - 03,08-  G. Madec: F90: Free form and module 
     121   !> @date Marsh,2008 - F90: Free form and module 
    69122   ! 
    70123   !> @note Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 
    … …  
    86139   !> @param[in] dd_ppsur 
    87140   !------------------------------------------------------------------- 
    88    !> @code 
    89141   SUBROUTINE vgrid_zgr_z( dd_gdepw, dd_gdept, dd_e3w, dd_e3t,          & 
     142   &                       dd_e3w_1d, dd_e3t_1d, & 
    90143   &                       dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,    & 
    91144   &                       dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed, & 
    … …  
    97150      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w 
    98151      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t 
     152      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w_1d 
     153      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t_1d 
    99154 
    100155      REAL(dp)              , INTENT(IN   ) :: dd_ppkth 
    … …  
    175230         DO jk = 1, il_jpk 
    176231            dl_zw = REAL(jk,dp) 
    177             dl_zt = REAL(jk,dp) + 0.5 
     232            dl_zt = REAL(jk,dp) + 0.5_dp 
    178233            dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1 
    179234            dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1 
    … …  
    186241         DO jk = 1, il_jpk 
    187242            dl_zw = REAL( jk,dp) 
    188             dl_zt = REAL( jk,dp) + 0.5 
     243            dl_zt = REAL( jk,dp) + 0.5_dp 
    189244            dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + & 
    190245            &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + & 
    … …  
    204259      ENDIF 
    205260 
     261   ! need to be like this to compute the pressure gradient with ISF. 
     262   ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth) 
     263   ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively 
     264      DO jk = 1, il_jpk-1 
     265         dd_e3t_1d(jk) = dd_gdepw(jk+1)-dd_gdepw(jk)  
     266      END DO 
     267      dd_e3t_1d(il_jpk) = dd_e3t_1d(il_jpk-1) ! we don't care because this level is masked in NEMO 
     268 
     269      DO jk = 2, il_jpk 
     270         dd_e3w_1d(jk) = dd_gdept(jk) - dd_gdept(jk-1)  
     271      END DO 
     272      dd_e3w_1d(1  ) = 2._dp * (dd_gdept(1) - dd_gdepw(1)) 
     273 
    206274      ! Control and  print 
    207275      ! ================== 
    … …  
    209277      DO jk = 1, il_jpk 
    210278         IF( dd_e3w(jk)  <= 0. .OR. dd_e3t(jk)  <= 0. )then 
    211             CALL logger_debug("VGRID ZGR Z: e3w or e3t =< 0 ") 
     279            CALL logger_debug("VGRID ZGR Z: e3w or e3t <= 0 ") 
    212280         ENDIF    
     281 
     282         IF( dd_e3w_1d(jk)  <= 0. .OR. dd_e3t_1d(jk)  <= 0. )then 
     283            CALL logger_debug("VGRID ZGR Z: e3w_1d or e3t_1d <= 0 ") 
     284         ENDIF 
    213285 
    214286         IF( dd_gdepw(jk) < 0. .OR. dd_gdept(jk) < 0. )then 
    … …  
    218290 
    219291   END SUBROUTINE vgrid_zgr_z 
    220    !> @endcode 
     292   !------------------------------------------------------------------- 
     293   !------------------------------------------------------------------- 
     294   SUBROUTINE vgrid_zgr_bat( dd_bathy, dd_gdepw, dd_hmin, dd_fill ) 
     295      IMPLICIT NONE 
     296      ! Argument 
     297      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_bathy  
     298      REAL(dp), DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw  
     299      REAL(dp)                , INTENT(IN   ) :: dd_hmin 
     300      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill 
     301 
     302      ! local 
     303      INTEGER(i4) :: il_jpk 
     304       
     305      REAL(dp)    :: dl_hmin 
     306      REAL(dp)    :: dl_fill 
     307 
     308      ! loop indices 
     309      INTEGER(i4) :: jk 
     310      !---------------------------------------------------------------- 
     311      il_jpk = SIZE(dd_gdepw(:)) 
     312 
     313      dl_fill=0._dp 
     314      IF( PRESENT(dd_fill) ) dl_fill=dd_fill 
     315 
     316      IF( dd_hmin < 0._dp ) THEN 
     317         jk = - INT( dd_hmin )     ! from a nb of level 
     318      ELSE 
     319         jk = MINLOC( dd_gdepw, mask = dd_gdepw > dd_hmin, dim = 1 )  ! from a depth 
     320      ENDIF 
     321       
     322      dl_hmin = dd_gdepw(jk+1) ! minimum depth = ik+1 w-levels  
     323      WHERE( dd_bathy(:,:) <= 0._wp .OR. dd_bathy(:,:) == dl_fill ) 
     324         dd_bathy(:,:) = dl_fill                         ! min=0     over the lands 
     325      ELSE WHERE 
     326         dd_bathy(:,:) = MAX(  dl_hmin , dd_bathy(:,:)  )   ! min=dl_hmin over the oceans 
     327      END WHERE 
     328      WRITE(*,*) 'Minimum ocean depth: ', dl_hmin, ' minimum number of ocean levels : ', jk       
     329 
     330   END SUBROUTINE vgrid_zgr_bat 
    221331   !------------------------------------------------------------------- 
    222332   !> @brief This subroutine set the depth and vertical scale factor in partial step 
    … …  
    231341   !>      function the derivative of which gives the reference vertical 
    232342   !>      scale factors. 
    233    !>        From  depth and scale factors reference, we compute there new value 
     343   !>      From  depth and scale factors reference, we compute there new value 
    234344   !>      with partial steps  on 3d arrays ( i, j, k ). 
    235345   !> 
    236    !>              w-level: gdepw_ps(i,j,k)  = fsdep(k) 
    237    !>                       e3w_ps(i,j,k) = dk(fsdep)(k)     = fse3(i,j,k) 
    238    !>              t-level: gdept_ps(i,j,k)  = fsdep(k+0.5) 
    239    !>                       e3t_ps(i,j,k) = dk(fsdep)(k+0.5) = fse3(i,j,k+0.5) 
    240    !> 
    241    !>        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc), 
     346   !>      w-level:  
     347   !>          - gdepw_ps(i,j,k)  = fsdep(k) 
     348   !>          - e3w_ps(i,j,k) = dk(fsdep)(k)     = fse3(i,j,k) 
     349   !>      t-level:  
     350   !>          - gdept_ps(i,j,k)  = fsdep(k+0.5) 
     351   !>          - e3t_ps(i,j,k) = dk(fsdep)(k+0.5) = fse3(i,j,k+0.5) 
     352   !> 
     353   !>      With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc), 
    242354   !>      we find the mbathy index of the depth at each grid point. 
    243355   !>      This leads us to three cases: 
    244    !> 
    245    !>              - bathy = 0 => mbathy = 0 
    246    !>              - 1 < mbathy < jpkm1     
    247    !>              - bathy > gdepw(jpk) => mbathy = jpkm1   
    248    !> 
    249    !>        Then, for each case, we find the new depth at t- and w- levels 
     356   !>          - bathy = 0 => mbathy = 0 
     357   !>          - 1 < mbathy < jpkm1     
     358   !>          - bathy > gdepw(jpk) => mbathy = jpkm1   
     359   !> 
     360   !>      Then, for each case, we find the new depth at t- and w- levels 
    250361   !>      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw-  
    251362   !>      and f-points. 
    … …  
    257368   !>      schemes. 
    258369   !> 
    259    !>         c a u t i o n : gdept, gdepw and e3 are positives 
    260    !>         - - - - - - -   gdept_ps, gdepw_ps and e3_ps are positives 
     370   !>  @warning  
     371   !>         - gdept, gdepw and e3 are positives 
     372   !>         - gdept_ps, gdepw_ps and e3_ps are positives 
    261373   ! 
    262374   !> @author A. Bozec, G. Madec 
    263    !> - 02-09 (A. Bozec, G. Madec) F90: Free form and module 
    264    !> - 02-09 (A. de Miranda)  rigid-lid + islands 
     375   !> @date February, 2009 - F90: Free form and module 
     376   !> @date February, 2009  
     377   !> - A. de Miranda : rigid-lid + islands 
    265378   !> 
    266379   !> @note Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 
    … …  
    274387   !> @param[in] dd_e3zps_rat 
    275388   !------------------------------------------------------------------- 
    276    !> @code 
    277389   SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, & 
    278    &                         dd_gdepw, dd_e3t,               & 
    279    &                         dd_e3zps_min, dd_e3zps_rat ) 
     390   &                          dd_gdepw, dd_e3t,               & 
     391   &                          dd_e3zps_min, dd_e3zps_rat,     & 
     392   &                          dd_fill ) 
    280393      IMPLICIT NONE 
    281394      ! Argument       
    … …  
    285398      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw 
    286399      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t 
    287       REAL(dp)                                   :: dd_e3zps_min 
    288       REAL(dp)                                   :: dd_e3zps_rat 
     400      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min 
     401      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat 
     402      REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill 
    289403 
    290404      ! local variable 
    291405      REAL(dp) :: dl_zmax     ! Maximum depth 
    292       REAL(dp) :: dl_zmin     ! Minimum depth 
     406      !REAL(dp) :: dl_zmin     ! Minimum depth 
    293407      REAL(dp) :: dl_zdepth   ! Ajusted ocean depth to avoid too small e3t  
     408      REAL(dp) :: dl_fill      
    294409 
    295410      INTEGER(i4) :: il_jpk 
    … …  
    308423      il_jpjglo=SIZE(id_mbathy(:,:),DIM=2) 
    309424 
     425      dl_fill=0._dp 
     426      IF( PRESENT(dd_fill) ) dl_fill=dd_fill 
     427 
    310428      ! Initialization of constant 
    311       dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) 
    312       dl_zmin = dd_gdepw(4) 
     429      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) ) 
     430 
     431      ! bounded value of bathy (min already set at the end of zgr_bat) 
     432      WHERE( dd_bathy(:,:) /= dl_fill ) 
     433         dd_bathy(:,:) = MIN( dl_zmax ,  dd_bathy(:,:) ) 
     434      END WHERE 
    313435 
    314436      ! bathymetry in level (from bathy_meter) 
    … …  
    321443      DO jj = 1, il_jpjglo 
    322444         DO ji= 1, il_jpiglo 
    323             IF( dd_bathy(ji,jj) <= 0. )   id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4) 
    324          END DO 
    325       END DO 
    326  
    327       ! bounded value of bathy 
    328       ! minimum depth == 3 levels 
    329       ! maximum depth == gdepw(jpk)+e3t(jpk)  
    330       ! i.e. the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk) 
    331       DO jj = 1, il_jpjglo 
    332          DO ji= 1, il_jpiglo 
    333             IF( dd_bathy(ji,jj) <= 0. ) THEN 
    334                dd_bathy(ji,jj) = 0.e0 
    335             ELSE 
    336                dd_bathy(ji,jj) = MAX( dd_bathy(ji,jj), dl_zmin ) 
    337                dd_bathy(ji,jj) = MIN( dd_bathy(ji,jj), dl_zmax ) 
     445            IF( dd_bathy(ji,jj) <= 0._dp )THEN 
     446               id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4) 
     447            ELSEIF( dd_bathy(ji,jj) == dl_fill )THEN 
     448               id_mbathy(ji,jj) = 0_i4 
    338449            ENDIF 
    339450         END DO 
    … …  
    350461         DO jj = 1, il_jpjglo 
    351462            DO ji = 1, il_jpiglo 
    352                IF( 0. < dd_bathy(ji,jj) .AND. dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1 
     463               IF( dd_bathy(ji,jj) /= dl_fill )THEN 
     464                  IF( 0. < dd_bathy(ji,jj) .AND. & 
     465                  &       dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1 
     466               ENDIF 
    353467            END DO 
    354468         END DO 
    … …  
    362476 
    363477   END SUBROUTINE vgrid_zgr_zps 
    364    !> @endcode 
    365478   !------------------------------------------------------------------- 
    366479   !> @brief This subroutine check the bathymetry in levels  
    … …  
    384497 
    385498   !> @author G.Madec 
    386    !> - 03-08 Original code 
     499   !> @date Marsh, 2008 - Original code 
    387500   ! 
    388    !> @param[in]  
    389    !------------------------------------------------------------------- 
    390    !> @code 
     501   !> @param[in] id_mbathy  
     502   !> @param[in] id_jpkmax 
     503   !> @param[in] id_jpk 
     504   !------------------------------------------------------------------- 
    391505   SUBROUTINE vgrid_zgr_bat_ctl( id_mbathy, id_jpkmax, id_jpk) 
    392506      IMPLICIT NONE 
    … …  
    477591 
    478592   END SUBROUTINE vgrid_zgr_bat_ctl 
    479    !> @endcode 
    480    !------------------------------------------------------------------- 
    481    !> @brief This function  
     593   !------------------------------------------------------------------- 
     594   !> @brief This function compute bathy level in T,U,V,F point, and return  
     595   !> them as array of variable structure 
    482596   ! 
    483597   !> @details 
     598   !> Bathymetry is read on Bathymetry file, then bathy level is computed  
     599   !> on T point, and finally fit to U,V,F point. 
     600   !> 
     601   !> you could specify :<br/> 
     602   !> - namelist where find parameter to set the depth of model levels 
     603   !> (default use GLORYS 75 levels parameters) 
     604   !> - domain structure to specify on e area to work on 
     605   !> - number of level to be used 
     606   !> 
     607   !> @author J.Paul 
     608   !> @date November, 2013 - Initial Version 
    484609   ! 
    485    !> @author J.Paul 
    486    !> - Nov, 2013- Initial Version 
    487    ! 
    488    !> @param[in]  
    489    !------------------------------------------------------------------- 
    490    !> @code 
     610   !> @param[in] td_bathy     Bathymetry file structure  
     611   !> @param[in] cd_namelist  namelist  
     612   !> @param[in] td_dom       domain structure 
     613   !> @param[in] id_nlevel    number of lelvel to be used  
     614   !> @return array of level on T,U,V,F point (variable structure) 
     615   !------------------------------------------------------------------- 
    491616   FUNCTION vgrid_get_level(td_bathy, cd_namelist, td_dom, id_nlevel) 
    492617      IMPLICIT NONE 
    493618      ! Argument 
    494       TYPE(TFILE)     , INTENT(IN) :: td_bathy 
    495       CHARACTER(LEN=*), INTENT(IN) :: cd_namelist 
     619      TYPE(TMPP)      , INTENT(IN) :: td_bathy 
     620      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_namelist 
    496621      TYPE(TDOM)      , INTENT(IN), OPTIONAL :: td_dom 
    497622      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_nlevel 
    498623 
    499624      ! function 
    500       TYPE(TVAR), DIMENSION(ig_npoint) :: vgrid_get_level 
     625      TYPE(TVAR), DIMENSION(ip_npoint) :: vgrid_get_level 
    501626 
    502627      ! local variable 
    503       TYPE(TFILE) :: tl_bathy 
    504       TYPE(TMPP)  :: tl_mppbathy 
    505  
    506       TYPE(TDOM)  :: tl_dom 
    507  
    508       TYPE(TVAR)  :: tl_var 
    509       TYPE(TVAR) , DIMENSION(ig_npoint)            :: tl_level 
    510  
    511       TYPE(TDIM) , DIMENSION(ip_maxdim)            :: tl_dim 
    512  
    513628      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_gdepw  
    514629      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_gdept  
    515630      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w  
    516631      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t 
     632      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w_1d  
     633      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t_1d 
    517634 
    518635      INTEGER(i4)                                  :: il_status 
    519636      INTEGER(i4)                                  :: il_fileid 
    520637      INTEGER(i4)                                  :: il_jpkmax 
     638      INTEGER(i4), DIMENSION(2,2)                  :: il_xghost 
    521639      INTEGER(i4), DIMENSION(:,:)    , ALLOCATABLE :: il_mbathy 
    522640      INTEGER(i4), DIMENSION(:,:,:,:), ALLOCATABLE :: il_level 
    523641       
    524642      LOGICAL                                      :: ll_exist 
     643 
     644      TYPE(TDIM) , DIMENSION(ip_maxdim)            :: tl_dim 
     645 
     646      TYPE(TDOM)                                   :: tl_dom 
     647 
     648      TYPE(TVAR)                                   :: tl_var 
     649 
     650      TYPE(TMPP)                                   :: tl_bathy 
    525651 
    526652      ! loop indices 
    … …  
    567693      !---------------------------------------------------------------- 
    568694 
    569       !1- read namelist 
    570       INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist) 
    571       IF( ll_exist )THEN 
     695      IF( PRESENT(cd_namelist) )THEN 
     696         !1- read namelist 
     697         INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist) 
     698         IF( ll_exist )THEN 
    572699  
    573          il_fileid=fct_getunit() 
    574  
    575          OPEN( il_fileid, FILE=TRIM(cd_namelist), & 
    576          &                FORM='FORMATTED',       & 
    577          &                ACCESS='SEQUENTIAL',    & 
    578          &                STATUS='OLD',           & 
    579          &                ACTION='READ',          & 
    580          &                IOSTAT=il_status) 
    581          CALL fct_err(il_status) 
    582          IF( il_status /= 0 )THEN 
    583             CALL logger_fatal("VGRID GET LEVEL: ERROR opening "//TRIM(cd_namelist)) 
     700            il_fileid=fct_getunit() 
     701 
     702            OPEN( il_fileid, FILE=TRIM(cd_namelist), & 
     703            &                FORM='FORMATTED',       & 
     704            &                ACCESS='SEQUENTIAL',    & 
     705            &                STATUS='OLD',           & 
     706            &                ACTION='READ',          & 
     707            &                IOSTAT=il_status) 
     708            CALL fct_err(il_status) 
     709            IF( il_status /= 0 )THEN 
     710               CALL logger_fatal("VGRID GET LEVEL: ERROR opening "//& 
     711               &  TRIM(cd_namelist)) 
     712            ENDIF 
     713 
     714            READ( il_fileid, NML = namzgr ) 
     715            READ( il_fileid, NML = namzps ) 
     716 
     717            CLOSE( il_fileid, IOSTAT=il_status ) 
     718            CALL fct_err(il_status) 
     719            IF( il_status /= 0 )THEN 
     720               CALL logger_error("VGRID GET LEVELL: ERROR closing "//& 
     721               &  TRIM(cd_namelist)) 
     722            ENDIF 
     723 
     724         ELSE 
     725 
     726            CALL logger_fatal("VGRID GET LEVEL: ERROR. can not find "//& 
     727            &  TRIM(cd_namelist)) 
     728 
    584729         ENDIF 
    585  
    586          READ( il_fileid, NML = namzgr ) 
    587          READ( il_fileid, NML = namzps ) 
    588  
    589          CLOSE( il_fileid, IOSTAT=il_status ) 
    590          CALL fct_err(il_status) 
    591          IF( il_status /= 0 )THEN 
    592             CALL logger_error("VGRID GET LEVELL: ERROR closing "//TRIM(cd_namelist)) 
    593          ENDIF 
    594  
     730      ENDIF 
     731 
     732      ! copy structure 
     733      tl_bathy=mpp_copy(td_bathy) 
     734 
     735      ! get domain 
     736      IF( PRESENT(td_dom) )THEN 
     737         tl_dom=dom_copy(td_dom) 
    595738      ELSE 
    596  
    597          CALL logger_fatal("VGRID GET LEVEL: ERROR. can not find "//TRIM(cd_namelist)) 
    598  
    599       ENDIF 
    600  
    601       !2- open files 
    602       tl_bathy=td_bathy 
    603       !2-1 get domain 
    604       IF( PRESENT(td_dom) )THEN 
    605          tl_dom=td_dom 
    606       ELSE 
    607          CALL iom_open(tl_bathy) 
    608  
    609739         CALL logger_debug("VGRID GET LEVEL: get dom from "//& 
    610740         &  TRIM(tl_bathy%c_name)) 
    611741         tl_dom=dom_init(tl_bathy) 
    612  
    613          CALL iom_close(tl_bathy) 
    614742      ENDIF 
    615743 
    616       !2-2 open mpp  
    617       tl_mppbathy=mpp_init(tl_bathy) 
    618       CALL file_clean(tl_bathy) 
    619  
    620       !2-3 get processor to be used 
    621       CALL mpp_get_use( tl_mppbathy, tl_dom ) 
    622  
    623       !2-4 open mpp files 
    624       CALL iom_mpp_open(tl_mppbathy) 
    625  
    626       !3- check namelist 
     744      ! get ghoste cell 
     745      il_xghost(:,:)=grid_get_ghost(tl_bathy) 
     746 
     747      ! open mpp files 
     748      CALL iom_dom_open(tl_bathy, tl_dom) 
     749 
     750      ! check namelist 
    627751      IF( PRESENT(id_nlevel) ) in_nlevel=id_nlevel 
    628752      IF( in_nlevel == 0 )THEN 
    … …  
    631755      ENDIF 
    632756 
    633       !4- read bathymetry 
    634       tl_var=iom_mpp_read_var(tl_mppbathy,'bathymetry',td_dom=tl_dom) 
    635  
     757      ! read bathymetry 
     758      tl_var=iom_dom_read_var(tl_bathy,'bathymetry',tl_dom) 
     759      ! clean 
     760      CALL dom_clean(tl_dom) 
     761 
     762      ! remove ghost cell 
     763      CALL grid_del_ghost(tl_var, il_xghost(:,:)) 
     764 
     765      ! force _FillValue (land) to be 0 
    636766      WHERE( tl_var%d_value(:,:,1,1) == tl_var%d_fill ) 
    637767         tl_var%d_value(:,:,1,1)=0 
    638768      END WHERE 
    639769 
    640       !5 clean 
    641       CALL iom_mpp_close(tl_mppbathy) 
    642       CALL mpp_clean(tl_mppbathy) 
    643  
    644       !5- compute vertical grid 
     770      ! clean 
     771      CALL iom_dom_close(tl_bathy) 
     772      CALL mpp_clean(tl_bathy) 
     773 
     774      ! compute vertical grid 
    645775      ALLOCATE( dl_gdepw(in_nlevel), dl_gdept(in_nlevel) )  
    646776      ALLOCATE(   dl_e3w(in_nlevel),   dl_e3t(in_nlevel) )  
     777      ALLOCATE(   dl_e3w_1d(in_nlevel),   dl_e3t_1d(in_nlevel) )  
    647778      CALL vgrid_zgr_z( dl_gdepw(:), dl_gdept(:), dl_e3w(:), dl_e3t(:), & 
     779      &                 dl_e3w_1d, dl_e3t_1d, & 
    648780      &                 dn_ppkth, dn_ppkth2, dn_ppacr, dn_ppacr2,       & 
    649781      &                 dn_ppdzmin, dn_pphmax, dn_pp_to_be_computed,    & 
    650782      &                 dn_ppa0, dn_ppa1, dn_ppa2, dn_ppsur ) 
    651783 
    652       !6- compute bathy level on T point 
     784      ! compute bathy level on T point 
    653785      ALLOCATE( il_mbathy(tl_var%t_dim(1)%i_len, & 
    654786      &                   tl_var%t_dim(2)%i_len ) ) 
    … …  
    660792      DEALLOCATE(   dl_e3w,   dl_e3t ) 
    661793 
    662       !7- compute bathy level in T,U,V,F point 
     794      ! compute bathy level in T,U,V,F point 
    663795      ALLOCATE( il_level(tl_var%t_dim(1)%i_len, & 
    664796      &                  tl_var%t_dim(2)%i_len, & 
    665       &                  ig_npoint,1) ) 
     797      &                  ip_npoint,1) ) 
    666798 
    667799      DO jj=1,tl_var%t_dim(2)%i_len 
    … …  
    686818      DEALLOCATE( il_mbathy ) 
    687819 
    688       tl_dim(:)=tl_var%t_dim(:) 
     820      tl_dim(:)=dim_copy(tl_var%t_dim(:)) 
     821      ! clean 
    689822      CALL var_clean(tl_var) 
    690823 
    … …  
    692825      tl_dim(3:4)%l_use=.FALSE. 
    693826 
    694       tl_level(jp_T)=var_init('tlevel',il_level(:,:,jp_T:jp_T,:),td_dim=tl_dim(:)) 
    695       tl_level(jp_U)=var_init('ulevel',il_level(:,:,jp_U:jp_U,:),td_dim=tl_dim(:)) 
    696       tl_level(jp_V)=var_init('vlevel',il_level(:,:,jp_V:jp_V,:),td_dim=tl_dim(:)) 
    697       tl_level(jp_F)=var_init('flevel',il_level(:,:,jp_F:jp_F,:),td_dim=tl_dim(:)) 
     827      vgrid_get_level(jp_T)=var_init( 'tlevel', il_level(:,:,jp_T:jp_T,:), & 
     828      &                                td_dim=tl_dim(:) ) 
     829      vgrid_get_level(jp_U)=var_init( 'ulevel', il_level(:,:,jp_U:jp_U,:), & 
     830      &                                td_dim=tl_dim(:)) 
     831      vgrid_get_level(jp_V)=var_init( 'vlevel', il_level(:,:,jp_V:jp_V,:), & 
     832      &                                td_dim=tl_dim(:)) 
     833      vgrid_get_level(jp_F)=var_init( 'flevel', il_level(:,:,jp_F:jp_F,:), & 
     834      &                                td_dim=tl_dim(:)) 
    698835 
    699836      DEALLOCATE( il_level ) 
    700837 
    701       ! save result 
    702       vgrid_get_level(:)=tl_level(:) 
    703  
    704       DO ji=1,ig_npoint 
    705          CALL var_clean(tl_level(ji)) 
    706       ENDDO 
     838      CALL grid_add_ghost( vgrid_get_level(jp_T), il_xghost(:,:) ) 
     839      CALL grid_add_ghost( vgrid_get_level(jp_U), il_xghost(:,:) ) 
     840      CALL grid_add_ghost( vgrid_get_level(jp_V), il_xghost(:,:) ) 
     841      CALL grid_add_ghost( vgrid_get_level(jp_F), il_xghost(:,:) ) 
     842 
     843      ! clean 
     844      CALL dim_clean(tl_dim(:)) 
    707845 
    708846   END FUNCTION vgrid_get_level 
    709    !> @endcode 
    710 !   !------------------------------------------------------------------- 
    711 !   !> @brief This function  
    712 !   ! 
    713 !   !> @details 
    714 !   ! 
    715 !   !> @author J.Paul 
    716 !   !> - Nov, 2013- Initial Version 
    717 !   ! 
    718 !   !> @param[in]  
    719 !   !------------------------------------------------------------------- 
    720 !   !> @code 
    721 !   FUNCTION vgrid_() 
    722 !      IMPLICIT NONE 
    723 !      ! Argument       
    724 !      ! function 
    725 !      ! local variable 
    726 !      ! loop indices 
    727 !      !---------------------------------------------------------------- 
    728 ! 
    729 !   END FUNCTION vgrid_ 
    730 !   !> @endcode 
    731 !   !------------------------------------------------------------------- 
    732 !   !> @brief This subroutine  
    733 !   ! 
    734 !   !> @details 
    735 !   ! 
    736 !   !> @author J.Paul 
    737 !   !> - Nov, 2013- Initial Version 
    738 !   ! 
    739 !   !> @param[in]  
    740 !   !------------------------------------------------------------------- 
    741 !   !> @code 
    742 !   SUBROUTINE vgrid_() 
    743 !      IMPLICIT NONE 
    744 !      ! Argument       
    745 !      ! local variable 
    746 !      ! loop indices 
    747 !      !---------------------------------------------------------------- 
    748 ! 
    749 !   END SUBROUTINE vgrid_ 
    750 !   !> @endcode 
    751847END MODULE vgrid 
    752848 
Note: See TracChangeset for help on using the changeset viewer.