[4738] | 1 | MODULE utils |
---|
| 2 | |
---|
| 3 | USE netcdf |
---|
| 4 | |
---|
| 5 | IMPLICIT NONE |
---|
| 6 | PUBLIC |
---|
| 7 | |
---|
[4739] | 8 | INTEGER, PUBLIC, PARAMETER :: dp=8 , sp=4, wp=dp |
---|
[4738] | 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 |
---|
[4739] | 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 |
---|
[4738] | 23 | |
---|
| 24 | INTEGER,PARAMETER :: numout = 6 |
---|
| 25 | INTEGER,PARAMETER :: numerr = 0 |
---|
| 26 | INTEGER,PARAMETER :: numnam = 11 |
---|
[4739] | 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. |
---|
[4738] | 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. |
---|
[4739] | 45 | LOGICAL :: ln_old_31_lev_code = .false. |
---|
[4738] | 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, & |
---|
[4739] | 50 | ln_med_red_seas, ln_old_31_lev_code, ln_coast, & |
---|
| 51 | ln_zero_top_layer, ln_custom, & |
---|
[4738] | 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 | |
---|
[4739] | 111 | CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) ) |
---|
[4738] | 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 |
---|