- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r4292 r6225 7 7 !! 8.1 ! 1999-11 (M. Imbard) NetCDF FORMAT with IOIPSL 8 8 !! NEMO 1.0 ! 2002-08 (G. Madec) F90 and several file 9 !! 3.0 ! 2008-01 (S. Masson) add dom_uniq 10 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 9 !! 3.0 ! 2008-01 (S. Masson) add dom_uniq 11 10 !!---------------------------------------------------------------------- 12 11 13 12 !!---------------------------------------------------------------------- 14 13 !! dom_wri : create and write mesh and mask file(s) 15 !! dom_uniq : 14 !! dom_uniq : identify unique point of a grid (TUVF) 16 15 !!---------------------------------------------------------------------- 17 16 USE dom_oce ! ocean space and time domain … … 26 25 PRIVATE 27 26 28 PUBLIC dom_wri! routine called by inidom.F9029 27 PUBLIC dom_wri ! routine called by inidom.F90 28 PUBLIC dom_wri_coordinate ! routine called by domhgr.F90 30 29 !! * Substitutions 31 30 # include "vectopt_loop_substitute.h90" … … 36 35 !!---------------------------------------------------------------------- 37 36 CONTAINS 37 38 SUBROUTINE dom_wri_coordinate 39 !!---------------------------------------------------------------------- 40 !! *** ROUTINE dom_wri_coordinate *** 41 !! 42 !! ** Purpose : Create the NetCDF file which contains all the 43 !! standard coordinate information plus the surface, 44 !! e1e2u and e1e2v. By doing so, those surface will 45 !! not be changed by the reduction of e1u or e2v scale 46 !! factors in some straits. 47 !! NB: call just after the read of standard coordinate 48 !! and the reduction of scale factors in some straits 49 !! 50 !! ** output file : coordinate_e1e2u_v.nc 51 !!---------------------------------------------------------------------- 52 INTEGER :: inum0 ! temprary units for 'coordinate_e1e2u_v.nc' file 53 CHARACTER(len=21) :: clnam0 ! filename (mesh and mask informations) 54 ! ! workspaces 55 REAL(wp), POINTER, DIMENSION(:,: ) :: zprt, zprw 56 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 57 !!---------------------------------------------------------------------- 58 ! 59 IF( nn_timing == 1 ) CALL timing_start('dom_wri_coordinate') 60 ! 61 IF(lwp) WRITE(numout,*) 62 IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file' 63 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~' 64 65 clnam0 = 'coordinate_e1e2u_v' ! filename (mesh and mask informations) 66 67 ! create 'coordinate_e1e2u_v.nc' file 68 ! ============================ 69 ! 70 CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 71 ! 72 ! ! horizontal mesh (inum3) 73 CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 ) ! ! latitude 74 CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 ) 75 CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 ) 76 CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 ) 77 78 CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 ) ! ! longitude 79 CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 ) 80 CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 ) 81 CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 ) 82 83 CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 ) ! ! e1 scale factors 84 CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 ) 85 CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 ) 86 CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 ) 87 88 CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 ) ! ! e2 scale factors 89 CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 ) 90 CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 ) 91 CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 ) 92 93 CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 ) 94 CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 ) 95 96 CALL iom_close( inum0 ) 97 ! 98 IF( nn_timing == 1 ) CALL timing_stop('dom_wri_coordinate') 99 ! 100 END SUBROUTINE dom_wri_coordinate 101 38 102 39 103 SUBROUTINE dom_wri … … 132 196 133 197 CALL dom_uniq( zprw, 'T' ) 134 zprt = tmask(:,:,1) * zprw ! ! unique point mask 198 DO jj = 1, jpj 199 DO ji = 1, jpi 200 jk=mikt(ji,jj) 201 zprt(ji,jj) = tmask(ji,jj,jk) * zprw(ji,jj) ! ! unique point mask 202 END DO 203 END DO ! ! unique point mask 135 204 CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 136 205 CALL dom_uniq( zprw, 'U' ) 137 zprt = umask(:,:,1) * zprw 206 DO jj = 1, jpj 207 DO ji = 1, jpi 208 jk=miku(ji,jj) 209 zprt(ji,jj) = umask(ji,jj,jk) * zprw(ji,jj) ! ! unique point mask 210 END DO 211 END DO 138 212 CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 139 213 CALL dom_uniq( zprw, 'V' ) 140 zprt = vmask(:,:,1) * zprw 214 DO jj = 1, jpj 215 DO ji = 1, jpi 216 jk=mikv(ji,jj) 217 zprt(ji,jj) = vmask(ji,jj,jk) * zprw(ji,jj) ! ! unique point mask 218 END DO 219 END DO 141 220 CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 142 221 CALL dom_uniq( zprw, 'F' ) 143 zprt = fmask(:,:,1) * zprw 222 DO jj = 1, jpj 223 DO ji = 1, jpi 224 jk=mikf(ji,jj) 225 zprt(ji,jj) = fmask(ji,jj,jk) * zprw(ji,jj) ! ! unique point mask 226 END DO 227 END DO 144 228 CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 145 229 … … 168 252 169 253 ! note that mbkt is set to 1 over land ==> use surface tmask 170 zprt(:,:) = tmask(:,:,1) * REAL( mbkt(:,:) , wp )254 zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp ) 171 255 CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 ) ! ! nb of ocean T-points 256 zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp ) 257 CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i2 ) ! ! nb of ocean T-points 258 zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp ) 259 CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r4 ) ! ! nb of ocean T-points 172 260 173 261 IF( ln_sco ) THEN ! s-coordinate … … 191 279 CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d ) ! ! stretched system 192 280 CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d ) 281 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 ) 282 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 ) 193 283 ENDIF 194 284 … … 203 293 DO jj = 1,jpj 204 294 DO ji = 1,jpi 205 e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * tmask(ji,jj,1)206 e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * tmask(ji,jj,1)295 e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj) 296 e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj) 207 297 END DO 208 298 END DO … … 228 318 DO jj = 1,jpj 229 319 DO ji = 1,jpi 230 zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj) ) * tmask(ji,jj,1)231 zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1)320 zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj) ) * ssmask(ji,jj) 321 zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * ssmask(ji,jj) 232 322 END DO 233 323 END DO
Note: See TracChangeset
for help on using the changeset viewer.
