source: branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90 @ 4738

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

Modified tra_dmp module to read in restoration coefficient from a netcdf file

Added a tool to create the netcdf file - this replaces all of the hard coded resolution dependencies in tra_dmp_init

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