1 | MODULE 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 | |
---|
127 | END MODULE utils |
---|