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.
utils.F90 in branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src – NEMO

source: branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90 @ 5255

Last change on this file since 5255 was 5255, checked in by timgraham, 10 years ago

First attempt at making a tool to move Scoord generation offline.
File size: 6.4 KB
Line 
1MODULE utils
2
3   IMPLICIT NONE
4   USE netcdf
5
6   PUBLIC             ! allows the acces to par_oce when dom_oce is used
7   !                  ! exception to coding rules... to be suppressed ???
8
9   PUBLIC dom_oce_alloc
10   PUBLIC read_bathy
11
12
13   !! All coordinates
14   !! ---------------
15   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m)
16   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m)
17   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f
18   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m)
19   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw
20   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m)
21
22   !! s-coordinate and hybrid z-s-coordinate
23   !! =----------------======---------------
24   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsigt, gsigw       !: model level depth coefficient at t-, w-levels (analytic)
25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsi3w              !: model level depth coefficient at w-level (sum of gsigw)
26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   esigt, esigw       !: vertical scale factor coef. at t-, w-levels
27
28   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies
31   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio
35
36   !!----------------------------------------------------------------------
37   !! masks, bathymetry
38   !! ---------------------------------------------------------------------
39   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters - read from file)
41
42   !! Other variables needed by scoord_gen
43   INTEGER  ::   jpi, jpj, jpk            ! Size of the domain - read from bathy or namelist?
44   INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
45   INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
46   INTEGER  ::   ios                      ! Local integer output status for namelist read and allocation
47   REAL(wp) ::   zrmax, ztaper   ! temporary scalars
48   REAL(wp) ::   zrfact
49   !
50   REAL(wp), DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
51   REAL(wp), DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
52
53   NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
54                        rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
55
56
57   INTEGER FUNCTION dom_oce_alloc()
58      !!----------------------------------------------------------------------
59      INTEGER, DIMENSION(12) :: ierr
60      !!----------------------------------------------------------------------
61      ierr(:) = 0
62      !
63      ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), &
64         &      zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj) )
65         !
66      ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         &
67         &      gdept_0 (jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) ,                         &
68         &      gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) )
69         !
70         !
71         !
72      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
73         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
74         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
75         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
76         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) )
77
78      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(9) )
79      !
80      dom_oce_alloc = MAXVAL(ierr)
81      !
82   END FUNCTION dom_oce_alloc
83
84
85   SUBROUTINE read_bathy()
86     !! Read bathymetry from input netcdf file
87     INTEGER :: var_id
88
89     CALL check_nf90( nf90_open('bathy.nc', NF90_NOWRITE, ncin), 'Error opening mesh_mask file' )
90
91     ! Find the size of the input bathymetry
92     CALL dimlen(ncin, 'x', jpi)   
93     CALL dimlen(ncin, 'y', jpj)   
94     
95     ALLOCATE( bathy(jpi, jpj) )
96     
97     ! Read the bathymetry variable from file
98     CALL check_nf90( nf90_inq_varid( ncin, 'bathymetry', tmask_id ), 'Cannot get variable ID for bathymetry')
99     CALL check_nf90( nf90_get_var( ncin, var_id, bathy, (/ 1,1 /), (/ jpi, jpj /) ) )
100
101   END SUBROUTINE read_bathy
102
103   SUBROUTINE dimlen( ncid, dimname, len )
104     ! Determine the length of dimension dimname
105     INTEGER, INTENT(in)          :: ncid
106     CHARACTER(LEN=*), INTENT(in) :: dimname
107     INTEGER, INTENT(out)         :: len
108     ! Local variables
109     INTEGER :: id_var, istatus
110
111     id_var = 1
112     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
113     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
114
115  END SUBROUTINE dimlen
116
117
118   
119   SUBROUTINE write_coord_file()
120
121   END SUBROUTINE write_coord_file
122
123   SUBROUTINE check_nf90( istat, message )
124      !Check for netcdf errors
125      INTEGER, INTENT(in) :: istat
126      CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
127
128      IF (istat /= nf90_noerr) THEN
129         WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
130         IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF
131         STOP
132      ENDIF
133
134   END SUBROUTINE check_nf90
135
136
137END MODULE utils
Note: See TracBrowser for help on using the repository browser.