Changeset 5257 for branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90
- Timestamp:
- 2015-05-08T16:18:50+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90
r5255 r5257 1 1 MODULE utils 2 2 3 IMPLICIT NONE4 3 USE netcdf 5 4 5 IMPLICIT NONE 6 6 PUBLIC ! allows the acces to par_oce when dom_oce is used 7 7 ! ! exception to coding rules... to be suppressed ??? 8 8 9 PUBLIC dom_oce_alloc 10 PUBLIC read_bathy 9 ! PUBLIC dom_oce_alloc 11 10 11 INTEGER, PARAMETER :: dp=8 , sp=4, wp=dp 12 12 13 13 !! All coordinates … … 45 45 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporary integers 46 46 INTEGER :: ios ! Local integer output status for namelist read and allocation 47 INTEGER :: numnam ! File handle for namelist 47 48 REAL(wp) :: zrmax, ztaper ! temporary scalars 48 49 REAL(wp) :: zrfact 49 50 ! 50 REAL(wp), DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 51 REAL(wp), DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 51 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 52 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zenv, ztmp, zmsk, zri, zrj, zhbat 53 54 !Namelist variables 55 REAL(wp) :: rn_jpk, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax, rn_theta 56 REAL(wp) :: rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 57 LOGICAL :: ln_s_sh94, ln_s_sf12, ln_sigcrit 52 58 53 59 NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 54 60 rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 55 61 62 CONTAINS 56 63 57 64 INTEGER FUNCTION dom_oce_alloc() 58 65 !!---------------------------------------------------------------------- 59 INTEGER, DIMENSION( 12) :: ierr66 INTEGER, DIMENSION(4) :: ierr 60 67 !!---------------------------------------------------------------------- 61 68 ierr(:) = 0 62 69 ! 63 70 ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), & 64 & zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj) )71 & zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj), STAT=ierr(1) ) 65 72 ! 66 ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 67 & gdept_0 68 & gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) )73 ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , & 74 & gdept_0(jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , & 75 & gdepw_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(2) ) 69 76 ! 70 77 ! … … 74 81 & scosrf(jpi,jpj) , scobot(jpi,jpj) , & 75 82 & hifv (jpi,jpj) , hiff (jpi,jpj) , & 76 & hift (jpi,jpj) , hifu (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr( 8) )83 & hift (jpi,jpj) , hifu (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(3) ) 77 84 78 ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(9) )79 85 ALLOCATE( mbathy(jpi,jpj) , STAT=ierr(4) ) 86 ! 80 87 dom_oce_alloc = MAXVAL(ierr) 81 88 ! 82 89 END FUNCTION dom_oce_alloc 83 90 84 91 85 92 SUBROUTINE read_bathy() 86 93 !! Read bathymetry from input netcdf file 87 INTEGER :: var_id 94 INTEGER :: var_id, ncin 88 95 89 CALL check_nf90( nf90_open('bathy.nc', NF90_NOWRITE, ncin), 'Error opening mesh_maskfile' )96 CALL check_nf90( nf90_open('bathy.nc', NF90_NOWRITE, ncin), 'Error opening bathy.nc file' ) 90 97 91 98 ! Find the size of the input bathymetry … … 96 103 97 104 ! Read the bathymetry variable from file 98 CALL check_nf90( nf90_inq_varid( ncin, 'bathymetry', tmask_id ), 'Cannot get variable ID for bathymetry')105 CALL check_nf90( nf90_inq_varid( ncin, 'bathymetry', var_id ), 'Cannot get variable ID for bathymetry') 99 106 CALL check_nf90( nf90_get_var( ncin, var_id, bathy, (/ 1,1 /), (/ jpi, jpj /) ) ) 107 108 CALL check_nf90( nf90_close(ncin), 'Error closing bathy.nc file' ) 100 109 101 110 END SUBROUTINE read_bathy … … 113 122 CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len)) 114 123 115 END SUBROUTINE dimlen 124 END SUBROUTINE dimlen 125 126 127 SUBROUTINE write_coord_file() 128 ! Write out variables to the a netcdf coordinates file 129 130 INTEGER :: id_x, id_y, id_z 131 INTEGER :: ncout 132 INTEGER, DIMENSION(11) :: var_ids !Array to contain all variable IDs 116 133 134 !Create the file 135 CALL check_nf90( nf90_create('coord_zgr.nc', NF90_CLOBBER, ncout), 'Could not create output file') 136 ! 137 !Define dimensions 138 CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) ) 139 CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) ) 140 CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) ) 141 ! 142 !Define variables 143 CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_x/), var_ids(1)) ) 144 CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_x/), var_ids(2)) ) 145 CALL check_nf90( nf90_def_var(ncout, 'gdep3w_0', nf90_double, (/id_x, id_y,id_x/), var_ids(3)) ) 146 CALL check_nf90( nf90_def_var(ncout, 'e3f_0', nf90_double, (/id_x, id_y,id_x/), var_ids(4)) ) 147 CALL check_nf90( nf90_def_var(ncout, 'e3t_0', nf90_double, (/id_x, id_y,id_x/), var_ids(5)) ) 148 CALL check_nf90( nf90_def_var(ncout, 'e3u_0', nf90_double, (/id_x, id_y,id_x/), var_ids(6)) ) 149 CALL check_nf90( nf90_def_var(ncout, 'e3v_0', nf90_double, (/id_x, id_y,id_x/), var_ids(7)) ) 150 CALL check_nf90( nf90_def_var(ncout, 'e3w_0', nf90_double, (/id_x, id_y,id_x/), var_ids(8)) ) 151 CALL check_nf90( nf90_def_var(ncout, 'e3uw_0', nf90_double, (/id_x, id_y,id_x/), var_ids(9)) ) 152 CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_x/), var_ids(10)) ) 153 CALL check_nf90( nf90_def_var(ncout, 'mbathy', nf90_double, (/id_x, id_y,id_x/), var_ids(11)) ) 154 155 ! End define mode 156 CALL check_nf90( nf90_enddef(ncout) ) 117 157 118 119 SUBROUTINE write_coord_file() 158 !Write variables to file 159 CALL check_nf90( nf90_put_var(ncout, var_ids(1), gdept_0) ) 160 CALL check_nf90( nf90_put_var(ncout, var_ids(2), gdepw_0) ) 161 CALL check_nf90( nf90_put_var(ncout, var_ids(3), gdep3w_0) ) 162 CALL check_nf90( nf90_put_var(ncout, var_ids(4), e3f_0) ) 163 CALL check_nf90( nf90_put_var(ncout, var_ids(5), e3t_0) ) 164 CALL check_nf90( nf90_put_var(ncout, var_ids(6), e3u_0) ) 165 CALL check_nf90( nf90_put_var(ncout, var_ids(7), e3v_0) ) 166 CALL check_nf90( nf90_put_var(ncout, var_ids(8), e3w_0) ) 167 CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0) ) 168 CALL check_nf90( nf90_put_var(ncout, var_ids(10), e3vw_0) ) 169 CALL check_nf90( nf90_put_var(ncout, var_ids(11), mbathy) ) 170 171 CALL check_nf90( nf90_close(ncout) ) 120 172 121 173 END SUBROUTINE write_coord_file … … 127 179 128 180 IF (istat /= nf90_noerr) THEN 129 WRITE( numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))130 IF ( PRESENT(message) ) THEN ; WRITE( numerr,*) message ; ENDIF181 WRITE(*,*) 'ERROR! : '//TRIM(nf90_strerror(istat)) 182 IF ( PRESENT(message) ) THEN ; WRITE(*,*) message ; ENDIF 131 183 STOP 132 184 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.