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