Changeset 975 for trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90
- Timestamp:
- 2008-05-15T16:10:33+02:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90
r719 r975 6 6 !! History : 9.0 ! 05 12 (J. Belier) Original code 7 7 !! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO 8 !! " ! 07 07 (D. Storkey) Changes to iom_ioipsl_gettime 8 9 !!-------------------------------------------------------------------- 9 10 !!gm caution add !DIR nec: improved performance to be checked as well as no result changes … … 19 20 USE in_out_manager ! I/O manager 20 21 USE dom_oce ! ocean space and time domain 21 USE lbclnk ! lateal boundary condition / mpp exchanges22 22 USE iom_def ! iom variables definitions 23 23 USE ioipsl ! IOIPSL library … … 36 36 !!---------------------------------------------------------------------- 37 37 !! OPA 9.0 , LOCEAN-IPSL (2006) 38 !! $Header $38 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/iom_ioipsl.F90,v 1.8 2007/06/29 14:10:50 opalod Exp $ 39 39 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 40 40 !!---------------------------------------------------------------------- … … 48 48 !! ** Purpose : open an input file with IOIPSL (only fliocom module) 49 49 !!--------------------------------------------------------------------- 50 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name51 INTEGER , INTENT( out) :: kiomid ! ioipsl identifier of the opened file52 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file?53 LOGICAL , INTENT(in ) :: ldok ! check the existence54 INTEGER, DIMENSION(2,5), INTENT(in ) :: kdompar ! domain parameters:50 CHARACTER(len=*) , INTENT(inout) :: cdname ! File name 51 INTEGER , INTENT( out) :: kiomid ! ioipsl identifier of the opened file 52 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 53 LOGICAL , INTENT(in ) :: ldok ! check the existence 54 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 55 55 56 56 CHARACTER(LEN=100) :: clinfo ! info character … … 59 59 INTEGER :: ifliodom ! model domain identifier (see flio_dom_set) 60 60 INTEGER :: ioipslid ! ioipsl identifier of the opened file 61 INTEGER :: jl ! loop variable 61 62 !--------------------------------------------------------------------- 62 63 … … 92 93 ENDIF 93 94 ELSE ! the file should be open for read mode so it must exist... 94 CALL ctl_stop( TRIM(clinfo), ' File '//cdname(1:iln-1)//'* not found' )95 CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 95 96 ENDIF 96 97 ENDIF … … 98 99 ! ============= 99 100 IF( istop == nstop ) THEN ! no error within this routine 100 kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 101 !does not work with some compilers kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 102 kiomid = 0 103 DO jl = jpmax_files, 1, -1 104 IF( iom_file(jl)%nfid == 0 ) kiomid = jl 105 ENDDO 101 106 iom_file(kiomid)%name = TRIM(cdname) 102 107 iom_file(kiomid)%nfid = ioipslid … … 161 166 & len_dims = iom_file(kiomid)%dimsz(1:i_nvd,kiv), & ! dimensions size 162 167 & id_dims = idimid(1:i_nvd) ) ! dimensions ids 163 DO ji = 1, i_nvd ! find the unlimited dimension 168 iom_file(kiomid)%luld(kiv) = .FALSE. ! default value 169 DO ji = 1, i_nvd ! find the unlimited dimension 164 170 IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE. 165 171 END DO 166 !---------- Deal with scale_factor and offset172 !---------- Deal with scale_factor and add_offset 167 173 CALL flioinqa( ioipslid, cdvar, 'scale_factor', ll_fnd ) 168 174 IF( ll_fnd) THEN … … 171 177 iom_file(kiomid)%scf(kiv) = 1. 172 178 END IF 173 CALL flioinqa( ioipslid, cdvar, ' offset', ll_fnd )179 CALL flioinqa( ioipslid, cdvar, 'add_offset', ll_fnd ) 174 180 IF( ll_fnd ) THEN 175 CALL fliogeta( ioipslid, cdvar, ' offset', iom_file(kiomid)%ofs(kiv) )181 CALL fliogeta( ioipslid, cdvar, 'add_offset', iom_file(kiomid)%ofs(kiv) ) 176 182 ELSE 177 183 iom_file(kiomid)%ofs(kiv) = 0. … … 190 196 & 'increase the parameter jpmax_vars') 191 197 ENDIF 192 !!$ ELSE 193 !!$ CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// & 194 !!$ & ' is not found in the file '//trim(iom_file(kiomid)%name) ) 198 ELSE 199 iom_ioipsl_varid = -1 ! variable not found, return error code: -1 195 200 ENDIF 196 201 ! … … 213 218 214 219 215 SUBROUTINE iom_ioipsl_g123d( kiomid, k dom, kvid, knbdim, kstart, kcount,&216 & 220 SUBROUTINE iom_ioipsl_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2, & 221 & pv_r1d, pv_r2d, pv_r3d) 217 222 !!----------------------------------------------------------------------- 218 223 !! *** ROUTINE iom_ioipsl_g123d *** … … 223 228 !!----------------------------------------------------------------------- 224 229 INTEGER , INTENT(in ) :: kiomid ! iom identifier of the file 225 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read226 230 INTEGER , INTENT(in ) :: kvid ! Name of the variable 227 231 INTEGER , INTENT(in ) :: knbdim ! number of dimensions of the variable 228 232 INTEGER , DIMENSION(:) , INTENT(in ) :: kstart ! start position of the reading in each axis 229 233 INTEGER , DIMENSION(:) , INTENT(in ) :: kcount ! number of points to be read in each axis 234 INTEGER , INTENT(in ) :: kx1, kx2, ky1, ky2 ! subdomain indexes 230 235 REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 231 236 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) … … 235 240 CHARACTER(LEN=100) :: clvn ! variable name 236 241 !--------------------------------------------------------------------- 237 clvn = TRIM(iom_file(kiomid)%cn_var(kvid)) 238 ioipslid = iom_file(kiomid)%nfid 242 clvn = TRIM(iom_file(kiomid)%cn_var(kvid)) ! get back variable name 243 ioipslid = iom_file(kiomid)%nfid ! get back IPIPSL file id 239 244 ! 240 245 IF( PRESENT(pv_r1d) ) THEN 241 CALL fliogetv( ioipslid, clvn, pv_r1d(: ), start=kstart(1:knbdim), count=kcount(1:knbdim) )246 CALL fliogetv( ioipslid, clvn, pv_r1d(: ), start = kstart(1:knbdim), count = kcount(1:knbdim) ) 242 247 ELSEIF( PRESENT(pv_r2d) ) THEN 243 IF( kdom /= jpdom_unknown ) THEN 244 CALL fliogetv( ioipslid, clvn, pv_r2d(nldi:nlei,nldj:nlej), start=kstart(1:knbdim), count=kcount(1:knbdim) ) 245 !--- Fill the overlap areas and extra hallows (mpp) 246 CALL lbc_lnk (pv_r2d,'Z',-999.,'no0') 247 ELSE 248 CALL fliogetv( ioipslid, clvn, pv_r2d(:,:), start=kstart(1:knbdim), count=kcount(1:knbdim) ) 249 ENDIF 248 CALL fliogetv( ioipslid, clvn, pv_r2d(kx1:kx2,ky1:ky2 ), start = kstart(1:knbdim), count = kcount(1:knbdim) ) 250 249 ELSEIF( PRESENT(pv_r3d) ) THEN 251 IF( kdom /= jpdom_unknown ) THEN 252 CALL fliogetv( ioipslid, clvn, pv_r3d(nldi:nlei,nldj:nlej,:), start=kstart(1:knbdim), & 253 & count=kcount (1:knbdim) ) 254 !--- Fill the overlap areas and extra hallows (mpp) 255 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 256 IF( kcount(3) == jpk ) THEN 257 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 258 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 259 pv_r3d(nlei+1:jpi, : ,:) = 1. 260 pv_r3d( : ,nlej+1:jpj,:) = 1. 261 ENDIF 262 ELSE 263 CALL fliogetv( ioipslid, clvn, pv_r3d(:,:,:), start=kstart(1:knbdim), count=kcount(1:knbdim) ) 264 ENDIF 250 CALL fliogetv( ioipslid, clvn, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim), count = kcount(1:knbdim) ) 265 251 ENDIF 266 252 ! … … 269 255 270 256 271 SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime )257 SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime, cdunits, cdcalendar ) 272 258 !!-------------------------------------------------------------------- 273 259 !! *** SUBROUTINE iom_gettime *** … … 275 261 !! ** Purpose : read the time axis kvid in the file with IOIPSL (only fliocom module) 276 262 !!-------------------------------------------------------------------- 277 INTEGER , INTENT(in ) :: kiomid ! file Identifier 278 INTEGER , INTENT(in ) :: kvid ! variable id 279 REAL(wp), DIMENSION(:), INTENT( out) :: ptime ! the time axis 263 INTEGER , INTENT(in ) :: kiomid ! file Identifier 264 INTEGER , INTENT(in ) :: kvid ! variable id 265 REAL(wp), DIMENSION(:) , INTENT( out) :: ptime ! the time axis 266 CHARACTER(len=*), OPTIONAL, INTENT( out) :: cdunits ! units attribute 267 CHARACTER(len=*), OPTIONAL, INTENT( out) :: cdcalendar ! calendar attribute 280 268 !--------------------------------------------------------------------- 281 269 ! 282 270 CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), ptime(:), & 283 271 & start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /) ) 272 IF ( PRESENT(cdunits) ) THEN 273 CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "units", cdunits ) 274 ENDIF 275 IF ( PRESENT(cdcalendar) ) THEN 276 CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "calendar", cdcalendar ) 277 ENDIF 284 278 ! 285 279 END SUBROUTINE iom_ioipsl_gettime … … 330 324 & long_name="Time axis", units='seconds since 0001-01-01 00:00:00' ) 331 325 ! update informations structure related the dimension variable we just added... 332 iom_file(kiomid)%nvars = 4 333 iom_file(kiomid)%luld(1:4) = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 334 iom_file(kiomid)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /) 335 iom_file(kiomid)%cn_var(4) = 'time_counter' 336 iom_file(kiomid)%ndims(1:4) = (/ 2, 2, 1, 1 /) 337 CALL flioinqf( ioipslid, ln_dim = idimsz ) 338 iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2) 339 iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2) 340 iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/) 326 iom_file(kiomid)%nvars = 4 327 iom_file(kiomid)%luld(1:4) = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 328 iom_file(kiomid)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /) 329 iom_file(kiomid)%cn_var(4) = 'time_counter' 330 iom_file(kiomid)%ndims(1:4) = (/ 2, 2, 1, 1 /) 331 ! trick: defined to 0 to say that dimension variables are defined but not yet written 332 iom_file(kiomid)%dimsz(1, 1) = 0 341 333 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 342 334 ENDIF … … 403 395 ! write dimension variables if it is not already done 404 396 ! ============= 397 ! trick: is defined to 0 => dimension variable are defined but not yet written 405 398 IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 406 399 CALL flioputv( ioipslid, 'nav_lon' , glamt(ix1:ix2, iy1:iy2) ) … … 408 401 CALL flioputv( ioipslid, 'nav_lev' , gdept_0 ) 409 402 ! +++ WRONG VALUE: to be improved but not really useful... 410 CALL flioputv( ioipslid, 'time_counter', kt ) 403 CALL flioputv( ioipslid, 'time_counter', kt ) 404 ! update the values of the variables dimensions size 405 CALL flioinqf( ioipslid, ln_dim = idimsz ) 406 iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2) 407 iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2) 408 iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/) 411 409 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 412 410 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
