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

Last change on this file since 10197 was 4739, checked in by timgraham, 7 years ago

Updated C1D/dyndmp.F90 and trcdmp.F90 to read restoration coefficient from a file.
Modified namelist_top_ref to match new options
Bug fixes to DMP_TOOLS tool and addition of custom.F90 to allow users to make modifications. Also changed to use working precision (wp) throughout.

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
49  NAMELIST/nam_dmp_create/cp_cfg, cp_cfz, jp_cfg, lzoom, ln_full_field, &
50                          ln_med_red_seas, ln_old_31_lev_code, ln_coast, &
51                          ln_zero_top_layer, ln_custom, &
52                          pn_surf, pn_bot, pn_dep, nn_hdmp, jperio
53
54  CONTAINS
55
56  SUBROUTINE grid_info(mesh)
57     CHARACTER(LEN=*),INTENT(in) :: mesh
58
59     ! Open meshfile
60     CALL check_nf90( nf90_open(mesh, NF90_NOWRITE, ncin), 'Error opening mesh_mask file' )
61 
62     ! Get size of grid from meshfile
63     CALL dimlen( ncin, 'x', jpi )
64     CALL dimlen( ncin, 'y', jpj )
65     CALL dimlen( ncin, 'z', jpk )
66
67     ALLOCATE( tmask(jpi, jpj), gdept(jpi, jpj), gphit(jpi,jpj) )
68
69     !Get ID of tmask in meshfile
70     CALL check_nf90( nf90_inq_varid( ncin, 'tmask', tmask_id ), 'Cannot get variable ID for tmask')
71     CALL check_nf90( nf90_inq_varid( ncin, 'umask', umask_id ), 'Cannot get variable ID for umask')
72     CALL check_nf90( nf90_inq_varid( ncin, 'vmask', vmask_id ), 'Cannot get variable ID for vmask')
73     CALL check_nf90( nf90_inq_varid( ncin, 'fmask', fmask_id ), 'Cannot get variable ID for fmask')
74     CALL check_nf90( nf90_inq_varid( ncin, 'gdept_0', gdept_id ), 'Cannot get variable ID for gdept_0')
75     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', gphit_id ), 'Cannot get variable ID for gphit')
76     CALL check_nf90( nf90_inq_varid( ncin, 'gphiu', gphiu_id ), 'Cannot get variable ID for gphiu')
77     CALL check_nf90( nf90_inq_varid( ncin, 'gphiv', gphiv_id ), 'Cannot get variable ID for gphiv')
78     CALL check_nf90( nf90_inq_varid( ncin, 'gphif', gphif_id ), 'Cannot get variable ID for gphif')
79     CALL check_nf90( nf90_inq_varid( ncin, 'glamt', glamt_id ), 'Cannot get variable ID for glamt')
80     CALL check_nf90( nf90_inq_varid( ncin, 'glamu', glamu_id ), 'Cannot get variable ID for glamu')
81     CALL check_nf90( nf90_inq_varid( ncin, 'glamv', glamv_id ), 'Cannot get variable ID for glamv')
82     CALL check_nf90( nf90_inq_varid( ncin, 'glamf', glamf_id ), 'Cannot get variable ID for glamf')
83 
84  END SUBROUTINE grid_info
85
86  SUBROUTINE dimlen( ncid, dimname, len )
87     ! Determine the length of dimension dimname
88     INTEGER, INTENT(in)          :: ncid
89     CHARACTER(LEN=*), INTENT(in) :: dimname
90     INTEGER, INTENT(out)         :: len
91     ! Local variables
92     INTEGER :: id_var, istatus
93
94     id_var = 1
95     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
96     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
97
98  END SUBROUTINE dimlen
99
100  SUBROUTINE make_outfile( filename )
101     ! Create the output file
102     ! Define dimensions and resto variable
103     CHARACTER(LEN=*), INTENT(in) :: filename
104     INTEGER :: id_x, id_y, id_z
105
106     CALL check_nf90( nf90_create(filename, NF90_CLOBBER, ncout), 'Could not create output file')
107     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
108     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
109     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
110
111     CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) )
112     CALL check_nf90( nf90_enddef(ncout) )
113
114  END SUBROUTINE make_outfile
115
116
117  SUBROUTINE check_nf90( istat, message )
118     !Check for netcdf errors
119     INTEGER, INTENT(in) :: istat
120     CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
121     
122     IF (istat /= nf90_noerr) THEN
123        WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
124        IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF
125        STOP
126     ENDIF
127
128  END SUBROUTINE check_nf90
129
130END MODULE utils
Note: See TracBrowser for help on using the repository browser.