Changeset 4187
- Timestamp:
- 2013-11-13T16:56:06+01:00 (10 years ago)
- Location:
- branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
r4064 r4187 6 6 !! 8.1 ! 1999-11 (M. Imbard) NetCDF FORMAT with IOIPSL 7 7 !! NEMO 1.0 ! 2002-08 (G. Madec) F90 and several file 8 !! 3.0 ! 2008-01 (S. Masson) add dom_uniq 8 !! 3.0 ! 2008-01 (S. Masson) add dom_uniq_crs 9 9 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 10 10 !! ! 2012-06 (J. Simeon, C. Calone, C Ethe ) Reduced and modified for coarse grid … … 24 24 USE crsdom ! coarse grid domain 25 25 USE crslbclnk ! crs mediator to lbclnk 26 USE wrk_nemo ! Working array 26 27 27 28 … … 64 65 INTEGER :: ji, jj, jk ! dummy loop indices 65 66 ! ! workspaces 66 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zprt, zprw67 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdepu, zdepv68 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: ze3tp, ze3wp67 REAL(wp), POINTER, DIMENSION(:,: ) :: zprt, zprw 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 69 REAL(wp), POINTER, DIMENSION(:,: ) :: ze3tp, ze3wp 69 70 !!---------------------------------------------------------------------- 70 71 ! 71 72 IF( nn_timing == 1 ) CALL timing_start('crs_dom_wri') 72 73 ! 73 ALLOCATE( zprt (jpi_crs,jpj_crs) , zprw(jpi_crs,jpj_crs))74 ALLOCATE( zdepu(jpi_crs,jpj_crs,jpk), zdepv(jpi_crs,jpj_crs,jpk))75 ALLOCATE( ze3tp(jpi_crs,jpj_crs) , ze3wp(jpi_crs,jpj_crs))74 CALL wrk_alloc( jpi_crs, jpj_crs, zprt , zprw ) 75 CALL wrk_alloc( jpi_crs, jpj_crs, ze3tp, ze3wp ) 76 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv ) 76 77 77 78 ze3tp(:,:) = 0.0 … … 155 156 ENDIF 156 157 157 ! CALL iom_rstput( 0, 0, inum2, 'tpol', pv_r2d=tpol_crs, ktype = jp_i1 )158 ! CALL iom_rstput( 0, 0, inum2, 'fpol', pv_r2d=fpol_crs, ktype = jp_i1 )159 160 !!!161 158 CALL iom_rstput( 0, 0, inum2, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 162 159 ! ! unique point mask 163 CALL dom_uniq ( zprw, 'U' )160 CALL dom_uniq_crs( zprw, 'U' ) 164 161 zprt = umask_crs(:,:,1) * zprw 165 162 CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 166 CALL dom_uniq ( zprw, 'V' )163 CALL dom_uniq_crs( zprw, 'V' ) 167 164 zprt = vmask_crs(:,:,1) * zprw 168 165 CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 169 CALL dom_uniq ( zprw, 'F' )166 CALL dom_uniq_crs( zprw, 'F' ) 170 167 zprt = fmask_crs(:,:,1) * zprw 171 168 CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) … … 296 293 END SELECT 297 294 ! 298 ! 299 DEALLOCATE( zprt , zprw ) 300 DEALLOCATE( zdepu , zdepv ) 301 DEALLOCATE( ze3tp , ze3wp ) 295 CALL wrk_dealloc( jpi_crs, jpj_crs, zprt , zprw ) 296 CALL wrk_dealloc( jpi_crs, jpj_crs, ze3tp, ze3wp ) 297 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv ) 302 298 ! 303 299 IF( nn_timing == 1 ) CALL timing_stop('crs_dom_wri') … … 307 303 308 304 309 SUBROUTINE dom_uniq ( puniq, cdgrd )310 !!---------------------------------------------------------------------- 311 !! *** ROUTINE crs_dom_uniq ***305 SUBROUTINE dom_uniq_crs( puniq, cdgrd ) 306 !!---------------------------------------------------------------------- 307 !! *** ROUTINE crs_dom_uniq_crs *** 312 308 !! 313 309 !! ** Purpose : identify unique point of a grid (TUVF) … … 323 319 INTEGER :: ji ! dummy loop indices 324 320 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not 325 ! REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 326 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztstref 327 !!---------------------------------------------------------------------- 328 ! 329 IF( nn_timing == 1 ) CALL timing_start('crs_dom_uniq') 330 ! 331 ! CALL wrk_alloc( jpi_crs, jpj_crs, ztstref ) 332 ALLOCATE( ztstref(jpi_crs,jpj_crs) ) 321 REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 322 !!---------------------------------------------------------------------- 323 ! 324 IF( nn_timing == 1 ) CALL timing_start('crs_dom_uniq_crs') 325 ! 326 CALL wrk_alloc( jpi_crs, jpj_crs, ztstref ) 333 327 ! 334 328 ! build an array with different values for each element … … 346 340 puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 347 341 ! 348 ! CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref ) 349 350 DEALLOCATE( ztstref ) 351 ! 352 IF( nn_timing == 1 ) CALL timing_stop('crs_dom_uniq') 353 ! 354 355 END SUBROUTINE dom_uniq 342 CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref ) 343 ! 344 IF( nn_timing == 1 ) CALL timing_stop('crs_dom_uniq_crs') 345 ! 346 347 END SUBROUTINE dom_uniq_crs 356 348 357 349 !!====================================================================== -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r4161 r4187 31 31 USE sbc_oce, ONLY : nn_fsbc ! ocean space and time domain 32 32 USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers 33 USE icb_oce, ONLY : class_num ! !: iceberg classes33 USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes 34 34 USE domngb ! ocean space and time domain 35 35 USE phycst ! physical constants … … 406 406 407 407 408 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims,ldstop )408 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop ) 409 409 !!----------------------------------------------------------------------- 410 410 !! *** FUNCTION iom_varid *** … … 415 415 CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable 416 416 INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions 417 INTEGER, INTENT( out), OPTIONAL :: kndims ! size of the dimensions418 417 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.) 419 418 ! … … 447 446 SELECT CASE (iom_file(kiomid)%iolib) 448 447 CASE (jpioipsl ) ; iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz ) 449 CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz , kndims)448 CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz ) 450 449 CASE (jprstdimg) ; iom_varid = -1 ! all variables are listed in iom_file 451 450 CASE DEFAULT … … 468 467 ENDIF 469 468 ENDIF 470 IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(iiv)471 469 ENDIF 472 470 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.