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/UKMO/dev_r5518_DMP_TOOLS/NEMOGCM/TOOLS/DMP_TOOLS/src – NEMO

source: branches/UKMO/dev_r5518_DMP_TOOLS/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90 @ 10722

Last change on this file since 10722 was 10199, checked in by jenniewaters, 5 years ago

Alllow a distance to coast file to be read in. Also modify code to prevent multiple calculations of the surface distance to coast.

File size: 5.4 KB
Line 
1MODULE utils
2
3  USE netcdf
4
5  IMPLICIT NONE
6  PUBLIC
7 
8  INTEGER, PUBLIC, PARAMETER   :: dp=8 , sp=4, wp=dp
9  INTEGER :: tmask_id, umask_id, vmask_id, fmask_id
10  INTEGER :: gdept_id
11  INTEGER :: gphit_id, gphiv_id, gphiu_id, gphif_id        ! Variable ids
12  INTEGER :: glamt_id, glamv_id, glamu_id, glamf_id        ! Variable ids
13  INTEGER :: resto_id                           ! Variable ID for output
14  INTEGER :: jpi, jpj, jpk                      ! Size of domain
15  INTEGER  :: ncin, ncout                              ! File handles for netCDF files
16  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit, glamt
17  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu, glamu
18  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiv, glamv
19  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphif, glamf
20  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask, umask, vmask, fmask
21  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gdept
22  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: resto
23
24  INTEGER,PARAMETER :: numout = 6
25  INTEGER,PARAMETER :: numerr = 0
26  INTEGER,PARAMETER :: numnam = 11
27  REAL(wp),PARAMETER :: rday = 86400           ! seconds in a day
28  REAL(wp),PARAMETER ::   rpi = 3.141592653589793
29  REAL(wp),PARAMETER ::   rad = 3.141592653589793/180.
30  REAL(wp),PARAMETER ::   ra =  6371229.
31
32  ! Namelist variables
33  CHARACTER(LEN=30) :: cp_cfg = 'ORCA'
34  CHARACTER(LEN=30) :: cp_cfz = 'No zoom'
35  INTEGER :: jp_cfg = 2
36  REAL(KIND=8) :: pn_surf = 1
37  REAL(KIND=8) :: pn_bot = 1
38  REAL(KIND=8) :: pn_dep = 1000         
39  INTEGER  :: nn_hdmp = 0                          ! damping option
40  INTEGER  :: jperio = 0                          ! damping option
41  LOGICAL :: lzoom = .false.
42  LOGICAL :: ln_coast = .false.
43  LOGICAL :: ln_full_field = .true.
44  LOGICAL :: ln_med_red_seas = .false.
45  LOGICAL :: ln_old_31_lev_code = .false.
46  LOGICAL :: ln_zero_top_layer = .false.
47  LOGICAL :: ln_custom = .false.
48  LOGICAL :: ln_readdistcoast = .false.
49
50  NAMELIST/nam_dmp_create/cp_cfg, cp_cfz, jp_cfg, lzoom, ln_full_field, &
51                          ln_med_red_seas, ln_old_31_lev_code, ln_coast, &
52                          ln_zero_top_layer, ln_custom, &
53                          pn_surf, pn_bot, pn_dep, nn_hdmp, jperio, ln_readdistcoast
54
55  CONTAINS
56
57  SUBROUTINE grid_info(mesh)
58     CHARACTER(LEN=*),INTENT(in) :: mesh
59
60     ! Open meshfile
61     CALL check_nf90( nf90_open(mesh, NF90_NOWRITE, ncin), 'Error opening mesh_mask file' )
62 
63     ! Get size of grid from meshfile
64     CALL dimlen( ncin, 'x', jpi )
65     CALL dimlen( ncin, 'y', jpj )
66     CALL dimlen( ncin, 'z', jpk )
67
68     ALLOCATE( tmask(jpi, jpj), gdept(jpi, jpj), gphit(jpi,jpj) )
69
70     !Get ID of tmask in meshfile
71     CALL check_nf90( nf90_inq_varid( ncin, 'tmask', tmask_id ), 'Cannot get variable ID for tmask')
72     CALL check_nf90( nf90_inq_varid( ncin, 'umask', umask_id ), 'Cannot get variable ID for umask')
73     CALL check_nf90( nf90_inq_varid( ncin, 'vmask', vmask_id ), 'Cannot get variable ID for vmask')
74     CALL check_nf90( nf90_inq_varid( ncin, 'fmask', fmask_id ), 'Cannot get variable ID for fmask')
75     CALL check_nf90( nf90_inq_varid( ncin, 'gdept', gdept_id ), 'Cannot get variable ID for gdept_0')
76     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', gphit_id ), 'Cannot get variable ID for gphit')
77     CALL check_nf90( nf90_inq_varid( ncin, 'gphiu', gphiu_id ), 'Cannot get variable ID for gphiu')
78     CALL check_nf90( nf90_inq_varid( ncin, 'gphiv', gphiv_id ), 'Cannot get variable ID for gphiv')
79     CALL check_nf90( nf90_inq_varid( ncin, 'gphif', gphif_id ), 'Cannot get variable ID for gphif')
80     CALL check_nf90( nf90_inq_varid( ncin, 'glamt', glamt_id ), 'Cannot get variable ID for glamt')
81     CALL check_nf90( nf90_inq_varid( ncin, 'glamu', glamu_id ), 'Cannot get variable ID for glamu')
82     CALL check_nf90( nf90_inq_varid( ncin, 'glamv', glamv_id ), 'Cannot get variable ID for glamv')
83     CALL check_nf90( nf90_inq_varid( ncin, 'glamf', glamf_id ), 'Cannot get variable ID for glamf')
84 
85  END SUBROUTINE grid_info
86
87  SUBROUTINE dimlen( ncid, dimname, len )
88     ! Determine the length of dimension dimname
89     INTEGER, INTENT(in)          :: ncid
90     CHARACTER(LEN=*), INTENT(in) :: dimname
91     INTEGER, INTENT(out)         :: len
92     ! Local variables
93     INTEGER :: id_var, istatus
94
95     id_var = 1
96     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
97     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
98
99  END SUBROUTINE dimlen
100
101  SUBROUTINE make_outfile( filename )
102     ! Create the output file
103     ! Define dimensions and resto variable
104     CHARACTER(LEN=*), INTENT(in) :: filename
105     INTEGER :: id_x, id_y, id_z
106
107     CALL check_nf90( nf90_create(filename, NF90_CLOBBER, ncout), 'Could not create output file')
108     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
109     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
110     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
111
112     CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) )
113     CALL check_nf90( nf90_enddef(ncout) )
114
115  END SUBROUTINE make_outfile
116
117
118  SUBROUTINE check_nf90( istat, message )
119     !Check for netcdf errors
120     INTEGER, INTENT(in) :: istat
121     CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
122     
123     IF (istat /= nf90_noerr) THEN
124        WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
125        IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF
126        STOP
127     ENDIF
128
129  END SUBROUTINE check_nf90
130
131END MODULE utils
Note: See TracBrowser for help on using the repository browser.